paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 03:12:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

anchordocking: restoretest: load/restore BoundsRect

Browse Source 
git-svn-id: trunk@39735 -
This commit is contained in:
mattias 2013-01-02 18:26:58 +00:00
parent 06fd9d01ec
commit 626930d7e3
2 changed files with 63 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/anchordocking/restoredebugger/mainunit.lfm
View File

@ -6,6 +6,7 @@ object ADRestDbg: TADRestDbg
Caption = 'ADRestDbg'
ClientHeight = 567
ClientWidth = 715
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.1'

65
components/anchordocking/restoredebugger/mainunit.pas
View File

@ -34,9 +34,10 @@ unit MainUnit;
interface
uses
Classes, SysUtils, FileUtil, LazFileUtils, SynEdit, SynHighlighterXML,
AnchorDocking, AnchorDockStorage, ADLayoutViewer, Forms, Controls, Graphics,
Dialogs, ComCtrls, ExtCtrls, Buttons, StdCtrls, XMLPropStorage;
Classes, SysUtils, FileUtil, LazFileUtils, LazLogger, SynEdit,
SynHighlighterXML, AnchorDocking, AnchorDockStorage, ADLayoutViewer, Forms,
Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, Buttons, StdCtrls,
XMLPropStorage;
type
@ -58,13 +59,17 @@ type
OpenToolButton: TToolButton;
OpenRecentToolButton: TToolButton;
OriginalLayoutToolBar: TToolBar;
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FConfigFilename: string;
FOriginalFilename: string;
FSettings: TAnchorDockSettings;
function GetOriginalLayout: TAnchorDockLayoutTree;
function GetRestoredLayout: TAnchorDockLayoutTree;
procedure LoadConfig;
procedure SaveConfig;
public
OriginalView: TADLayoutTreeView;
RestoredView: TADLayoutTreeView;
@ -74,6 +79,7 @@ type
property OriginalLayout: TAnchorDockLayoutTree read GetOriginalLayout;
property OriginalFilename: string read FOriginalFilename;
property RestoredLayout: TAnchorDockLayoutTree read GetRestoredLayout;
property ConfigFilename: string read FConfigFilename write FConfigFilename;
end;
var
@ -87,6 +93,9 @@ implementation
procedure TADRestDbg.FormCreate(Sender: TObject);
begin
FConfigFilename:=GetAppConfigFileUTF8(false);
DebugLn(['TADRestDbg.FormCreate ',FConfigFilename]);
Caption:='Anchordocking Restore Debugger';
FSettings:=TAnchorDockSettings.Create;
@ -109,10 +118,17 @@ begin
Align:=alClient;
end;
LoadConfig;
if Paramcount>0 then
OpenLayout(ParamStrUTF8(1));
end;
procedure TADRestDbg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SaveConfig;
end;
procedure TADRestDbg.FormDestroy(Sender: TObject);
begin
FreeAndNil(FSettings);
@ -128,6 +144,49 @@ begin
Result:=RestoredView.Layout;
end;
procedure TADRestDbg.LoadConfig;
var
Cfg: TXMLConfigStorage;
NewBounds: TRect;
begin
try
Cfg:=TXMLConfigStorage.Create(ConfigFilename,true);
try
Cfg.GetValue('Bounds',NewBounds,Rect(0,0,0,0));
if (NewBounds.Right>NewBounds.Left)
and (NewBounds.Bottom>NewBounds.Top) then
BoundsRect:=NewBounds;
finally
Cfg.Free;
end;
except
on E:Exception do begin
debugln(['TADRestDbg.LoadConfig ',E.Message]);
end;
end;
end;
procedure TADRestDbg.SaveConfig;
var
Cfg: TXMLConfigStorage;
begin
if not ForceDirectoriesUTF8(ExtractFilePath(ConfigFilename)) then begin
debugln(['WARNING: TADRestDbg.SaveConfig: can not create directory ',ExtractFilePath(ConfigFilename)]);
end;
try
Cfg:=TXMLConfigStorage.Create(ConfigFilename,false);
try
Cfg.SetDeleteValue('Bounds',BoundsRect,Rect(0,0,0,0));
finally
Cfg.Free;
end;
except
on E:Exception do begin
debugln(['TADRestDbg.SaveConfig ',E.Message]);
end;
end;
end;
procedure TADRestDbg.OpenLayout(Filename: string);
begin
if Filename='' then exit;