paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 10:59:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpcunit: guitestrunner: save & restore windows size and position, patch #27629, from Graeme

Browse Source 
git-svn-id: trunk@48185 -
This commit is contained in:
mattias 2015-03-09 19:58:56 +00:00
parent 7419d9721f
commit 9119350010
2 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpcunit/guitestrunner.lfm
View File

@ -43,6 +43,7 @@ object GUITestRunner: TGUITestRunner
FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
}
OnCreate = GUITestRunnerCreate
OnDestroy = FormDestroy
OnShow = GUITestRunnerShow
Position = poScreenCenter
ShowHint = True

27
components/fpcunit/guitestrunner.pas
View File

@ -1,5 +1,5 @@
{
Copyright (C) 2004-2014 Dean Zobec, contributors
Copyright (C) 2004-2015 Dean Zobec, contributors
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -32,7 +32,8 @@ uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, ComCtrls, ActnList, Menus, Clipbrd, StdCtrls,
testdecorator, xmltestreport,
fpcunit, testregistry, SynEdit, SynHighlighterXML, gettext, Translations;
fpcunit, testregistry, SynEdit, SynHighlighterXML, gettext, Translations,
inifiles;
type
@ -86,7 +87,6 @@ type
tsTestTree: TTabSheet;
tsResultsXML: TTabSheet;
XMLSynEdit: TSynEdit;
FFirstFailure: TTreeNode; // reference to first failed test
procedure ActCheckAllExecute(Sender: TObject);
procedure ActCheckCurrentSuiteExecute(Sender: TObject);
procedure ActCloseFormExecute(Sender: TObject);
@ -94,6 +94,7 @@ type
procedure ActUncheckAllExecute(Sender: TObject);
procedure ActRunHighLightedTestUpdate(Sender: TObject);
procedure ActUncheckCurrentSuiteExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RunExecute(Sender: TObject);
procedure GUITestRunnerCreate(Sender: TObject);
procedure GUITestRunnerShow(Sender: TObject);
@ -116,6 +117,8 @@ type
skipsCounter: Integer;
barColor: TColor;
testSuite: TTest;
FFirstFailure: TTreeNode; // reference to first failed test
FINI: TINIFile;
procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
function FindNode(aTest: TTest): TTreeNode;
procedure ResetNodeColors;
@ -268,6 +271,8 @@ begin
TestTree.Items.SelectOnlyThis(TestTree.Items[0]);
TestTree.Items[0].Expand(False);
end;
FINI := TINIFile.Create(ExtractFileNameOnly(ParamStr(0))+ '.ini');
end;
procedure TGUITestRunner.RunExecute(Sender: TObject);
@ -341,10 +346,25 @@ begin
end;
end;
procedure TGUITestRunner.FormDestroy(Sender: TObject);
begin
// store window position and size
FINI.WriteInteger('WindowState', 'Left', Left);
FINI.WriteInteger('WindowState', 'Top', Top);
FINI.WriteInteger('WindowState', 'Width', Width);
FINI.WriteInteger('WindowState', 'Height', Height);
FINI.Free;
end;
procedure TGUITestRunner.GUITestRunnerShow(Sender: TObject);
begin
if (ParamStrUTF8(1) = '--now') or (ParamStrUTF8(1) = '-n') then
RunExecute(Self);
// restore last used position and size
Left := FINI.ReadInteger('WindowState', 'Left', Left);
Top := FINI.ReadInteger('WindowState', 'Top', Top);
Width := FINI.ReadInteger('WindowState', 'Width', Width);
Height := FINI.ReadInteger('WindowState', 'Height', Height);
end;
procedure TGUITestRunner.MenuItem3Click(Sender: TObject);
@ -654,7 +674,6 @@ begin
RunAction.Enabled := AValue;
end;
procedure TGUITestRunner.AddFailure(ATest: TTest; AFailure: TTestFailure);
var
FailureNode: TTreeNode;