paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 17:19:19 +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 FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
} }
OnCreate = GUITestRunnerCreate OnCreate = GUITestRunnerCreate
OnDestroy = FormDestroy
OnShow = GUITestRunnerShow OnShow = GUITestRunnerShow
Position = poScreenCenter Position = poScreenCenter
ShowHint = True 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 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 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, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, ComCtrls, ActnList, Menus, Clipbrd, StdCtrls, ExtCtrls, Buttons, ComCtrls, ActnList, Menus, Clipbrd, StdCtrls,
testdecorator, xmltestreport, testdecorator, xmltestreport,
fpcunit, testregistry, SynEdit, SynHighlighterXML, gettext, Translations; fpcunit, testregistry, SynEdit, SynHighlighterXML, gettext, Translations,
inifiles;
type type
@ -86,7 +87,6 @@ type
tsTestTree: TTabSheet; tsTestTree: TTabSheet;
tsResultsXML: TTabSheet; tsResultsXML: TTabSheet;
XMLSynEdit: TSynEdit; XMLSynEdit: TSynEdit;
FFirstFailure: TTreeNode; // reference to first failed test
procedure ActCheckAllExecute(Sender: TObject); procedure ActCheckAllExecute(Sender: TObject);
procedure ActCheckCurrentSuiteExecute(Sender: TObject); procedure ActCheckCurrentSuiteExecute(Sender: TObject);
procedure ActCloseFormExecute(Sender: TObject); procedure ActCloseFormExecute(Sender: TObject);
@ -94,6 +94,7 @@ type
procedure ActUncheckAllExecute(Sender: TObject); procedure ActUncheckAllExecute(Sender: TObject);
procedure ActRunHighLightedTestUpdate(Sender: TObject); procedure ActRunHighLightedTestUpdate(Sender: TObject);
procedure ActUncheckCurrentSuiteExecute(Sender: TObject); procedure ActUncheckCurrentSuiteExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RunExecute(Sender: TObject); procedure RunExecute(Sender: TObject);
procedure GUITestRunnerCreate(Sender: TObject); procedure GUITestRunnerCreate(Sender: TObject);
procedure GUITestRunnerShow(Sender: TObject); procedure GUITestRunnerShow(Sender: TObject);
@ -116,6 +117,8 @@ type
skipsCounter: Integer; skipsCounter: Integer;
barColor: TColor; barColor: TColor;
testSuite: TTest; testSuite: TTest;
FFirstFailure: TTreeNode; // reference to first failed test
FINI: TINIFile;
procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite); procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
function FindNode(aTest: TTest): TTreeNode; function FindNode(aTest: TTest): TTreeNode;
procedure ResetNodeColors; procedure ResetNodeColors;
@ -268,6 +271,8 @@ begin
TestTree.Items.SelectOnlyThis(TestTree.Items[0]); TestTree.Items.SelectOnlyThis(TestTree.Items[0]);
TestTree.Items[0].Expand(False); TestTree.Items[0].Expand(False);
end; end;
FINI := TINIFile.Create(ExtractFileNameOnly(ParamStr(0))+ '.ini');
end; end;
procedure TGUITestRunner.RunExecute(Sender: TObject); procedure TGUITestRunner.RunExecute(Sender: TObject);
@ -341,10 +346,25 @@ begin
end; end;
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); procedure TGUITestRunner.GUITestRunnerShow(Sender: TObject);
begin begin
if (ParamStrUTF8(1) = '--now') or (ParamStrUTF8(1) = '-n') then if (ParamStrUTF8(1) = '--now') or (ParamStrUTF8(1) = '-n') then
RunExecute(Self); 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; end;
procedure TGUITestRunner.MenuItem3Click(Sender: TObject); procedure TGUITestRunner.MenuItem3Click(Sender: TObject);
@ -654,7 +674,6 @@ begin
RunAction.Enabled := AValue; RunAction.Enabled := AValue;
end; end;
procedure TGUITestRunner.AddFailure(ATest: TTest; AFailure: TTestFailure); procedure TGUITestRunner.AddFailure(ATest: TTest; AFailure: TTestFailure);
var var
FailureNode: TTreeNode; FailureNode: TTreeNode;