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

PoChecker: save and restore windowgeometry of Results form and GraphicalSummary form.

Browse Source 
git-svn-id: trunk@46381 -
This commit is contained in:
bart 2014-09-30 20:42:50 +00:00
parent 031fce5c35
commit 96686c4731
4 changed files with 194 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
components/pochecker/graphstat.pp
View File

@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, Types, FileUtil, Forms, Controls, Graphics, Dialogs,
{$ifndef POCHECKERSTANDALONE} LazIDEIntf, {$endif}
ExtCtrls, PoFamilies, PoCheckerConsts, LCLProc, StdCtrls, ComCtrls;
ExtCtrls, PoFamilies, PoCheckerConsts, LCLProc, StdCtrls, ComCtrls,
PoCheckerSettings;
type
@ -37,12 +38,16 @@ type
FPoFamilyStats: TPoFamilyStats;
FImgList: TImageList;
FOldHintHidePause: Integer;
FSettings: TPoCheckerSettings;
procedure LoadConfig;
Procedure SaveConfig;
function CreateBitmap(AStat: TStat): TBitmap;
procedure AddToListView(AStat: TStat; ABmp: TBitmap);
procedure DrawGraphs;
public
{ public declarations }
property PoFamilyStats: TPoFamilyStats read FPoFamilyStats write FPoFamilyStats;
property Settings: TPoCheckerSettings read FSettings write FSettings;
end;
var
@ -83,6 +88,7 @@ procedure TGraphStatForm.FormShow(Sender: TObject);
begin
FOldHintHidePause := Application.HintHidePause;
Application.HintHidePause := 5000;
LoadConfig;
end;
procedure TGraphStatForm.ListViewMouseMove(Sender: TObject; Shift: TShiftState;
@ -141,6 +147,27 @@ begin
{$endif}
end;
procedure TGraphStatForm.LoadConfig;
var
ARect: TRect;
begin
if not Assigned(FSettings) then Exit;
ARect := FSettings.GraphFormGeometry;
//debugln('TGraphStatForm.LoadConfig: ARect = ',dbgs(ARect));
if not IsDefaultRect(ARect) and IsValidRect(ARect) then
begin
ARect := FitToRect(ARect, Screen.WorkAreaRect);
BoundsRect := ARect;
end;
end;
procedure TGraphStatForm.SaveConfig;
begin
//debugln('TGraphStatForm.SaveConfig: BoundsRect = ',dbgs(BoundsRect));
if not Assigned(FSettings) then Exit;
Settings.GraphFormGeometry := BoundsRect;
end;
procedure TGraphStatForm.FormCreate(Sender: TObject);
begin
Caption := sGrapStatFormCaption;
@ -169,6 +196,7 @@ end;
procedure TGraphStatForm.FormDestroy(Sender: TObject);
begin
if Assigned(FImgList) then FImgList.Free;
SaveConfig;
end;
function TGraphStatForm.CreateBitmap(AStat: TStat): TBitmap;

18
components/pochecker/pocheckermain.pp
View File

@ -392,8 +392,8 @@ begin
(PoFamily.ChildName <> FSelectedPoName) then
PoFamily.ChildName := FSelectedPoName;
PoFamily.RunTests(TestTypes, TestOptions, ErrorCount, WarningCount, SL);
debugln('RunSelectedTests: ', Format(sTotalErrors, [ErrorCount]));
debugln(' ', Format(sTotalWarnings, [WarningCount]));
//debugln('RunSelectedTests: ', Format(sTotalErrors, [ErrorCount]));
//debugln(' ', Format(sTotalWarnings, [WarningCount]));
if (ErrorCount > 0) or (WarningCount > 0) or
(pttCheckStatistics in TestTypes) then
begin
@ -407,6 +407,7 @@ begin
ResultDlg.PoFamilyStats := PoFamily.PoFamilyStats
else
ResultDlg.PoFamilyStats := nil;
ResultDlg.Settings := FPoCheckerSettings;
mr := ResultDlg.ShowModal;
finally
ResultDlg.Free;
@ -455,20 +456,17 @@ end;
procedure TPoCheckerForm.LoadConfig;
function IsSaneRect(ARect: TRect): Boolean;
const
MinWH = 50; //arbitrary
begin
Result := (ARect.Right > ARect.Left + MinWH) and
(ARect.Bottom > ARect.Bottom + MinWH);
end;
var
ARect: TRect;
begin
FPoCheckerSettings := TPoCheckerSettings.Create;
FPoCheckerSettings.LoadConfig;
ARect := FPoCheckerSettings.MainFormGeometry;
if IsSaneRect(ARect) then BoundsRect := ARect;
if not IsDefaultRect(ARect) and IsValidRect(ARect) then
begin
ARect := FitToRect(ARect, Screen.WorkAreaRect);
BoundsRect := ARect;
end;
//DebugLn(' TestOptions after loading = ');
//DebugLn(' ',DbgS(FPoCheckerSettings.TestOptions));

171
components/pochecker/pocheckersettings.pp
View File

@ -29,9 +29,12 @@ type
FChildrenPoList: TStrings;
FLastSelectedFile: String;
FMainFormGeometry: TRect;
FGraphFormGeometry: TRect;
FResultsFormGeometry: TRect;
function LoadLastSelectedFile: String;
function LoadTestTypes: TPoTestTypes;
function LoadTestOptions: TPoTestOptions;
procedure LoadWindowsGeometry;
procedure LoadMasterPoList(List: TStrings);
procedure LoadChildrenPoList(List: TStrings);
procedure SaveLastSelectedFile;
@ -56,13 +59,116 @@ type
property ChildrenPoList: TStrings read FChildrenPoList write FChildrenPoList;
property LastSelectedFile: String read FLastSelectedFile write FLastSelectedFile;
property MainFormGeometry: TRect read FMainFormGeometry write FMainFormGeometry;
property ResultsFormGeometry: TRect read FResultsFormGeometry write FResultsFormGeometry;
property GraphFormGeometry: TRect read FGraphFormGeometry write FGraphFormGeometry;
end;
function DbgS(PoTestTypes: TPoTestTypes): String; overload;
function DbgS(PoTestOpts: TPoTestOptions): String; overload;
function FitToRect(const ARect, FitIn: TRect): TRect;
function IsDefaultRect(ARect: TRect): Boolean;
function IsValidRect(ARect: TRect): Boolean;
implementation
function FitToRect(const ARect, FitIn: TRect): TRect;
begin
Result := ARect;
if (Result.Right - Result.Left) > (FitIn.Right - FitIn.Left) then
Result.Right := Result.Left + (FitIn.Right - FitIn.Left);
if (Result.Bottom - Result.Top) > (FitIn.Bottom - FitIn.Top) then
Result.Bottom := Result.Top + (FitIn.Bottom - FitIn.Top);
if Result.Left < FitIn.Left then
begin
Result.Right := Result.Right + (FitIn.Left - Result.Left);
Result.Left := FitIn.Left;
end;
if Result.Right > FitIn.Right then
begin
Result.Left := Result.Left - (Result.Right - FitIn.Right);
Result.Right := Result.Right - (Result.Right - FitIn.Right);
end;
if Result.Top < FitIn.Top then
begin
Result.Bottom := Result.Bottom + (FitIn.Top - Result.Top);
Result.Top := FitIn.Top;
end;
if Result.Bottom > FitIn.Bottom then
begin
Result.Top := Result.Top - (Result.Bottom - FitIn.Bottom);
Result.Bottom := Result.Bottom - (Result.Bottom - FitIn.Bottom);
end;
//if Result.Right > FitIn.Right then Result.Right := FitIn.Right;
//if Result.Bottom > FitIn.Bottom then Result.Bottom := FitIn.Bottom;
end;
function IsDefaultRect(ARect: TRect): Boolean;
begin
Result := (ARect.Left = -1) and (ARect.Top = -1) and
(ARect.Right = -1) and (Arect.Bottom = -1);
end;
function IsValidRect(ARect: TRect): Boolean;
begin
Result := (ARect.Right > ARect.Left) and
(ARect.Bottom > ARect.Top);
end;
const
TestTypeNames: array[TPoTestType] of String = (
'CheckNumberOfItems',
'CheckForIncompatibleFormatArguments',
'CheckMissingIdentifiers',
'CheckForMismatchesInUntranslatedStrings',
'CheckForDuplicateUntranslatedValues',
'CheckStatistics'
);
TestoptionNames: array[TPoTestOption] of String = (
'FindAllChildren',
'IgnoreFuzzyStrings'
);
pLoadSettings = 'General/LoadSettings/';
pLastSelected = 'LastSelected/';
pTestTypes = 'TestTypes/';
pTestOptions = 'TestOptions/';
pWindowsGeometry = 'General/WindowsGeometry/';
pMasterPoFiles = 'MasterPoFiles/';
pChildrenPoFiles = 'ChildrenPoFiles/';
var
DefaultRect: TRect;
function DbgS(PoTestTypes: TPoTestTypes): String; overload;
var
Typ: TPoTestType;
begin
Result := '[';
for Typ := Low(TPotestType) to High(TPoTesttype) do
begin
if (Typ in PoTestTypes) then Result := Result + TestTypeNames[Typ];
end;
if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1);
Result := Result + ']';
end;
function DbgS(PoTestOpts: TPoTestOptions): String; overload;
var
Opt: TPoTestOption;
begin
Result := '[';
for Opt := Low(TPotestOption) to High(TPoTestOption) do
begin
if (Opt in PoTestOpts) then Result := Result + TestOptionNames[opt];
end;
if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1);
Result := Result + ']';
end;
{ TPoCheckerSettings }
{$ifdef pocheckerstandalone}
function AppName: String;
@ -101,53 +207,6 @@ end;
{$endif}
const
TestTypeNames: array[TPoTestType] of String = (
'CheckNumberOfItems',
'CheckForIncompatibleFormatArguments',
'CheckMissingIdentifiers',
'CheckForMismatchesInUntranslatedStrings',
'CheckForDuplicateUntranslatedValues',
'CheckStatistics'
);
TestoptionNames: array[TPoTestOption] of String = (
'FindAllChildren',
'IgnoreFuzzyStrings'
);
pLoadSettings = 'General/LoadSettings/';
pLastSelected = 'LastSelected/';
pTestTypes = 'TestTypes/';
pTestOptions = 'TestOptions/';
pWindowsGeometry = 'General/WindowsGeometry/';
pMasterPoFiles = 'MasterPoFiles/';
pChildrenPoFiles = 'ChildrenPoFiles/';
function DbgS(PoTestTypes: TPoTestTypes): String; overload;
var
Typ: TPoTestType;
begin
Result := '[';
for Typ := Low(TPotestType) to High(TPoTesttype) do
begin
if (Typ in PoTestTypes) then Result := Result + TestTypeNames[Typ];
end;
if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1);
Result := Result + ']';
end;
function DbgS(PoTestOpts: TPoTestOptions): String; overload;
var
Opt: TPoTestOption;
begin
Result := '[';
for Opt := Low(TPotestOption) to High(TPoTestOption) do
begin
if (Opt in PoTestOpts) then Result := Result + TestOptionNames[opt];
end;
if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1);
Result := Result + ']';
end;
function TPoCheckerSettings.LoadLastSelectedFile: String;
begin
@ -184,6 +243,13 @@ begin
end;
end;
procedure TPoCheckerSettings.LoadWindowsGeometry;
begin
FConfig.GetValue(pWindowsGeometry+'MainForm/Value',FMainFormGeometry,DefaultRect);
FConfig.GetValue(pWindowsGeometry+'ResultsForm/Value',FResultsFormGeometry,DefaultRect);
FConfig.GetValue(pWindowsGeometry+'GraphForm/Value',FGraphFormGeometry,DefaultRect);
end;
procedure TPoCheckerSettings.LoadMasterPoList(List: TStrings);
begin
if not Assigned(List) then Exit;
@ -227,7 +293,9 @@ end;
procedure TPoCheckerSettings.SaveWindowsGeometry;
begin
FConfig.SetDeleteValue(pWindowsGeometry+'MainForm/Value',FMainFormGeometry,Rect(-1,-1,-1,-1));
FConfig.SetDeleteValue(pWindowsGeometry+'MainForm/Value',FMainFormGeometry,DefaultRect);
FConfig.SetDeleteValue(pWindowsGeometry+'ResultsForm/Value',FResultsFormGeometry,DefaultRect);
FConfig.SetDeleteValue(pWindowsGeometry+'GraphForm/Value',FGraphFormGeometry,DefaultRect);
end;
procedure TPoCheckerSettings.SaveMasterPoList;
@ -250,8 +318,8 @@ begin
FFilename := GetAndCreateConfigPath;
if (FFilename <> '') then FFilename := AppendPathDelim(FFilename);
FFilename := FFilename + 'pochecker.xml';
debugln('TPoCheckerSettings.Create: Filename = ');
debugln('"',Filename,'"');
//debugln('TPoCheckerSettings.Create: Filename = ');
//debugln('"',Filename,'"');
//FFilename := 'pochecker.xml';
@ -283,6 +351,7 @@ begin
FTestTypes := LoadTestTypes;
FTestOptions := LoadTestOptions;
FLastSelectedFile := LoadLastSelectedFile;
LoadWindowsGeometry;
LoadMasterPoList(FMasterPoList);
LoadChildrenPoList(FChildrenPoList);
end;
@ -318,5 +387,7 @@ begin
end;
end;
Initialization
DefaultRect := Rect(-1, -1, -1, -1);
end.

41
components/pochecker/resultdlg.pp
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, ClipBrd, LCLType, LCLProc, SynEdit, SynHighlighterPo,
PoFamilies, GraphStat, PoCheckerConsts;
PoFamilies, GraphStat, PoCheckerConsts, PoCheckerSettings;
type
@ -33,10 +33,14 @@ type
private
PoHL: TSynPoSyn;
FPoFamilyStats: TPoFamilyStats;
FSettings: TPoCheckerSettings;
procedure SaveToFile;
procedure LoadConfig;
procedure SaveConfig;
public
property Log: TStringList read FLog write FLog;
property PoFamilyStats: TPoFamilyStats read FPoFamilyStats write FPoFamilyStats;
property Settings: TPoCheckerSettings read FSettings write FSettings;
end;
implementation
@ -72,6 +76,7 @@ end;
procedure TResultDlgForm.FormDestroy(Sender: TObject);
begin
FLog.Free;
SaveConfig;
end;
procedure TResultDlgForm.FormKeyDown(Sender: TObject; var Key: Word;
@ -90,6 +95,7 @@ procedure TResultDlgForm.FormShow(Sender: TObject);
begin
LogMemo.Lines.Assign(FLog);
GraphStatBtn.Visible := (PoFamilyStats <> nil) and (PoFamilyStats.Count > 0);
LoadConfig;
end;
procedure TResultDlgForm.GraphStatBtnClick(Sender: TObject);
@ -97,10 +103,14 @@ var
mr: TModalResult;
begin
GraphStatForm := TGraphStatForm.Create(nil);
GraphStatForm.PoFamilyStats := Self.PoFamilyStats;
mr := GraphStatForm.ShowModal;
FreeAndNil(GraphStatForm);
if mr = mrOpenEditorFile then ModalResult := mr; // To inform pocheckermain
try
GraphStatForm.PoFamilyStats := Self.PoFamilyStats;
GraphStatForm.Settings := Self.Settings;
mr := GraphStatForm.ShowModal;
if mr = mrOpenEditorFile then ModalResult := mr; // To inform pocheckermain
finally
FreeAndNil(GraphStatForm);
end;
end;
procedure TResultDlgForm.SaveBtnClick(Sender: TObject);
@ -127,5 +137,26 @@ begin
end;
end;
procedure TResultDlgForm.LoadConfig;
var
ARect: TRect;
begin
if not Assigned(FSettings) then Exit;
ARect := FSettings.ResultsFormGeometry;
//debugln('TResultDlgForm.LoadConfig: ARect = ',dbgs(ARect));
if not IsDefaultRect(ARect) and IsValidRect(ARect) then
begin
ARect := FitToRect(ARect, Screen.WorkAreaRect);
BoundsRect := ARect;
end;
end;
procedure TResultDlgForm.SaveConfig;
begin
//debugln('TResultDlgForm.SaveConfig: BoundsRect = ',dbgs(BoundsRect));
if not Assigned(FSettings) then Exit;
Settings.ResultsFormGeometry := BoundsRect;
end;
end.