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

AnchorDocking: Refactor and restore some removed methods. Remove IDE dependency added in r49778 #50bc37338d.

Browse Source 
git-svn-id: trunk@49787 -
This commit is contained in:
juha 2015-09-08 12:31:06 +00:00
parent 78a3ce2949
commit 3f0e11a05b
8 changed files with 398 additions and 298 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

371
components/anchordocking/anchordocking.pas
View File

@ -105,32 +105,10 @@ uses
Math, Classes, SysUtils, types,
LCLType, LCLIntf, LCLProc,
Controls, Forms, ExtCtrls, ComCtrls, Graphics, Themes, Menus, Buttons,
LazConfigStorage, LazFileUtils, LazFileCache, Laz2_XMLCfg,
IDEOptionsIntf, MacroIntf, LazIDEIntf,
LazConfigStorage, LazFileCache,
AnchorDockStr, AnchorDockStorage;
type
TAnchorDesktopOpt = class(TAbstractDesktopDockingOpt)
private
FTree: TAnchorDockLayoutTree;
FRestoreLayouts: TAnchorDockRestoreLayouts;
public
procedure LoadDefaultLayout;
procedure LoadLayoutFromConfig(Path: string; aXMLCfg: TRttiXMLConfig);
procedure LoadLayoutFromFile(FileName: string);
procedure SaveMainLayoutToTree;
procedure SaveLayoutToConfig(Path: string; aXMLCfg: TRttiXMLConfig);
public
constructor Create(aUseIDELayouts: Boolean); override;
destructor Destroy; override;
procedure Load(Path: String; aXMLCfg: TRttiXMLConfig); override;
procedure Save(Path: String; aXMLCfg: TRttiXMLConfig); override;
procedure Assign(Source: TAbstractDesktopDockingOpt); override;
procedure StoreWindowPositions; override;
function RestoreDesktop: Boolean; override;
end;
TAnchorDockHostSite = class;
{ TAnchorDockCloseButton
@ -597,16 +575,20 @@ type
ResizePolicy: TADMResizePolicy;
AllowInside: boolean = false);
procedure MakeVisible(AControl: TControl; SwitchPages: boolean);
function ShowControl(ControlName: string; BringToFront: boolean = false
): TControl;
function ShowControl(ControlName: string; BringToFront: boolean = false): TControl;
procedure CloseAll;
// save/restore layouts
procedure SaveLayoutToConfig(Config: TConfigStorage);
procedure SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree);
procedure SaveSiteLayoutToTree(AForm: TCustomForm;
LayoutTree: TAnchorDockLayoutTree);
function CreateRestoreLayout(AControl: TControl): TAnchorDockRestoreLayout;
function ConfigIsEmpty(Config: TConfigStorage): boolean;
property RestoreLayouts: TAnchorDockRestoreLayouts read FRestoreLayouts; // layout information for restoring hidden forms
function LoadLayoutFromConfig(Config: TConfigStorage; Scale: Boolean): boolean;
// layout information for restoring hidden forms
property RestoreLayouts: TAnchorDockRestoreLayouts read FRestoreLayouts
write FRestoreLayouts;
property Restoring: boolean read FRestoring write SetRestoring;
property IdleConnected: Boolean read FIdleConnected write SetIdleConnected;
procedure LoadSettingsFromConfig(Config: TConfigStorage);
@ -1183,197 +1165,6 @@ begin
Fill(LeftTopControl);
end;
{ TAnchorDesktopOpt }
procedure TAnchorDesktopOpt.Assign(Source: TAbstractDesktopDockingOpt);
var
xSource: TAnchorDesktopOpt;
begin
if Source is TAnchorDesktopOpt then
begin
xSource := TAnchorDesktopOpt(Source);
FTree.Assign(xSource.FTree);
FRestoreLayouts.Assign(xSource.FRestoreLayouts);
end;
end;
constructor TAnchorDesktopOpt.Create(aUseIDELayouts: Boolean);
begin
inherited;
FTree := TAnchorDockLayoutTree.Create;
FRestoreLayouts := TAnchorDockRestoreLayouts.Create;
if aUseIDELayouts then
DockMaster.FRestoreLayouts := Self.FRestoreLayouts;
end;
destructor TAnchorDesktopOpt.Destroy;
begin
FTree.Free;
FRestoreLayouts.Free;
inherited Destroy;
end;
procedure TAnchorDesktopOpt.Load(Path: String; aXMLCfg: TRttiXMLConfig);
var
Config: TConfigStorage;
begin
//new version of old "TIDEAnchorDockMaster.LoadUserLayout"
Path := Path + 'AnchorDocking/';
try
{$IFDEF VerboseAnchorDocking}
debugln(['TIDEAnchorDockMaster.LoadUserLayout ',Filename]);
{$ENDIF}
if aXMLCfg.GetValue(Path+'MainConfig/Nodes/ChildCount',0) > 0 then//config is not empty
begin
// loading last layout
{$IF defined(VerboseAnchorDocking) or defined(VerboseAnchorDockRestore)}
debugln(['TIDEAnchorDockMaster.LoadUserLayout restoring ...']);
{$ENDIF}
LoadLayoutFromConfig(Path,aXMLCfg);
end else begin
// loading defaults
{$IF defined(VerboseAnchorDocking) or defined(VerboseAnchorDockRestore)}
debugln(['TIDEAnchorDockMaster.LoadUserLayout loading default layout ...']);
{$ENDIF}
LoadDefaultLayout;
end;
except
on E: Exception do begin
DebugLn(['TIDEAnchorDockMaster.LoadUserLayout loading ',aXMLCfg.GetValue(Path+'Name', ''),' failed: ',E.Message]);
Raise;
end;
end;
end;
procedure TAnchorDesktopOpt.LoadDefaultLayout;
var
BaseDir: String;
Filename: String;
begin
Filename := AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+'anchordocklayout.xml';
if FileExistsUTF8(Filename) then//first load from anchordocklayout.xml -- backwards compatibility
LoadLayoutFromFile(Filename)
else
begin
BaseDir := '$PkgDir(AnchorDockingDsgn)';
IDEMacros.SubstituteMacros(BaseDir);
if (BaseDir<>'') and DirectoryExistsUTF8(BaseDir) then begin
Filename:=AppendPathDelim(BaseDir)+'ADLayoutDefault.xml';
if FileExistsUTF8(Filename) then
LoadLayoutFromFile(Filename);
end;
end;
end;
procedure TAnchorDesktopOpt.LoadLayoutFromConfig(Path: string; aXMLCfg: TRttiXMLConfig);
begin
FTree.LoadFromConfig(Path+'MainConfig/', aXMLCfg);
FRestoreLayouts.LoadFromConfig(Path+'Restores/', aXMLCfg);
end;
procedure TAnchorDesktopOpt.LoadLayoutFromFile(FileName: string);
var
Config: TRttiXMLConfig;
begin
Config := TRttiXMLConfig.Create(FileName);
try
LoadLayoutFromConfig('',Config);
finally
Config.Free;
end;
end;
procedure TAnchorDesktopOpt.Save(Path: String; aXMLCfg: TRttiXMLConfig);
begin
Path := Path + 'AnchorDocking/';
try
{$IF defined(VerboseAnchorDocking) or defined(VerboseAnchorDockRestore)}
debugln(['TIDEAnchorDockMaster.SaveDefaultLayout ',Filename]);
{$ENDIF}
SaveLayoutToConfig(Path, aXMLCfg);
except
on E: Exception do begin
DebugLn(['TIDEAnchorDockMaster.SaveDefaultLayout saving ',aXMLCfg.GetValue(Path+'Name', ''),' failed: ',E.Message]);
Raise;
end;
end;
end;
procedure TAnchorDesktopOpt.SaveLayoutToConfig(Path: string; aXMLCfg: TRttiXMLConfig);
begin
FTree.SaveToConfig(Path+'MainConfig/', aXMLCfg);
FRestoreLayouts.SaveToConfig(Path+'Restores/', aXMLCfg);
WriteDebugLayout('TAnchorDesktopOpt.SaveLayoutToConfig ',FTree.Root);
end;
procedure TAnchorDesktopOpt.SaveMainLayoutToTree;
var
i: Integer;
AControl: TControl;
Site: TAnchorDockHostSite;
SavedSites: TFPList;
LayoutNode: TAnchorDockLayoutTreeNode;
AForm: TCustomForm;
VisibleControls: TStringList;
begin
FTree.Clear;
SavedSites:=TFPList.Create;
VisibleControls:=TStringList.Create;
with DockMaster do
try
for i:=0 to ControlCount-1 do begin
AControl:=Controls[i];
if not DockedControlIsVisible(AControl) then continue;
VisibleControls.Add(AControl.Name);
AForm:=GetParentForm(AControl);
if AForm=nil then continue;
if SavedSites.IndexOf(AForm)>=0 then continue;
SavedSites.Add(AForm);
debugln(['TAnchorDesktopOpt.SaveMainLayoutToTree AForm=',DbgSName(AForm)]);
DebugWriteChildAnchors(AForm,true,true);
if (AForm is TAnchorDockHostSite) then begin
Site:=TAnchorDockHostSite(AForm);
LayoutNode:=FTree.NewNode(FTree.Root);
Site.SaveLayout(FTree,LayoutNode);
end else if IsCustomSite(AForm) then begin
// custom dock site
LayoutNode:=FTree.NewNode(FTree.Root);
LayoutNode.NodeType:=adltnCustomSite;
LayoutNode.Assign(AForm);
// can have one normal dock site
Site:=TAnchorDockManager(AForm.DockManager).GetChildSite;
if Site<>nil then begin
LayoutNode:=FTree.NewNode(LayoutNode);
Site.SaveLayout(FTree,LayoutNode);
{if Site.BoundSplitter<>nil then begin
LayoutNode:=FTree.NewNode(LayoutNode);
Site.BoundSplitter.SaveLayout(LayoutNode);
end;}
end;
end else
raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl));
end;
// remove invisible controls
FTree.Root.Simplify(VisibleControls);
finally
VisibleControls.Free;
SavedSites.Free;
end;
end;
procedure TAnchorDesktopOpt.StoreWindowPositions;
begin
SaveMainLayoutToTree;
end;
function TAnchorDesktopOpt.RestoreDesktop: Boolean;
begin
Result := DockMaster.FullRestoreLayout(FTree,True);
end;
{ TAnchorDockSettings }
procedure TAnchorDockSettings.SetAllowDragging(AValue: boolean);
@ -2872,6 +2663,79 @@ begin
end;
end;
procedure TAnchorDockMaster.SaveLayoutToConfig(Config: TConfigStorage);
var
Tree: TAnchorDockLayoutTree;
begin
Tree:=TAnchorDockLayoutTree.Create;
try
Config.AppendBasePath('MainConfig/');
SaveMainLayoutToTree(Tree);
Tree.SaveToConfig(Config);
Config.UndoAppendBasePath;
Config.AppendBasePath('Restores/');
RestoreLayouts.SaveToConfig(Config);
Config.UndoAppendBasePath;
WriteDebugLayout('TAnchorDockMaster.SaveLayoutToConfig ',Tree.Root);
//DebugWriteChildAnchors(Tree.Root);
finally
Tree.Free;
end;
end;
procedure TAnchorDockMaster.SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree);
var
i: Integer;
AControl: TControl;
Site: TAnchorDockHostSite;
SavedSites: TFPList;
LayoutNode: TAnchorDockLayoutTreeNode;
AForm: TCustomForm;
VisibleControls: TStringList;
begin
SavedSites:=TFPList.Create;
VisibleControls:=TStringList.Create;
try
for i:=0 to ControlCount-1 do begin
AControl:=Controls[i];
if not DockedControlIsVisible(AControl) then continue;
VisibleControls.Add(AControl.Name);
AForm:=GetParentForm(AControl);
if AForm=nil then continue;
if SavedSites.IndexOf(AForm)>=0 then continue;
SavedSites.Add(AForm);
debugln(['TAnchorDockMaster.SaveMainLayoutToTree AForm=',DbgSName(AForm)]);
DebugWriteChildAnchors(AForm,true,true);
if (AForm is TAnchorDockHostSite) then begin
Site:=TAnchorDockHostSite(AForm);
LayoutNode:=LayoutTree.NewNode(LayoutTree.Root);
Site.SaveLayout(LayoutTree,LayoutNode);
end else if IsCustomSite(AForm) then begin
// custom dock site
LayoutNode:=LayoutTree.NewNode(LayoutTree.Root);
LayoutNode.NodeType:=adltnCustomSite;
LayoutNode.Assign(AForm);
// can have one normal dock site
Site:=TAnchorDockManager(AForm.DockManager).GetChildSite;
if Site<>nil then begin
LayoutNode:=LayoutTree.NewNode(LayoutNode);
Site.SaveLayout(LayoutTree,LayoutNode);
{if Site.BoundSplitter<>nil then begin
LayoutNode:=LayoutTree.NewNode(LayoutNode);
Site.BoundSplitter.SaveLayout(LayoutNode);
end;}
end;
end else
raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl));
end;
// remove invisible controls
LayoutTree.Root.Simplify(VisibleControls);
finally
VisibleControls.Free;
SavedSites.Free;
end;
end;
procedure TAnchorDockMaster.SaveSiteLayoutToTree(AForm: TCustomForm;
LayoutTree: TAnchorDockLayoutTree);
var
@ -2931,6 +2795,79 @@ begin
Result:=Config.GetValue('MainConfig/Nodes/ChildCount',0)=0;
end;
function TAnchorDockMaster.LoadLayoutFromConfig(Config: TConfigStorage;
Scale: Boolean): boolean;
var
Tree: TAnchorDockLayoutTree;
ControlNames: TStringList;
begin
Result:=false;
ControlNames:=TStringList.Create;
fTreeNameToDocker:=TADNameToControl.Create;
Tree:=TAnchorDockLayoutTree.Create;
try
// load layout
Config.AppendBasePath('MainConfig/');
try
Tree.LoadFromConfig(Config);
finally
Config.UndoAppendBasePath;
end;
// load restore layouts for hidden forms
Config.AppendBasePath('Restores/');
try
RestoreLayouts.LoadFromConfig(Config);
finally
Config.UndoAppendBasePath;
end;
{$IFDEF VerboseAnchorDockRestore}
WriteDebugLayout('TAnchorDockMaster.LoadLayoutFromConfig ',Tree.Root);
DebugWriteChildAnchors(Tree.Root);
{$ENDIF}
// close all unneeded forms/controls (not helper controls like splitters)
if not CloseUnneededControls(Tree) then exit;
BeginUpdate;
try
// create all needed forms/controls (not helper controls like splitters)
if not CreateNeededControls(Tree,true,ControlNames) then exit;
// simplify layouts
ControlNames.Sort;
{$IFDEF VerboseAnchorDockRestore}
debugln(['TAnchorDockMaster.LoadLayoutFromConfig controls: ']);
debugln(ControlNames.Text);
{$ENDIF}
// if some forms/controls could not be created the layout needs to be adapted
Tree.Root.Simplify(ControlNames);
// reuse existing sites to reduce flickering
MapTreeToControls(Tree);
{$IFDEF VerboseAnchorDockRestore}
fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.LoadLayoutFromConfig Map');
{$ENDIF}
// create sites, move controls
RestoreLayout(Tree,Scale);
finally
EndUpdate;
end;
finally
// clean up
FreeAndNil(fTreeNameToDocker);
ControlNames.Free;
Tree.Free;
// commit (this can raise an exception)
EnableAllAutoSizing;
end;
{$IFDEF VerboseAnchorDockRestore}
DebugWriteChildAnchors(Application.MainForm,true,false);
{$ENDIF}
Result:=true;
end;
procedure TAnchorDockMaster.LoadSettingsFromConfig(Config: TConfigStorage);
var
Settings: TAnchorDockSettings;

5
components/anchordocking/anchordockoptionsdlg.pas
View File

@ -34,8 +34,9 @@ unit AnchorDockOptionsDlg;
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
StdCtrls, ComCtrls, LCLProc, AnchorDocking, AnchorDockStr, types;
Classes, SysUtils, types,
Forms, Controls, ButtonPanel, StdCtrls, ComCtrls,
AnchorDocking, AnchorDockStr;
type
TAnchorDockOptionsFlag = (

273
components/anchordocking/anchordockstorage.pas
View File

@ -34,8 +34,9 @@ Unit AnchorDockStorage;
interface
uses
Math, Classes, SysUtils, LCLProc, AvgLvlTree, ExtCtrls, ComCtrls, Forms,
Controls, LazConfigStorage, AnchorDockStr, Laz2_XMLCfg;
Math, Classes, SysUtils, LCLProc, ExtCtrls, ComCtrls, Forms, Controls,
AvgLvlTree, LazConfigStorage, Laz2_XMLCfg,
AnchorDockStr;
const
AnchorDockSplitterName = 'AnchorDockSplitter';
@ -111,10 +112,12 @@ type
destructor Destroy; override;
procedure Clear;
function IsEqual(Node: TAnchorDockLayoutTreeNode): boolean;
procedure Assign(Node: TAnchorDockLayoutTreeNode);
procedure Assign(AControl: TControl);
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig);
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig);
procedure Assign(Node: TAnchorDockLayoutTreeNode); overload;
procedure Assign(AControl: TControl); overload;
procedure LoadFromConfig(Config: TConfigStorage); overload;
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload;
procedure SaveToConfig(Config: TConfigStorage); overload;
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload;
function FindChildNode(aName: string; Recursive: boolean): TAnchorDockLayoutTreeNode;
function FindControlNode: TAnchorDockLayoutTreeNode;
procedure CheckConsistency; virtual;
@ -181,14 +184,16 @@ type
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig);
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig);
procedure Assign(Source: TObject);
procedure LoadFromConfig(Config: TConfigStorage); overload;
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload;
procedure SaveToConfig(Config: TConfigStorage); overload;
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload;
procedure IncreaseChangeStamp;
property ChangeStamp: int64 read FChangeStamp;
property Modified: boolean read GetModified write SetModified;
property Root: TAnchorDockLayoutTreeRootNode read FRoot;
function NewNode(aParent: TAnchorDockLayoutTreeNode): TAnchorDockLayoutTreeNode;
procedure Assign(Source: TObject);
end;
{ TAnchorDockRestoreLayout }
@ -202,13 +207,15 @@ type
constructor Create; overload;
constructor Create(aLayout: TAnchorDockLayoutTree); overload;
destructor Destroy; override;
procedure Assign(Source: TAnchorDockRestoreLayout);
function IndexOfControlName(AName: string): integer;
function HasControlName(AName: string): boolean;
procedure RemoveControlName(AName: string);
procedure UpdateControlNames;
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig);
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig);
procedure Assign(Source: TAnchorDockRestoreLayout);
procedure LoadFromConfig(Config: TConfigStorage); overload;
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload;
procedure SaveToConfig(Config: TConfigStorage); overload;
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload;
property ControlNames: TStrings read FControlNames write SetControlNames;
property Layout: TAnchorDockLayoutTree read FLayout;
end;
@ -223,16 +230,18 @@ type
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Assign(Source: TAnchorDockRestoreLayouts);
procedure Delete(Index: integer);
function IndexOfName(AControlName: string): integer;
function FindByName(AControlName: string): TAnchorDockRestoreLayout;
procedure Add(Layout: TAnchorDockRestoreLayout; RemoveOther: boolean);
procedure RemoveByName(AControlName: string);
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig);
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig);
procedure LoadFromConfig(Config: TConfigStorage); overload;
procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload;
procedure SaveToConfig(Config: TConfigStorage); overload;
procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload;
function ConfigIsEmpty(Config: TConfigStorage): boolean;
function Count: integer;
procedure Assign(Source: TAnchorDockRestoreLayouts);
property Items[Index: integer]: TAnchorDockRestoreLayout read GetItems; default;
end;
@ -1130,8 +1139,41 @@ begin
end;
end;
procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Config: TConfigStorage);
var
i: Integer;
Child: TAnchorDockLayoutTreeNode;
NewCount: longint;
begin
Clear;
Name:=Config.GetValue('Name','');
NodeType:=NameToADLTreeNodeType(Config.GetValue('Type',ADLTreeNodeTypeNames[adltnNone]));
Left:=Config.GetValue('Bounds/Left',0);
Top:=Config.GetValue('Bounds/Top',0);
Width:=Config.GetValue('Bounds/Width',0);
Height:=Config.GetValue('Bounds/Height',0);
BoundSplitterPos:=Config.GetValue('Bounds/SplitterPos',0);
Config.GetValue('Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0));
Anchors[akLeft]:=Config.GetValue('Anchors/Left','');
Anchors[akTop]:=Config.GetValue('Anchors/Top','');
Anchors[akRight]:=Config.GetValue('Anchors/Right','');
Anchors[akBottom]:=Config.GetValue('Anchors/Bottom','');
Align:=NameToADLAlign(Config.GetValue('Anchors/Align',dbgs(alNone)));
WindowState:=NameToADLWindowState(Config.GetValue('WindowState',ADLWindowStateNames[wsNormal]));
HeaderPosition:=NameToADLHeaderPosition(Config.GetValue('Header/Position',ADLHeaderPositionNames[adlhpAuto]));
TabPosition:=NameToADLTabPosition(Config.GetValue('Header/TabPosition',ADLTabPostionNames[tpTop]));
Monitor:=Config.GetValue('Monitor',0);
NewCount:=Config.GetValue('ChildCount',0);
for i:=1 to NewCount do begin
Config.AppendBasePath('Item'+IntToStr(i)+'/');
Child:=TAnchorDockLayoutTreeNode.Create;
Child.Parent:=Self;
Child.LoadFromConfig(Config);
Config.UndoAppendBasePath;
end;
end;
procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Path: string; Config: TRttiXMLConfig);
var
i: Integer;
Child: TAnchorDockLayoutTreeNode;
@ -1156,21 +1198,54 @@ begin
TabPosition:=NameToADLTabPosition(Config.GetValue(Path+'Header/TabPosition',ADLTabPostionNames[tpTop]));
Monitor:=Config.GetValue(Path+'Monitor',0);
NewCount:=Config.GetValue(Path+'ChildCount',0);
for i:=1 to NewCount do begin
for i:=1 to NewCount do
begin
Child:=TAnchorDockLayoutTreeNode.Create;
Child.Parent:=Self;
Child.LoadFromConfig(Path+'Item'+IntToStr(i)+'/', Config);
end;
end;
procedure TAnchorDockLayoutTreeNode.SaveToConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockLayoutTreeNode.SaveToConfig(Config: TConfigStorage);
var
i: Integer;
begin
Config.SetDeleteValue('Name',Name,'');
Config.SetDeleteValue('Type',ADLTreeNodeTypeNames[NodeType],
ADLTreeNodeTypeNames[adltnNone]);
Config.SetDeleteValue('Bounds/Left',Left,0);
Config.SetDeleteValue('Bounds/Top',Top,0);
Config.SetDeleteValue('Bounds/Width',Width,0);
Config.SetDeleteValue('Bounds/Height',Height,0);
Config.SetDeleteValue('Bounds/SplitterPos',BoundSplitterPos,0);
Config.SetDeleteValue('Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0));
Config.SetDeleteValue('Anchors/Left',Anchors[akLeft],'');
Config.SetDeleteValue('Anchors/Top',Anchors[akTop],'');
Config.SetDeleteValue('Anchors/Right',Anchors[akRight],'');
Config.SetDeleteValue('Anchors/Bottom',Anchors[akBottom],'');
Config.SetDeleteValue('Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]);
Config.SetDeleteValue('WindowState',ADLWindowStateNames[WindowState],
ADLWindowStateNames[wsNormal]);
Config.SetDeleteValue('Header/Position',ADLHeaderPositionNames[HeaderPosition],
ADLHeaderPositionNames[adlhpAuto]);
Config.SetDeleteValue('Header/TabPosition',ADLTabPostionNames[TabPosition],
ADLTabPostionNames[tpTop]);
Config.SetDeleteValue('Monitor',Monitor,0);
Config.SetDeleteValue('ChildCount',Count,0);
for i:=1 to Count do begin
Config.AppendBasePath('Item'+IntToStr(i)+'/');
Nodes[i-1].SaveToConfig(Config);
Config.UndoAppendBasePath;
end;
end;
procedure TAnchorDockLayoutTreeNode.SaveToConfig(Path: string; Config: TRttiXMLConfig);
var
i: Integer;
begin
Config.SetDeleteValue(Path+'Name',Name,'');
Config.SetDeleteValue(Path+'Type',ADLTreeNodeTypeNames[NodeType],
ADLTreeNodeTypeNames[adltnNone]);
ADLTreeNodeTypeNames[adltnNone]);
Config.SetDeleteValue(Path+'Bounds/Left',Left,0);
Config.SetDeleteValue(Path+'Bounds/Top',Top,0);
Config.SetDeleteValue(Path+'Bounds/Width',Width,0);
@ -1183,16 +1258,15 @@ begin
Config.SetDeleteValue(Path+'Anchors/Bottom',Anchors[akBottom],'');
Config.SetDeleteValue(Path+'Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]);
Config.SetDeleteValue(Path+'WindowState',ADLWindowStateNames[WindowState],
ADLWindowStateNames[wsNormal]);
ADLWindowStateNames[wsNormal]);
Config.SetDeleteValue(Path+'Header/Position',ADLHeaderPositionNames[HeaderPosition],
ADLHeaderPositionNames[adlhpAuto]);
ADLHeaderPositionNames[adlhpAuto]);
Config.SetDeleteValue(Path+'Header/TabPosition',ADLTabPostionNames[TabPosition],
ADLTabPostionNames[tpTop]);
ADLTabPostionNames[tpTop]);
Config.SetDeleteValue(Path+'Monitor',Monitor,0);
Config.SetDeleteValue(Path+'ChildCount',Count,0);
for i:=1 to Count do begin
for i:=1 to Count do
Nodes[i-1].SaveToConfig(Path+'Item'+IntToStr(i)+'/', Config);
end;
end;
function TAnchorDockLayoutTreeNode.FindChildNode(aName: string;
@ -1665,15 +1739,28 @@ begin
Modified:=false;
end;
procedure TAnchorDockLayoutTree.LoadFromConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockLayoutTree.LoadFromConfig(Config: TConfigStorage);
begin
Config.AppendBasePath('Nodes/');
FRoot.LoadFromConfig(Config);
Config.UndoAppendBasePath;
Root.CheckConsistency;
end;
procedure TAnchorDockLayoutTree.LoadFromConfig(Path: string; Config: TRttiXMLConfig);
begin
FRoot.LoadFromConfig(Path+'Nodes/',Config);
Root.CheckConsistency;
end;
procedure TAnchorDockLayoutTree.SaveToConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockLayoutTree.SaveToConfig(Config: TConfigStorage);
begin
Config.AppendBasePath('Nodes/');
FRoot.SaveToConfig(Config);
Config.UndoAppendBasePath;
end;
procedure TAnchorDockLayoutTree.SaveToConfig(Path: string; Config: TRttiXMLConfig);
begin
FRoot.SaveToConfig(Path+'Nodes/',Config);
end;
@ -1798,12 +1885,6 @@ begin
FLayout:=TAnchorDockLayoutTree.Create;
end;
procedure TAnchorDockRestoreLayout.Assign(Source: TAnchorDockRestoreLayout);
begin
FControlNames.Assign(Source.FControlNames);
FLayout.Assign(Source.FLayout);
end;
constructor TAnchorDockRestoreLayout.Create(aLayout: TAnchorDockLayoutTree);
begin
FControlNames:=TStringList.Create;
@ -1818,6 +1899,12 @@ begin
inherited Destroy;
end;
procedure TAnchorDockRestoreLayout.Assign(Source: TAnchorDockRestoreLayout);
begin
FControlNames.Assign(Source.FControlNames);
FLayout.Assign(Source.FLayout);
end;
function TAnchorDockRestoreLayout.IndexOfControlName(AName: string): integer;
begin
Result:=fControlNames.Count-1;
@ -1857,8 +1944,29 @@ begin
Check(Layout.Root);
end;
procedure TAnchorDockRestoreLayout.LoadFromConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockRestoreLayout.LoadFromConfig(Config: TConfigStorage);
var
i: Integer;
AName: string;
Node: TAnchorDockLayoutTreeNode;
begin
FControlNames.Delimiter:=',';
FControlNames.StrictDelimiter:=true;
FControlNames.DelimitedText:=Config.GetValue('Names','');
Layout.LoadFromConfig(Config);
for i:=FControlNames.Count-1 downto 0 do begin
AName:=FControlNames[i];
if (AName<>'') and IsValidIdent(AName)
and (Layout.Root<>nil) then begin
Node:=Layout.Root.FindChildNode(AName,true);
if (Node<>nil) and (Node.NodeType in [adltnControl,adltnCustomSite]) then
continue;
end;
FControlNames.Delete(i);
end;
end;
procedure TAnchorDockRestoreLayout.LoadFromConfig(Path: string; Config: TRttiXMLConfig);
var
i: Integer;
AName: string;
@ -1880,8 +1988,15 @@ begin
end;
end;
procedure TAnchorDockRestoreLayout.SaveToConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockRestoreLayout.SaveToConfig(Config: TConfigStorage);
begin
FControlNames.Delimiter:=',';
FControlNames.StrictDelimiter:=true;
Config.SetDeleteValue('Names',FControlNames.DelimitedText,'');
Layout.SaveToConfig(Config);
end;
procedure TAnchorDockRestoreLayout.SaveToConfig(Path: string; Config: TRttiXMLConfig);
begin
FControlNames.Delimiter:=',';
FControlNames.StrictDelimiter:=true;
@ -1891,8 +2006,7 @@ end;
{ TAnchorDockRestoreLayouts }
function TAnchorDockRestoreLayouts.GetItems(Index: integer
): TAnchorDockRestoreLayout;
function TAnchorDockRestoreLayouts.GetItems(Index: integer): TAnchorDockRestoreLayout;
begin
Result:=TAnchorDockRestoreLayout(fItems[Index]);
end;
@ -1918,6 +2032,20 @@ begin
fItems.Clear;
end;
procedure TAnchorDockRestoreLayouts.Assign(Source: TAnchorDockRestoreLayouts);
var
i: Integer;
xNew: TAnchorDockRestoreLayout;
begin
Clear;
for i := 0 to Source.Count-1 do
begin
xNew := TAnchorDockRestoreLayout.Create;
Add(xNew, False);
xNew.Assign(Source[i]);
end;
end;
procedure TAnchorDockRestoreLayouts.Delete(Index: integer);
begin
TObject(fItems[Index]).Free;
@ -1956,20 +2084,6 @@ begin
fItems.Add(Layout);
end;
procedure TAnchorDockRestoreLayouts.Assign(Source: TAnchorDockRestoreLayouts);
var
I: Integer;
xNew: TAnchorDockRestoreLayout;
begin
Clear;
for I := 0 to Source.Count-1 do
begin
xNew := TAnchorDockRestoreLayout.Create;
Add(xNew, False);
xNew.Assign(Source[I]);
end;
end;
procedure TAnchorDockRestoreLayouts.RemoveByName(AControlName: string);
var
i: Integer;
@ -1983,8 +2097,45 @@ begin
end;
end;
procedure TAnchorDockRestoreLayouts.LoadFromConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockRestoreLayouts.LoadFromConfig(Config: TConfigStorage);
var
NewCount: longint;
NewItem: TAnchorDockRestoreLayout;
i: Integer;
begin
Clear;
NewCount:=Config.GetValue('Count',0);
for i:=1 to NewCount do begin
NewItem:=TAnchorDockRestoreLayout.Create;
Config.AppendBasePath('Item'+IntToStr(i+1)+'/');
try
NewItem.LoadFromConfig(Config);
finally
Config.UndoAppendBasePath;
end;
if NewItem.ControlNames.Count>0 then
fItems.Add(NewItem)
else
NewItem.Free;
end;
end;
procedure TAnchorDockRestoreLayouts.SaveToConfig(Config: TConfigStorage);
var
i: Integer;
begin
Config.SetDeleteValue('Count',Count,0);
for i:=0 to Count-1 do begin
Config.AppendBasePath('Item'+IntToStr(i+1)+'/');
try
Items[i].SaveToConfig(Config);
finally
Config.UndoAppendBasePath;
end;
end;
end;
procedure TAnchorDockRestoreLayouts.LoadFromConfig(Path: string; Config: TRttiXMLConfig);
var
NewCount: longint;
NewItem: TAnchorDockRestoreLayout;
@ -2002,8 +2153,7 @@ begin
end;
end;
procedure TAnchorDockRestoreLayouts.SaveToConfig(Path: string;
Config: TRttiXMLConfig);
procedure TAnchorDockRestoreLayouts.SaveToConfig(Path: string; Config: TRttiXMLConfig);
var
i: Integer;
begin
@ -2013,8 +2163,7 @@ begin
end;
end;
function TAnchorDockRestoreLayouts.ConfigIsEmpty(Config: TConfigStorage
): boolean;
function TAnchorDockRestoreLayouts.ConfigIsEmpty(Config: TConfigStorage): boolean;
begin
Result:=Config.GetValue('Count',0)<=0;
end;

10
components/anchordocking/design/anchordockingdsgn.lpk
View File

@ -19,12 +19,20 @@
<License Value="GPL2 as the IDE
"/>
<Version Minor="5"/>
<Files Count="1">
<Files Count="3">
<Item1>
<Filename Value="registeranchordocking.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="RegisterAnchorDocking"/>
</Item1>
<Item2>
<Filename Value="registeranchordocking.lfm"/>
<Type Value="LFM"/>
</Item2>
<Item3>
<Filename Value="anchordesktopoptions.pas"/>
<UnitName Value="AnchorDesktopOptions"/>
</Item3>
</Files>
<RequiredPkgs Count="2">
<Item1>

12
components/anchordocking/design/anchordockingdsgn.pas
View File

@ -2,20 +2,20 @@
This source is only used to compile and install the package.
}
unit AnchorDockingDsgn;
unit AnchorDockingDsgn;
interface
uses
RegisterAnchorDocking, LazarusPackageIntf;
RegisterAnchorDocking, AnchorDesktopOptions, LazarusPackageIntf;
implementation
procedure Register;
procedure Register;
begin
RegisterUnit('RegisterAnchorDocking', @RegisterAnchorDocking.Register);
end;
RegisterUnit('RegisterAnchorDocking', @RegisterAnchorDocking.Register);
end;
initialization
RegisterPackage('AnchorDockingDsgn', @Register);
RegisterPackage('AnchorDockingDsgn', @Register);
end.

14
components/anchordocking/design/registeranchordocking.pas
View File

@ -36,11 +36,15 @@ unit RegisterAnchorDocking;
interface
uses
Math, Classes, SysUtils, LCLProc, Forms, Controls, FileUtil, LazFileCache,
Dialogs, LazConfigStorage, LazFileUtils, StdCtrls,
LCLIntf, BaseIDEIntf, ProjectIntf,
LazIDEIntf, IDEWindowIntf, IDEOptionsIntf, AnchorDockStr, AnchorDocking,
AnchorDockOptionsDlg;
Math, Classes, SysUtils,
// LCL
LCLProc, Forms, Controls, Dialogs, StdCtrls,
// LazUtils
LazFileCache, LazConfigStorage, LazFileUtils,
// IdeIntf
LCLIntf, BaseIDEIntf, IDEWindowIntf, IDEOptionsIntf,
// AnchorDocking
AnchorDockStr, AnchorDocking, AnchorDesktopOptions, AnchorDockOptionsDlg;
const
DefaultConfigFileName = 'anchordockoptions.xml';

3
components/anchordocking/minide/miniide1.lpr
View File

@ -7,8 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, Controls, FileUtil
{ you can add units after this };
Forms, Unit1, Controls, LazUTF8;
{$R *.res}

8
components/anchordocking/minide/unit1.pas
View File

@ -5,9 +5,11 @@ unit Unit1;
interface
uses
Classes, SysUtils, LCLProc, FileUtil, Forms, Controls, Graphics, Dialogs,
Menus, ExtCtrls, Buttons, ComCtrls, SimpleFrm, AnchorDocking,
AnchorDockStorage, XMLPropStorage, StdCtrls, AnchorDockOptionsDlg;
Classes, SysUtils,
LCLProc, Forms, Controls, Graphics, Dialogs, StdCtrls,
Menus, ExtCtrls, Buttons, ComCtrls, XMLPropStorage,
LazFileUtils,
SimpleFrm, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg;
type