dexed/etc/anchordocking/xanchordockstorage.pas

2179 lines
67 KiB
Plaintext

{ Unit implementing anchor docking storage tree.
Copyright (C) 2010 Mattias Gaertner mattias@freepascal.org
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
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
Unit xAnchorDockStorage;
{$mode objfpc}{$H+}
interface
uses
Math, Classes, SysUtils, LCLProc, ExtCtrls, ComCtrls, Forms, Controls,
AvgLvlTree, LazConfigStorage, Laz2_XMLCfg,
xAnchorDockStr;
const
AnchorDockSplitterName = 'AnchorDockSplitter';
AnchorDockSiteName = 'AnchorDockSite';
type
TADLTreeNodeType = (
adltnNone,
adltnLayout,
adltnControl,
adltnSplitterHorizontal,
adltnSplitterVertical,
adltnPages,
adltnCustomSite
);
TADLTreeNodeTypes = set of TADLTreeNodeType;
TADLHeaderPosition = (
adlhpAuto,
adlhpTop,
adlhpLeft,
adlhpRight,
adlhpBottom
);
TADLHeaderPositions = set of TADLHeaderPosition;
EAnchorDockLayoutError = class(Exception);
{ TAnchorDockLayoutTreeNode }
TAnchorDockLayoutTreeNode = class
private
FAlign: TAlign;
fAnchors: array[TAnchorKind] of string;
FBoundSplitterPos: integer;
FBoundsRect: TRect;
FHeaderPosition: TADLHeaderPosition;
FMonitor: integer;
FName: string;
FNodes: TFPList; // list of TAnchorDockLayoutTreeNode
FNodeType: TADLTreeNodeType;
FParent: TAnchorDockLayoutTreeNode;
FWorkAreaRect: TRect;
FTabPosition: TTabPosition;
FWindowState: TWindowState;
function GetAnchors(Site: TAnchorKind): string;
function GetBottom: integer;
function GetHeight: integer;
function GetLeft: integer;
function GetNodes(Index: integer): TAnchorDockLayoutTreeNode;
function GetRight: integer;
function GetTop: integer;
function GetWidth: integer;
procedure SetAlign(const AValue: TAlign);
procedure SetAnchors(Site: TAnchorKind; const AValue: string);
procedure SetBottom(const AValue: integer);
procedure SetBoundSplitterPos(const AValue: integer);
procedure SetBoundsRect(const AValue: TRect);
procedure SetHeaderPosition(const AValue: TADLHeaderPosition);
procedure SetHeight(const AValue: integer);
procedure SetLeft(const AValue: integer);
procedure SetMonitor(const AValue: integer);
procedure SetName(const AValue: string);
procedure SetNodeType(const AValue: TADLTreeNodeType);
procedure SetParent(const AValue: TAnchorDockLayoutTreeNode);
procedure SetRight(const AValue: integer);
procedure SetWorkAreaRect(const AValue: TRect);
procedure SetTabPosition(const AValue: TTabPosition);
procedure SetTop(const AValue: integer);
procedure SetWidth(const AValue: integer);
procedure SetWindowState(const AValue: TWindowState);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function IsEqual(Node: TAnchorDockLayoutTreeNode): boolean;
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;
// simplifying
procedure Simplify(ExistingNames: TStrings);
procedure DeleteNode(ChildNode: TAnchorDockLayoutTreeNode);
function FindNodeBoundSplitter(ChildNode: TAnchorDockLayoutTreeNode;
Side: TAnchorKind): TAnchorDockLayoutTreeNode;
procedure DeleteNodeBoundSplitter(Splitter, ChildNode: TAnchorDockLayoutTreeNode;
Side: TAnchorKind);
procedure DeleteSpiralSplitter(ChildNode: TAnchorDockLayoutTreeNode);
procedure ReplaceWithChildren(ChildNode: TAnchorDockLayoutTreeNode);
// properties
procedure IncreaseChangeStamp; virtual;
property Name: string read FName write SetName;
property NodeType: TADLTreeNodeType read FNodeType write SetNodeType;
property Parent: TAnchorDockLayoutTreeNode read FParent write SetParent;
property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop;
property Width: integer read GetWidth write SetWidth;
property Height: integer read GetHeight write SetHeight;
property Right: integer read GetRight write SetRight;
property Bottom: integer read GetBottom write SetBottom;
property BoundsRect: TRect read FBoundsRect write SetBoundsRect;
property BoundSplitterPos: integer read FBoundSplitterPos write SetBoundSplitterPos;
property WorkAreaRect: TRect read FWorkAreaRect write SetWorkAreaRect;
property Anchors[Site: TAnchorKind]: string read GetAnchors write SetAnchors; // empty means default (parent)
property Align: TAlign read FAlign write SetAlign;
property WindowState: TWindowState read FWindowState write SetWindowState;
property Monitor: integer read FMonitor write SetMonitor;
property HeaderPosition: TADLHeaderPosition read FHeaderPosition write SetHeaderPosition;
property TabPosition: TTabPosition read FTabPosition write SetTabPosition;
function Count: integer;
function IsSplitter: boolean;
function IsRootWindow: boolean;
property Nodes[Index: integer]: TAnchorDockLayoutTreeNode read GetNodes; default;
end;
TAnchorDockLayoutTree = class;
{ TAnchorDockLayoutTreeRootNode }
TAnchorDockLayoutTreeRootNode = class(TAnchorDockLayoutTreeNode)
private
FTree: TAnchorDockLayoutTree;
public
procedure IncreaseChangeStamp; override;
property Tree: TAnchorDockLayoutTree read FTree write FTree;
procedure CheckConsistency; override;
end;
{ TAnchorDockLayoutTree }
TAnchorDockLayoutTree = class
private
FChangeStamp: int64;
FSavedChangeStamp: int64;
FRoot: TAnchorDockLayoutTreeRootNode;
function GetModified: boolean;
procedure SetModified(const AValue: boolean);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
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;
end;
{ TAnchorDockRestoreLayout }
TAnchorDockRestoreLayout = class
private
FControlNames: TStrings;
FLayout: TAnchorDockLayoutTree;
procedure SetControlNames(const AValue: TStrings);
public
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(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;
{ TAnchorDockRestoreLayouts }
TAnchorDockRestoreLayouts = class
private
fItems: TFPList;
function GetItems(Index: integer): TAnchorDockRestoreLayout;
public
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(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;
property Items[Index: integer]: TAnchorDockRestoreLayout read GetItems; default;
end;
{ TADNameToControl }
TADNameToControl = class
private
fItems: TStringList;
function IndexOfName(const aName: string): integer;
function GetControl(const aName: string): TControl;
procedure SetControl(const aName: string; const AValue: TControl);
public
constructor Create;
destructor Destroy; override;
function ControlToName(AControl: TControl): string;
property Control[const aName: string]: TControl read GetControl write SetControl; default;
procedure RemoveControl(AControl: TControl);
procedure WriteDebugReport(Msg: string);
end;
const
ADLTreeNodeTypeNames: array[TADLTreeNodeType] of string = (
'None',
'Layout',
'Control',
'SplitterHorizontal',
'SplitterVertical',
'Pages',
'CustomSite'
);
ADLWindowStateNames: array[TWindowState] of string = (
'Normal',
'Minimized',
'Maximized',
'Fullscreen'
);
ADLHeaderPositionNames: array[TADLHeaderPosition] of string = (
'auto',
'left',
'top',
'right',
'bottom'
);
ADLTabPostionNames: array[TTabPosition] of string = (
'Top',
'Bottom',
'Left',
'Right'
);
ADLAlignNames: array[TAlign] of string = (
'None',
'Top',
'Bottom',
'Left',
'Right',
'Client',
'Custom'
);
function NameToADLTreeNodeType(s: string): TADLTreeNodeType;
function NameToADLWindowState(s: string): TWindowState;
function NameToADLHeaderPosition(s: string): TADLHeaderPosition;
function NameToADLTabPosition(s: string): TTabPosition;
function NameToADLAlign(s: string): TAlign;
function dbgs(const NodeType: TADLTreeNodeType): string; overload;
procedure WriteDebugLayout(Title: string; RootNode: TObject);
function DebugLayoutAsString(RootNode: TObject): string;
procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode); overload;
procedure DebugWriteChildAnchors(RootControl: TWinControl;
OnlyWinControls, OnlyForms: boolean); overload;
implementation
function NameToADLTreeNodeType(s: string): TADLTreeNodeType;
begin
for Result:=low(TADLTreeNodeType) to high(TADLTreeNodeType) do
if s=ADLTreeNodeTypeNames[Result] then exit;
Result:=adltnNone;
end;
function NameToADLWindowState(s: string): TWindowState;
begin
for Result:=low(TWindowState) to high(TWindowState) do
if s=ADLWindowStateNames[Result] then exit;
Result:=wsNormal;
end;
function NameToADLHeaderPosition(s: string): TADLHeaderPosition;
begin
for Result:=low(TADLHeaderPosition) to high(TADLHeaderPosition) do
if s=ADLHeaderPositionNames[Result] then exit;
Result:=adlhpAuto;
end;
function NameToADLTabPosition(s: string): TTabPosition;
begin
for Result:=low(TTabPosition) to high(TTabPosition) do
if s=ADLTabPostionNames[Result] then exit;
Result:=tpTop;
end;
function NameToADLAlign(s: string): TAlign;
begin
for Result:=low(TAlign) to high(TAlign) do
if s=ADLAlignNames[Result] then exit;
Result:=alNone;
end;
function dbgs(const NodeType: TADLTreeNodeType): string; overload;
begin
Result:=ADLTreeNodeTypeNames[NodeType];
end;
procedure WriteDebugLayout(Title: string; RootNode: TObject);
begin
debugln(['WriteDebugLayout ',Title,':']);
debugln(DebugLayoutAsString(RootNode));
end;
function DebugLayoutAsString(RootNode: TObject): string;
type
TNodeInfo = record
MinSize: TPoint;
MinSizeValid, MinSizeCalculating: boolean;
MinLeft: integer;
MinLeftValid, MinLeftCalculating: boolean;
MinTop: Integer;
MinTopValid, MinTopCalculating: boolean;
end;
PNodeInfo = ^TNodeInfo;
var
Cols: LongInt;
Rows: LongInt;
LogCols: Integer;
NodeInfos: TPointerToPointerTree;// TObject to PNodeInfo
procedure InitNodeInfos;
begin
NodeInfos:=TPointerToPointerTree.Create;
end;
procedure FreeNodeInfos;
var
Item: PNodeInfo;
NodePtr, InfoPtr: Pointer;
begin
NodeInfos.GetFirst(NodePtr,InfoPtr);
repeat
Item:=PNodeInfo(InfoPtr);
if Item=nil then break;
Dispose(Item);
until not NodeInfos.GetNext(NodePtr,NodePtr,InfoPtr);
NodeInfos.Free;
end;
function GetNodeInfo(Node: TObject): PNodeInfo;
begin
Result:=PNodeInfo(NodeInfos[Node]);
if Result=nil then begin
New(Result);
FillChar(Result^,SizeOf(TNodeInfo),0);
NodeInfos[Node]:=Result;
end;
end;
procedure w(x,y: Integer; const s: string; MaxX: Integer = 0);
var
i: Integer;
begin
for i:=1 to length(s) do begin
if (MaxX>0) and (x+i>MaxX) then exit;
Result[LogCols*(y-1) + x + i-1]:=s[i];
end;
end;
procedure wfillrect(const ARect: TRect; c: char);
var
x: LongInt;
y: LongInt;
begin
for x:=ARect.Left to ARect.Right do
for y:=ARect.Top to ARect.Bottom do
w(x,y,c);
end;
procedure wrectangle(const ARect: TRect);
begin
w(ARect.Left,ARect.Top,'+');
w(ARect.Right,ARect.Top,'+');
w(ARect.Left,ARect.Bottom,'+');
w(ARect.Right,ARect.Bottom,'+');
if ARect.Left<ARect.Right then begin
if ARect.Top<ARect.Bottom then begin
wfillrect(Rect(ARect.Left+1,ARect.Top,ARect.Right-1,ARect.Top),'-');// top line
wfillrect(Rect(ARect.Left+1,ARect.Bottom,ARect.Right-1,ARect.Bottom),'-');// bottom line
wfillrect(Rect(ARect.Left,ARect.Top+1,ARect.Left,ARect.Bottom-1),'|');// left line
wfillrect(Rect(ARect.Right,ARect.Top+1,ARect.Right,ARect.Bottom-1),'|');// right line
end else begin
wfillrect(Rect(ARect.Left+1,ARect.Top,ARect.Right-1,ARect.Top),'=');// horizontal line
end;
end else begin
wfillrect(Rect(ARect.Left,ARect.Top+1,ARect.Left,ARect.Bottom-1),'#');// vertical line
end;
end;
function MapRect(const OriginalRect, OldBounds, NewBounds: TRect): TRect;
function MapX(i: Integer): Integer;
begin
Result:=NewBounds.Left+
(((i-OldBounds.Left)*(NewBounds.Right-NewBounds.Left))
div (OldBounds.Right-OldBounds.Left));
end;
function MapY(i: Integer): Integer;
begin
Result:=NewBounds.Top+
(((i-OldBounds.Top)*(NewBounds.Bottom-NewBounds.Top))
div (OldBounds.Bottom-OldBounds.Top));
end;
begin
Result.Left:=MapX(OriginalRect.Left);
Result.Top:=MapY(OriginalRect.Left);
Result.Right:=MapX(OriginalRect.Left);
Result.Bottom:=MapY(OriginalRect.Left);
end;
function GetParentNode(Node: TObject): TObject;
begin
if Node is TControl then
Result:=TControl(Node).Parent
else if Node is TAnchorDockLayoutTreeNode then
Result:=TAnchorDockLayoutTreeNode(Node).Parent
else
Result:=nil;
end;
function GetSiblingNode(Node: TObject; Side: TAnchorKind): TObject;
begin
Result:=nil;
if Node=nil then exit;
if Node is TControl then begin
if not (Side in TControl(Node).Anchors) then exit;
Result:=TControl(Node).AnchorSide[Side].Control;
if Result=TControl(Node).Parent then
Result:=nil;
end else if Node is TAnchorDockLayoutTreeNode then begin
if TAnchorDockLayoutTreeNode(Node).Parent<>nil then
Result:=TAnchorDockLayoutTreeNode(Node).Parent.FindChildNode(
TAnchorDockLayoutTreeNode(Node).Anchors[Side],false);
end;
end;
function GetAnchorNode(Node: TObject; Side: TAnchorKind): TObject;
var
ADLNode: TAnchorDockLayoutTreeNode;
begin
Result:=nil;
if Node=nil then exit;
if Node is TControl then begin
if not (Side in TControl(Node).Anchors) then exit;
Result:=TControl(Node).AnchorSide[Side].Control;
end else if Node is TAnchorDockLayoutTreeNode then begin
ADLNode:=TAnchorDockLayoutTreeNode(Node);
if ((ADLNode.NodeType=adltnSplitterVertical)
and (Side in [akLeft,akRight]))
or ((ADLNode.NodeType=adltnSplitterHorizontal)
and (Side in [akTop,akBottom]))
then
Result:=nil
else if (ADLNode.Anchors[Side]<>'') then begin
if ADLNode.Parent<>nil then
Result:=ADLNode.Parent.FindChildNode(
ADLNode.Anchors[Side],false);
end else
Result:=GetParentNode(Node);
end;
end;
function IsSplitter(Node: TObject): boolean;
begin
Result:=(Node is TCustomSplitter)
or ((Node is TAnchorDockLayoutTreeNode)
and (TAnchorDockLayoutTreeNode(Node).IsSplitter));
end;
function IsPages(Node: TObject): boolean;
begin
Result:=(Node is TCustomTabControl)
or ((Node is TAnchorDockLayoutTreeNode)
and (TAnchorDockLayoutTreeNode(Node).NodeType in [adltnPages,adltnNone]));
end;
function GetName(Node: TObject): string;
begin
if Node is TControl then
Result:=TControl(Node).Name
else if Node is TAnchorDockLayoutTreeNode then
Result:=TAnchorDockLayoutTreeNode(Node).Name
else
Result:=DbgSName(Node);
end;
function GetChildCount(Node: TObject): integer;
begin
if Node is TWinControl then
Result:=TWinControl(Node).ControlCount
else if Node is TAnchorDockLayoutTreeNode then
Result:=TAnchorDockLayoutTreeNode(Node).Count
else
Result:=0;
end;
function GetChild(Node: TObject; Index: integer): TObject;
begin
if Node is TWinControl then
Result:=TWinControl(Node).Controls[Index]
else if Node is TAnchorDockLayoutTreeNode then
Result:=TAnchorDockLayoutTreeNode(Node).Nodes[Index]
else
Result:=nil;
end;
function GetMinSize(Node: TObject): TPoint; forward;
function GetMinPos(Node: TObject; Side: TAnchorKind): Integer;
// calculates left or top position of Node
function Compute(var MinPosValid, MinPosCalculating: boolean;
var MinPos: Integer): Integer;
procedure Improve(Neighbour: TObject);
var
NeighbourPos: LongInt;
NeighbourSize: TPoint;
NeighbourLength: LongInt;
begin
if Neighbour=nil then exit;
if GetParentNode(Neighbour)<>GetParentNode(Node) then exit;
NeighbourPos:=GetMinPos(Neighbour,Side);
NeighbourSize:=GetMinSize(Neighbour);
if Side=akLeft then
NeighbourLength:=NeighbourSize.X
else
NeighbourLength:=NeighbourSize.Y;
MinPos:=Max(MinPos,NeighbourPos+NeighbourLength);
end;
var
Sibling: TObject;
i: Integer;
ParentNode: TObject;
begin
if MinPosCalculating then begin
DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected RootNode=',DbgSName(RootNode)]);
if RootNode is TWinControl then
DebugWriteChildAnchors(TWinControl(RootNode),true,true)
else if RootNode is TAnchorDockLayoutTreeNode then
DebugWriteChildAnchors(TAnchorDockLayoutTreeNode(RootNode));
RaiseGDBException('circle detected');
end;
if (not MinPosValid) then begin
MinPosValid:=true;
MinPosCalculating:=true;
Sibling:=GetSiblingNode(Node,Side);
if Sibling<>nil then
Improve(Sibling);
ParentNode:=GetParentNode(Node);
if ParentNode<>nil then begin
for i:=0 to GetChildCount(ParentNode)-1 do begin
Sibling:=GetChild(ParentNode,i);
if Node=GetSiblingNode(Sibling,OppositeAnchor[Side]) then
Improve(Sibling);
end;
end;
MinPosCalculating:=false;
end;
Result:=MinPos;
end;
var
Info: PNodeInfo;
begin
Info:=GetNodeInfo(Node);
//DebugLn(['GetMinPos ',Node.Name,' ',DbgS(Side),' ',Info^.MinLeftCalculating]);
if Side=akLeft then
Result:=Compute(Info^.MinLeftValid,Info^.MinLeftCalculating,Info^.MinLeft)
else
Result:=Compute(Info^.MinTopValid,Info^.MinTopCalculating,Info^.MinTop);
end;
function GetChildsMinSize(Node: TObject): TPoint;
// calculate the minimum size needed to draw the content of the node
var
i: Integer;
Child: TObject;
ChildMinSize: TPoint;
begin
//DebugLn(['GetChildsMinSize ',Node.name]);
Result:=Point(0,0);
if IsPages(Node) then begin
// maximum size of all pages
for i:=0 to GetChildCount(Node)-1 do begin
ChildMinSize:=GetMinSize(GetChild(Node,i));
Result.X:=Max(Result.X,ChildMinSize.X);
Result.Y:=Max(Result.Y,ChildMinSize.Y);
end;
end else begin
for i:=0 to GetChildCount(Node)-1 do begin
Child:=GetChild(Node,i);
ChildMinSize:=GetMinSize(Child);
Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildMinSize.X);
Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildMinSize.Y);
end;
end;
end;
function GetMinSize(Node: TObject): TPoint;
// calculate the minimum size needed to draw the node
var
ChildMinSize: TPoint;
Info: PNodeInfo;
begin
//DebugLn(['GetMinSize ',Node.name]);
Info:=GetNodeInfo(Node);
if Info^.MinSizeValid then begin
Result:=Info^.MinSize;
exit;
end;
if Info^.MinSizeCalculating then begin
DebugLn(['DebugLayoutAsString.GetMinSize WARNING: anchor circle detected']);
DumpStack;
Result:=Point(1,1);
exit;
end;
Info^.MinSizeCalculating:=true;
Result.X:=2+length(GetName(Node));// border plus name
Result.Y:=2; // border
if GetChildCount(Node)=0 then begin
if IsSplitter(Node) then
Result:=Point(1,1); // splitters don't need captions
end else begin
ChildMinSize:=GetChildsMinSize(Node);
Result.X:=Max(Result.X,ChildMinSize.X+2);
Result.Y:=Max(Result.Y,ChildMinSize.Y+2);
end;
//debugln(['GetMinSize ',GetName(Node),' Splitter=',IsSplitter(Node),' MinSize=',dbgs(Result)]);
Info^.MinSize:=Result;
Info^.MinSizeValid:=true;
Info^.MinSizeCalculating:=false;
end;
procedure DrawNode(Node: TObject; ARect: TRect);
var
i: Integer;
Child: TObject;
ChildSize: TPoint;
ChildRect: TRect;
AnchorNode: TObject;
begin
DebugLn(['DrawNode Node=',GetName(Node),' ARect=',dbgs(ARect)]);
wrectangle(ARect);
w(ARect.Left+1,ARect.Top,GetName(Node),ARect.Right);
for i := 0 to GetChildCount(Node)-1 do begin
Child:=GetChild(Node,i);
ChildRect.Left:=ARect.Left+1+GetMinPos(Child,akLeft);
ChildRect.Top:=ARect.Top+1+GetMinPos(Child,akTop);
ChildSize:=GetMinSize(Child);
ChildRect.Right:=ChildRect.Left+ChildSize.X-1;
ChildRect.Bottom:=ChildRect.Top+ChildSize.Y-1;
AnchorNode:=GetAnchorNode(Child,akRight);
if AnchorNode<>nil then begin
if AnchorNode=Node then
ChildRect.Right:=ARect.Right-1
else if GetParentNode(AnchorNode)=Node then
ChildRect.Right:=ARect.Left+1+GetMinPos(AnchorNode,akLeft)-1;
end;
AnchorNode:=GetAnchorNode(Child,akBottom);
if AnchorNode<>nil then begin
if AnchorNode=Node then
ChildRect.Bottom:=ARect.Bottom-1
else if GetParentNode(AnchorNode)=Node then
ChildRect.Bottom:=ARect.Top+1+GetMinPos(AnchorNode,akTop)-1;
end;
DrawNode(Child,ChildRect);
if IsPages(Node) then begin
// paint only one page
break;
end;
end;
end;
var
e: string;
y: Integer;
begin
Cols:=StrToIntDef(Application.GetOptionValue('ldcn-colunms'),79);
Rows:=StrToIntDef(Application.GetOptionValue('ldcn-rows'),20);
InitNodeInfos;
try
e:=LineEnding;
LogCols:=Cols+length(e);
SetLength(Result,LogCols*Rows);
// fill space
FillChar(Result[1],length(Result),' ');
// add line endings
for y:=1 to Rows do
w(Cols+1,y,e);
// draw node
DrawNode(RootNode,Rect(1,1,Cols,Rows));
finally
FreeNodeInfos;
end;
end;
procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode);
procedure WriteControl(Node: TAnchorDockLayoutTreeNode; Prefix: string);
var
i: Integer;
a: TAnchorKind;
AnchorControl: TAnchorDockLayoutTreeNode;
AnchorName: String;
begin
DbgOut(Prefix);
DbgOut('"'+Node.Name+'"');
DbgOut(' Type='+dbgs(Node.NodeType));
DbgOut(' Bounds=',dbgs(Node.BoundsRect)
,',w=',dbgs(Node.BoundsRect.Right-Node.BoundsRect.Left)
,',h=',dbgs(Node.BoundsRect.Bottom-Node.BoundsRect.Top));
if Node.WindowState<>wsNormal then
DbgOut(' WindowState=',dbgs(Node.WindowState));
if Node.Monitor<>0 then
DbgOut(' Monitor=',dbgs(Node.Monitor));
if Node.BoundSplitterPos<>0 then
DbgOut(' SplitterPos=',dbgs(Node.BoundSplitterPos));
if (Node.WorkAreaRect.Right>0) and (Node.WorkAreaRect.Bottom>0) then
DbgOut(' WorkArea=',dbgs(Node.WorkAreaRect));
debugln;
for a:=low(TAnchorKind) to high(TAnchorKind) do begin
if Node.Anchors[a]<>'' then
AnchorControl:=Node.Parent.FindChildNode(Node.Anchors[a],False)
else
AnchorControl:=nil;
if AnchorControl=nil then
AnchorName:='Parent'
else
AnchorName:=AnchorControl.Name;
debugln([Prefix,' ',dbgs(a),'=',AnchorName]);
end;
for i:=0 to Node.Count-1 do
WriteControl(Node[i],Prefix+' ');
end;
var
i: Integer;
begin
debugln(['DebugWriteChildAnchors RootNode="',RootNode.Name,'" Type=',dbgs(RootNode.NodeType)]);
for i:=0 to RootNode.Count-1 do
WriteControl(RootNode[i],' ');
end;
procedure DebugWriteChildAnchors(RootControl: TWinControl;
OnlyWinControls, OnlyForms: boolean); overload;
procedure WriteControl(AControl: TControl; Prefix: string);
var
i: Integer;
a: TAnchorKind;
AnchorControl: TControl;
AnchorName: String;
begin
if OnlyWinControls and (not (AControl is TWinControl)) then exit;
if OnlyForms and (not (AControl is TCustomForm)) then exit;
if not AControl.IsControlVisible then exit;
debugln([Prefix,DbgSName(AControl),' Caption="',dbgstr(AControl.Caption),'" Align=',dbgs(AControl.Align),' Bounds=',dbgs(AControl.BoundsRect)]);
for a:=low(TAnchorKind) to high(TAnchorKind) do begin
AnchorControl:=AControl.AnchorSide[a].Control;
if AnchorControl=AControl.Parent then
AnchorName:='Parent'
else if AnchorControl is TCustomForm then
AnchorName:='"'+AnchorControl.Name+'"'
else
AnchorName:=DbgSName(AnchorControl);
debugln([Prefix,' ',dbgs(a),'=',a in AControl.Anchors,' ',AnchorName,' ',dbgs(a,AControl.AnchorSide[a].Side)]);
end;
if AControl is TWinControl then begin
for i:=0 to TWinControl(AControl).ControlCount-1 do
WriteControl(TWinControl(AControl).Controls[i],Prefix+' ');
end;
end;
var
i: Integer;
begin
debugln(['WriteChildAnchors ',DbgSName(RootControl),' Caption="',RootControl.Caption,'" Align=',dbgs(RootControl.Align)]);
for i:=0 to RootControl.ControlCount-1 do
WriteControl(RootControl.Controls[i],' ');
end;
{ TAnchorDockLayoutTreeNode }
function TAnchorDockLayoutTreeNode.GetNodes(Index: integer
): TAnchorDockLayoutTreeNode;
begin
Result:=TAnchorDockLayoutTreeNode(FNodes[Index]);
end;
function TAnchorDockLayoutTreeNode.GetRight: integer;
begin
Result:=FBoundsRect.Right;
end;
function TAnchorDockLayoutTreeNode.GetHeight: integer;
begin
Result:=FBoundsRect.Bottom-FBoundsRect.Top;
end;
function TAnchorDockLayoutTreeNode.GetBottom: integer;
begin
Result:=FBoundsRect.Bottom;
end;
function TAnchorDockLayoutTreeNode.GetAnchors(Site: TAnchorKind): string;
begin
Result:=fAnchors[Site];
end;
function TAnchorDockLayoutTreeNode.GetLeft: integer;
begin
Result:=FBoundsRect.Left;
end;
function TAnchorDockLayoutTreeNode.GetTop: integer;
begin
Result:=FBoundsRect.Top;
end;
function TAnchorDockLayoutTreeNode.GetWidth: integer;
begin
Result:=FBoundsRect.Right-FBoundsRect.Left;
end;
procedure TAnchorDockLayoutTreeNode.SetAlign(const AValue: TAlign);
begin
if FAlign=AValue then exit;
FAlign:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetAnchors(Site: TAnchorKind;
const AValue: string);
begin
if Anchors[Site]=AValue then exit;
fAnchors[Site]:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetBottom(const AValue: integer);
begin
if GetBottom=AValue then exit;
FBoundsRect.Bottom:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetBoundSplitterPos(const AValue: integer);
begin
if FBoundSplitterPos=AValue then exit;
FBoundSplitterPos:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetBoundsRect(const AValue: TRect);
begin
if CompareRect(@FBoundsRect,@AValue) then exit;
FBoundsRect:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetHeaderPosition(
const AValue: TADLHeaderPosition);
begin
if FHeaderPosition=AValue then exit;
FHeaderPosition:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetHeight(const AValue: integer);
begin
if Height=AValue then exit;
FBoundsRect.Bottom:=FBoundsRect.Top+AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetLeft(const AValue: integer);
begin
if Left=AValue then exit;
FBoundsRect.Left:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetMonitor(const AValue: integer);
begin
if FMonitor=AValue then exit;
FMonitor:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetName(const AValue: string);
begin
if FName=AValue then exit;
FName:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetNodeType(const AValue: TADLTreeNodeType);
begin
if FNodeType=AValue then exit;
FNodeType:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetParent(
const AValue: TAnchorDockLayoutTreeNode);
begin
if FParent=AValue then exit;
if FParent<>nil then begin
FParent.FNodes.Remove(Self);
FParent.IncreaseChangeStamp;
end;
FParent:=AValue;
if FParent<>nil then
FParent.FNodes.Add(Self);
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetRight(const AValue: integer);
begin
if Right=AValue then exit;
FBoundsRect.Right:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetWorkAreaRect(const AValue: TRect);
begin
if CompareRect(@FWorkAreaRect,@AValue) then exit;
FWorkAreaRect:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetTabPosition(const AValue: TTabPosition);
begin
if FTabPosition=AValue then exit;
FTabPosition:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetTop(const AValue: integer);
begin
if Top=AValue then exit;
FBoundsRect.Top:=AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetWidth(const AValue: integer);
begin
if Width=AValue then exit;
FBoundsRect.Right:=FBoundsRect.Left+AValue;
IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeNode.SetWindowState(const AValue: TWindowState);
begin
if FWindowState=AValue then exit;
FWindowState:=AValue;
IncreaseChangeStamp;
end;
constructor TAnchorDockLayoutTreeNode.Create;
begin
FNodes:=TFPList.Create;
end;
destructor TAnchorDockLayoutTreeNode.Destroy;
begin
Parent:=nil;
Clear;
FreeAndNil(FNodes);
inherited Destroy;
end;
procedure TAnchorDockLayoutTreeNode.Clear;
var
a: TAnchorKind;
begin
Name:='';
FillByte(FBoundsRect,sizeOf(FBoundsRect),0);
while Count>0 do Nodes[Count-1].Free;
NodeType:=adltnNone;
WindowState:=wsNormal;
Monitor:=0;
Align:=alNone;
HeaderPosition:=adlhpAuto;
TabPosition:=tpTop;
BoundSplitterPos:=0;
WorkAreaRect:=Rect(0,0,0,0);
for a:=low(TAnchorKind) to high(TAnchorKind) do
Anchors[a]:='';
end;
function TAnchorDockLayoutTreeNode.IsEqual(Node: TAnchorDockLayoutTreeNode
): boolean;
var
i: Integer;
a: TAnchorKind;
begin
Result:=false;
if (not CompareRect(@FBoundsRect,@Node.FBoundsRect))
or (Count<>Node.Count)
or (NodeType<>Node.NodeType)
or (Name<>Node.Name)
or (Align<>Node.Align)
or (WindowState<>Node.WindowState)
or (HeaderPosition<>Node.HeaderPosition)
or (TabPosition<>Node.TabPosition)
or (BoundSplitterPos<>Node.BoundSplitterPos)
or (not CompareRect(@FWorkAreaRect,@Node.FWorkAreaRect))
then
exit;
for a:=low(TAnchorKind) to high(TAnchorKind) do
if Anchors[a]<>Node.Anchors[a] then exit;
for i:=0 to Count-1 do
if not Nodes[i].IsEqual(Node.Nodes[i]) then exit;
Result:=true;
end;
procedure TAnchorDockLayoutTreeNode.Assign(Node: TAnchorDockLayoutTreeNode);
var
i: Integer;
Child: TAnchorDockLayoutTreeNode;
a: TAnchorKind;
begin
Name:=Node.Name;
NodeType:=Node.NodeType;
BoundsRect:=Node.BoundsRect;
Align:=Node.Align;
WindowState:=Node.WindowState;
HeaderPosition:=Node.HeaderPosition;
TabPosition:=Node.TabPosition;
BoundSplitterPos:=Node.BoundSplitterPos;
WorkAreaRect:=Node.WorkAreaRect;
Monitor:=Node.Monitor;
for a:=low(TAnchorKind) to high(TAnchorKind) do
Anchors[a]:=Node.Anchors[a];
while Count>Node.Count do Nodes[Count-1].Free;
for i:=0 to Node.Count-1 do begin
if i=Count then begin
Child:=TAnchorDockLayoutTreeNode.Create;
Child.Parent:=Self;
end else begin
Child:=Nodes[i];
end;
Child.Assign(Node.Nodes[i]);
end;
end;
procedure TAnchorDockLayoutTreeNode.Assign(AControl: TControl);
var
AnchorControl: TControl;
a: TAnchorKind;
begin
Name:=AControl.Name;
BoundsRect:=AControl.BoundsRect;
Align:=AControl.Align;
if (AControl.Parent=nil) and (AControl is TCustomForm) then begin
WindowState:=TCustomForm(AControl).WindowState;
Monitor:=TCustomForm(AControl).Monitor.MonitorNum;
WorkAreaRect:=TCustomForm(AControl).Monitor.WorkareaRect;
end else
WindowState:=wsNormal;
if AControl is TCustomTabControl then
TabPosition:=TCustomTabControl(AControl).TabPosition
else
TabPosition:=tpTop;
for a:=low(TAnchorKind) to high(TAnchorKind) do begin
AnchorControl:=AControl.AnchorSide[a].Control;
if (AnchorControl=nil) or (AnchorControl=AControl.Parent) then
Anchors[a]:=''
else if AnchorControl.Parent=AControl.Parent then
Anchors[a]:=AnchorControl.Name;
end;
end;
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;
NewCount: longint;
begin
Clear;
Name:=Config.GetValue(Path+'Name','');
NodeType:=NameToADLTreeNodeType(Config.GetValue(Path+'Type',ADLTreeNodeTypeNames[adltnNone]));
Left:=Config.GetValue(Path+'Bounds/Left',0);
Top:=Config.GetValue(Path+'Bounds/Top',0);
Width:=Config.GetValue(Path+'Bounds/Width',0);
Height:=Config.GetValue(Path+'Bounds/Height',0);
BoundSplitterPos:=Config.GetValue(Path+'Bounds/SplitterPos',0);
Config.GetValue(Path+'Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0));
Anchors[akLeft]:=Config.GetValue(Path+'Anchors/Left','');
Anchors[akTop]:=Config.GetValue(Path+'Anchors/Top','');
Anchors[akRight]:=Config.GetValue(Path+'Anchors/Right','');
Anchors[akBottom]:=Config.GetValue(Path+'Anchors/Bottom','');
Align:=NameToADLAlign(Config.GetValue(Path+'Anchors/Align',dbgs(alNone)));
WindowState:=NameToADLWindowState(Config.GetValue(Path+'WindowState',ADLWindowStateNames[wsNormal]));
HeaderPosition:=NameToADLHeaderPosition(Config.GetValue(Path+'Header/Position',ADLHeaderPositionNames[adlhpAuto]));
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
Child:=TAnchorDockLayoutTreeNode.Create;
Child.Parent:=Self;
Child.LoadFromConfig(Path+'Item'+IntToStr(i)+'/', Config);
end;
end;
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]);
Config.SetDeleteValue(Path+'Bounds/Left',Left,0);
Config.SetDeleteValue(Path+'Bounds/Top',Top,0);
Config.SetDeleteValue(Path+'Bounds/Width',Width,0);
Config.SetDeleteValue(Path+'Bounds/Height',Height,0);
Config.SetDeleteValue(Path+'Bounds/SplitterPos',BoundSplitterPos,0);
Config.SetDeleteValue(Path+'Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0));
Config.SetDeleteValue(Path+'Anchors/Left',Anchors[akLeft],'');
Config.SetDeleteValue(Path+'Anchors/Top',Anchors[akTop],'');
Config.SetDeleteValue(Path+'Anchors/Right',Anchors[akRight],'');
Config.SetDeleteValue(Path+'Anchors/Bottom',Anchors[akBottom],'');
Config.SetDeleteValue(Path+'Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]);
Config.SetDeleteValue(Path+'WindowState',ADLWindowStateNames[WindowState],
ADLWindowStateNames[wsNormal]);
Config.SetDeleteValue(Path+'Header/Position',ADLHeaderPositionNames[HeaderPosition],
ADLHeaderPositionNames[adlhpAuto]);
Config.SetDeleteValue(Path+'Header/TabPosition',ADLTabPostionNames[TabPosition],
ADLTabPostionNames[tpTop]);
Config.SetDeleteValue(Path+'Monitor',Monitor,0);
Config.SetDeleteValue(Path+'ChildCount',Count,0);
for i:=1 to Count do
Nodes[i-1].SaveToConfig(Path+'Item'+IntToStr(i)+'/', Config);
end;
function TAnchorDockLayoutTreeNode.FindChildNode(aName: string;
Recursive: boolean): TAnchorDockLayoutTreeNode;
var
i: Integer;
begin
for i:=0 to Count-1 do begin
Result:=Nodes[i];
if CompareText(aName,Result.Name)=0 then exit;
if Recursive then begin
Result:=Result.FindChildNode(aName,true);
if Result<>nil then exit;
end;
end;
Result:=nil;
end;
function TAnchorDockLayoutTreeNode.FindControlNode: TAnchorDockLayoutTreeNode;
var
i: Integer;
begin
if NodeType=adltnControl then
Result:=Self
else
for i:=0 to Count-1 do begin
Result:=Nodes[i].FindControlNode;
if Result<>nil then exit;
end;
end;
procedure TAnchorDockLayoutTreeNode.CheckConsistency;
{ ToDo: check for topological sort }
procedure CheckCornerIsUnique(Side1: TAnchorKind; Side1AnchorName: string;
Side2: TAnchorKind; Side2AnchorName: string);
var
i: Integer;
Child, Found: TAnchorDockLayoutTreeNode;
begin
Found:=nil;
for i:=0 to Count-1 do begin
Child:=Nodes[i];
if Child.IsSplitter then continue;
if CompareText(Child.Anchors[Side1],Side1AnchorName)<>0 then continue;
if CompareText(Child.Anchors[Side2],Side2AnchorName)<>0 then continue;
if Found<>nil then
raise EAnchorDockLayoutError.Create('overlapping controls found :'+Found.Name+','+Child.Name);
Found:=Child;
end;
if Found=nil then
raise EAnchorDockLayoutError.Create('empty space found :'+Name+' '+dbgs(Side1)+'='+Side1AnchorName+' '+dbgs(Side2)+'='+Side2AnchorName);
end;
var
i: Integer;
Child: TAnchorDockLayoutTreeNode;
Side: TAnchorKind;
Sibling: TAnchorDockLayoutTreeNode;
begin
// check parent
if (NodeType=adltnNone) and (Parent<>nil) then
raise EAnchorDockLayoutError.Create('invalid parent, root node');
if (NodeType=adltnCustomSite) and (Parent<>nil) and (Parent.NodeType<>adltnNone) then
raise EAnchorDockLayoutError.Create('invalid parent, custom sites parent must be nil');
if (Parent<>nil) and IsSplitter and (Parent.NodeType<>adltnLayout) then
raise EAnchorDockLayoutError.Create('invalid parent, splitter needs parent layout');
// check sides
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
if Anchors[Side]<>'' then begin
// anchor must be a sibling
Sibling:=nil;
if Parent<>nil then
Sibling:=Parent.FindChildNode(Anchors[Side],false);
if (Sibling=nil) then
raise EAnchorDockLayoutError.Create(
Format(adrsAnchorNotFoundNodeAnchors, [Name, dbgs(Side), Anchors[Side]]));
// only anchor to splitter
if not Sibling.IsSplitter then
raise EAnchorDockLayoutError.Create(
Format(adrsAnchorIsNotSplitterNodeAnchors, [Name, dbgs(Side), Anchors[Side]]));
// the free sides of a splitter must not be anchored
if ((NodeType=adltnSplitterVertical) and (Side in [akLeft,akRight]))
or ((NodeType=adltnSplitterHorizontal) and (Side in [akTop,akBottom]))
then
raise EAnchorDockLayoutError.Create(
Format(adrsAFreeSideOfASplitterMustNotBeAnchoredNodeTypeAncho,
[Name, ADLTreeNodeTypeNames[NodeType], dbgs(Side), Anchors[Side]]));
// a page must not be anchored
if (Parent.NodeType=adltnPages) then
raise EAnchorDockLayoutError.Create(
Format(adrsAPageMustNotBeAnchoredNodeParentParentTypeAnchors,
[Name, Parent.Name, ADLTreeNodeTypeNames[Parent.NodeType], dbgs(Side), Anchors[Side]]));
// check if anchored to the wrong side of a splitter
if ((Sibling.NodeType=adltnSplitterHorizontal) and (Side in [akLeft,akRight]))
or ((Sibling.NodeType=adltnSplitterVertical) and (Side in [akTop,akBottom]))
then
raise EAnchorDockLayoutError.Create(
Format(adrsAnchorToWrongSideOfSplitterNodeAnchors, [Name, dbgs(Side), Anchors[Side]]));
end;
end;
// only the root node, pages, layouts and customsite can have children
if (Parent<>nil) and (Count>0)
and (not (NodeType in [adltnLayout,adltnPages,adltnCustomSite]))
then
raise EAnchorDockLayoutError.Create(
Format(adrsNoChildrenAllowedForNodeType, [Name, ADLTreeNodeTypeNames[NodeType]]));
if (NodeType=adltnCustomSite) then begin
if (Count>1) then
raise EAnchorDockLayoutError.Create(Format(adrsCustomDockSiteCanHaveOnlyOneSite, [Name]));
end;
// check if in each corner sits exactly one child
if NodeType=adltnLayout then
for Side:=low(TAnchorKind) to high(TAnchorKind) do
CheckCornerIsUnique(Side,'',ClockwiseAnchor[Side],'');
// check grandchild
for i:=0 to Count-1 do begin
Child:=Nodes[i];
Child.CheckConsistency;
if (Child.NodeType=adltnSplitterHorizontal) then begin
// check if splitter corners have exactly one sibling
CheckCornerIsUnique(akLeft,Child.Anchors[akLeft],akTop,Child.Name);
CheckCornerIsUnique(akLeft,Child.Anchors[akLeft],akBottom,Child.Name);
CheckCornerIsUnique(akRight,Child.Anchors[akRight],akTop,Child.Name);
CheckCornerIsUnique(akRight,Child.Anchors[akRight],akBottom,Child.Name);
end;
if (Child.NodeType=adltnSplitterVertical) then begin
// check if splitter corners have exactly one sibling
CheckCornerIsUnique(akTop,Child.Anchors[akTop],akLeft,Child.Name);
CheckCornerIsUnique(akTop,Child.Anchors[akTop],akRight,Child.Name);
CheckCornerIsUnique(akBottom,Child.Anchors[akBottom],akLeft,Child.Name);
CheckCornerIsUnique(akBottom,Child.Anchors[akBottom],akRight,Child.Name);
end;
end;
end;
procedure TAnchorDockLayoutTreeNode.Simplify(ExistingNames: TStrings);
{ Simplification rules:
1. Control nodes without existing name are deleted.
2. Empty layouts and pages are deleted
3. pages and layouts with only one child are removed and its content moved up
}
var
i: Integer;
ChildNode: TAnchorDockLayoutTreeNode;
begin
// simplify children
i:=Count-1;
while i>=0 do begin
ChildNode:=Nodes[i];
ChildNode.Simplify(ExistingNames);
if (ChildNode.NodeType=adltnControl) then begin
// leaf node => check if there is a control
if (ChildNode.Name='') or (ExistingNames.IndexOf(ChildNode.Name)<0) then
DeleteNode(ChildNode);
end else if ChildNode.IsSplitter then begin
// splitter
// delete all children
while ChildNode.Count>0 do
ChildNode[0].Free;
end else if ChildNode.NodeType=adltnCustomSite then begin
// custom dock site
end else if ChildNode.Count=0 then begin
// inner node without child => delete
DeleteNode(ChildNode);
end else if (ChildNode.Count=1)
and (ChildNode.NodeType in [adltnLayout,adltnPages]) then begin
// layouts and pages with only one child
// => move grandchildren up and delete childnode
ReplaceWithChildren(ChildNode);
end;
i:=Min(i,Count)-1;
end;
end;
procedure TAnchorDockLayoutTreeNode.DeleteNode(
ChildNode: TAnchorDockLayoutTreeNode);
var
i: Integer;
Sibling: TAnchorDockLayoutTreeNode;
Side: TAnchorKind;
Splitter: TAnchorDockLayoutTreeNode;
begin
WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode BEFORE DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self);
ChildNode.Parent:=nil;
try
if not ChildNode.IsSplitter then begin
// delete node bound splitter (= a splitter only anchored to this node)
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
Splitter:=FindNodeBoundSplitter(ChildNode,Side);
if Splitter<>nil then begin
DeleteNodeBoundSplitter(Splitter,ChildNode,OppositeAnchor[Side]);
exit;
end;
end;
// delete spiral splitter
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
Splitter:=FindChildNode(ChildNode.Anchors[Side],false);
if (Splitter=nil) or (not Splitter.IsSplitter) then break;
if Side=High(TAnchorKind) then begin
DeleteSpiralSplitter(ChildNode);
exit;
end;
end;
end;
finally
// remove references
for i:=0 to Count-1 do begin
Sibling:=Nodes[i];
for Side:=low(TAnchorKind) to high(TAnchorKind) do
if Sibling.Anchors[Side]=ChildNode.Name then
Sibling.Anchors[Side]:='';
end;
WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode AFTER DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self);
// free node
ChildNode.Free;
end;
end;
function TAnchorDockLayoutTreeNode.FindNodeBoundSplitter(
ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind
): TAnchorDockLayoutTreeNode;
var
AnchorNode: TAnchorDockLayoutTreeNode;
i: Integer;
AnchorName: string;
begin
Result:=nil;
AnchorName:=ChildNode.Anchors[Side];
if AnchorName='' then exit;
AnchorNode:=FindChildNode(AnchorName,false);
if (AnchorNode=nil) or (not AnchorNode.IsSplitter) then exit;
for i:=0 to Count-1 do
if (Nodes[i]<>ChildNode) and (Nodes[i].Anchors[Side]=AnchorName) then exit;
Result:=AnchorNode;
end;
procedure TAnchorDockLayoutTreeNode.DeleteNodeBoundSplitter(Splitter,
ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind);
{ delete node bound splitter (= a splitter only anchored to this node)
Example: Side=akRight
# #
##################### #########
---+S+--------+# ---+#
---+S|AControl|# ---> ---+#
---+S+--------+# ---+#
##################### #########
}
var
i: Integer;
Sibling: TAnchorDockLayoutTreeNode;
begin
for i:=0 to Count-1 do begin
Sibling:=Nodes[i];
if Sibling.Anchors[Side]=Splitter.Name then
Sibling.Anchors[Side]:=ChildNode.Anchors[Side];
end;
DeleteNode(Splitter);
end;
procedure TAnchorDockLayoutTreeNode.DeleteSpiralSplitter(
ChildNode: TAnchorDockLayoutTreeNode);
{ Merge two splitters and delete one of them.
Prefer the pair with shortest distance between.
For example:
3 3
11111111113 3
2+----+3 3
2|Node|3 ---> 111111111
2+----+3 2
2444444444 2
2 2
Everything anchored to 4 is now anchored to 1.
And right side of 1 is now anchored to where the right side of 4 was anchored.
}
var
Splitters: array[TAnchorKind] of TAnchorDockLayoutTreeNode;
Side: TAnchorKind;
i: Integer;
Sibling: TAnchorDockLayoutTreeNode;
Keep: TAnchorKind;
DeleteSplitter: TAnchorDockLayoutTreeNode;
NextSide: TAnchorKind;
begin
// find the four splitters
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
Splitters[Side]:=FindChildNode(ChildNode.Anchors[Side],false);
if (Splitters[Side]=nil) or (not Splitters[Side].IsSplitter) then
RaiseGDBException(''); // missing splitter
end;
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
// spiral splitters are connected to each other
NextSide:=ClockwiseAnchor[Side];
if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then begin
NextSide:=OppositeAnchor[NextSide];
if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then
RaiseGDBException(''); // this is not a spiral splitter
end;
end;
// Prefer the pair with shortest distance between
if (Splitters[akRight].Left-Splitters[akLeft].Left)
<(Splitters[akBottom].Top-Splitters[akTop].Top)
then
Keep:=akLeft
else
Keep:=akTop;
DeleteSplitter:=Splitters[OppositeAnchor[Keep]];
// transfer anchors from the deleting splitter to the kept splitter
for i:=0 to Count-1 do begin
Sibling:=Nodes[i];
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
if FindChildNode(Sibling.Anchors[Side],false)=DeleteSplitter then
Sibling.Anchors[Side]:=Splitters[Keep].Name;
end;
end;
// longen kept splitter
NextSide:=ClockwiseAnchor[Keep];
if Splitters[Keep].Anchors[NextSide]<>Splitters[NextSide].Name then
NextSide:=OppositeAnchor[NextSide];
Splitters[Keep].Anchors[NextSide]:=DeleteSplitter.Anchors[NextSide];
// delete the splitter
DeleteNode(DeleteSplitter);
end;
procedure TAnchorDockLayoutTreeNode.ReplaceWithChildren(
ChildNode: TAnchorDockLayoutTreeNode);
{ move all children of ChildNode up.
All anchored to ChildNode (= their parent) use the anchors of ChildNode.
ChildNode is freed.
}
var
GrandChild: TAnchorDockLayoutTreeNode;
Side: TAnchorKind;
begin
WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren BEFORE REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self);
DebugWriteChildAnchors(Self);
while ChildNode.Count>0 do begin
GrandChild:=ChildNode[0];
GrandChild.Parent:=Self;
OffsetRect(GrandChild.FBoundsRect,ChildNode.Left,ChildNode.Top);
for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
if GrandChild.Anchors[Side]='' then begin
if ((GrandChild.NodeType=adltnSplitterHorizontal)
and (Side in [akTop,akBottom]))
or ((GrandChild.NodeType=adltnSplitterVertical)
and (Side in [akLeft,akRight]))
then
continue; // a free splitter sides => don't anchor it
GrandChild.Anchors[Side]:=ChildNode.Anchors[Side];
end;
end;
end;
WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren AFTER REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self);
ChildNode.Free;
DebugWriteChildAnchors(Self);
end;
procedure TAnchorDockLayoutTreeNode.IncreaseChangeStamp;
begin
if Parent<>nil then Parent.IncreaseChangeStamp;
end;
function TAnchorDockLayoutTreeNode.IsSplitter: boolean;
begin
Result:=NodeType in [adltnSplitterHorizontal,adltnSplitterVertical];
end;
function TAnchorDockLayoutTreeNode.IsRootWindow: boolean;
begin
Result:=(NodeType in [adltnLayout,adltnPages,adltnControl,adltnCustomSite])
and ((Parent=nil) or (Parent.NodeType in [adltnNone]));
end;
function TAnchorDockLayoutTreeNode.Count: integer;
begin
Result:=FNodes.Count;
end;
{ TAnchorDockLayoutTreeRootNode }
procedure TAnchorDockLayoutTreeRootNode.IncreaseChangeStamp;
begin
Tree.IncreaseChangeStamp;
end;
procedure TAnchorDockLayoutTreeRootNode.CheckConsistency;
var
Names: TStringList;
procedure RaiseNodePath(const Msg: string; Node: TAnchorDockLayoutTreeNode);
var
s: String;
begin
s:='';
while Node<>nil do begin
if s<>'' then
s:='/'+s;
s:=Node.Name+s;
Node:=Node.Parent;
end;
s:=Msg+s;
end;
procedure CheckNames(Node: TAnchorDockLayoutTreeNode);
var
i: Integer;
begin
if (Node.Name='') and (Node<>Self) then
RaiseNodePath(adrsEmptyName, Node);
for i:=0 to Names.Count-1 do
if CompareText(Names[i],Node.Name)=0 then
RaiseNodePath(adrsDuplicateName, Node);
Names.Add(Node.Name);
for i:=0 to Node.Count-1 do
CheckNames(Node[i]);
end;
begin
// check that all names are unique
Names:=TStringList.Create;
try
CheckNames(Self);
finally
Names.Free;
end;
inherited CheckConsistency;
end;
{ TAnchorDockLayoutTree }
procedure TAnchorDockLayoutTree.SetModified(const AValue: boolean);
begin
if AValue then
IncreaseChangeStamp
else
FSavedChangeStamp:=FChangeStamp;
end;
function TAnchorDockLayoutTree.GetModified: boolean;
begin
Result:=FSavedChangeStamp<>FChangeStamp;
end;
constructor TAnchorDockLayoutTree.Create;
begin
FSavedChangeStamp:=Low(FChangeStamp);
FRoot:=TAnchorDockLayoutTreeRootNode.Create;
Root.FTree:=Self;
end;
destructor TAnchorDockLayoutTree.Destroy;
begin
FreeAndNil(FRoot);
inherited Destroy;
end;
procedure TAnchorDockLayoutTree.Clear;
begin
FRoot.Clear;
Modified:=false;
end;
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(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;
procedure TAnchorDockLayoutTree.IncreaseChangeStamp;
begin
if FChangeStamp<High(FChangeStamp) then
inc(FChangeStamp)
else
FChangeStamp:=Low(FChangeStamp)+1;
end;
function TAnchorDockLayoutTree.NewNode(aParent: TAnchorDockLayoutTreeNode
): TAnchorDockLayoutTreeNode;
begin
Result:=TAnchorDockLayoutTreeNode.Create;
Result.Parent:=aParent;
end;
procedure TAnchorDockLayoutTree.Assign(Source: TObject);
begin
if Source is TAnchorDockLayoutTree then
Root.Assign(TAnchorDockLayoutTree(Source).Root)
else if Source is TAnchorDockLayoutTreeNode then
Root.Assign(TAnchorDockLayoutTreeNode(Source))
else
raise Exception.Create('TAnchorDockLayoutTree.Assign not implemented '+DbgSName(Source));
end;
{ TADNameToControl }
function TADNameToControl.IndexOfName(const aName: string): integer;
begin
Result:=fItems.Count-1;
while (Result>=0) and (CompareText(aName,fItems[Result])<>0) do
dec(Result);
end;
function TADNameToControl.GetControl(const aName: string): TControl;
var
i: LongInt;
begin
i:=IndexOfName(aName);
if i>=0 then
Result:=TControl(fItems.Objects[i])
else
Result:=nil;
end;
procedure TADNameToControl.SetControl(const aName: string;
const AValue: TControl);
var
i: LongInt;
begin
i:=IndexOfName(aName);
if i>=0 then begin
fItems[i]:=aName;
fItems.Objects[i]:=AValue;
end else
fItems.AddObject(aName,AValue);
end;
constructor TADNameToControl.Create;
begin
fItems:=TStringList.Create;
end;
destructor TADNameToControl.Destroy;
begin
FreeAndNil(fItems);
inherited Destroy;
end;
function TADNameToControl.ControlToName(AControl: TControl): string;
var
i: Integer;
begin
i:=fItems.Count-1;
while i>=0 do begin
if fItems.Objects[i]=AControl then begin
Result:=fItems[i];
exit;
end;
dec(i);
end;
Result:='';
end;
procedure TADNameToControl.RemoveControl(AControl: TControl);
var
i: Integer;
begin
i:=fItems.Count-1;
while i>=0 do begin
if fItems.Objects[i]=AControl then
fItems.Delete(i);
dec(i);
end;
end;
procedure TADNameToControl.WriteDebugReport(Msg: string);
var
i: Integer;
begin
debugln(['TADNameToControl.WriteDebugReport ',fItems.Count,' ',Msg]);
for i:=0 to fItems.Count-1 do begin
debugln([' ',i,'/',fItems.Count,' "',dbgstr(fItems[i]),'" Control=',dbgsname(TControl(fItems.Objects[i]))]);
end;
end;
{ TAnchorDockRestoreLayout }
procedure TAnchorDockRestoreLayout.SetControlNames(const AValue: TStrings);
begin
if FControlNames=AValue then exit;
FControlNames.Assign(AValue);
end;
constructor TAnchorDockRestoreLayout.Create;
begin
FControlNames:=TStringList.Create;
FLayout:=TAnchorDockLayoutTree.Create;
end;
constructor TAnchorDockRestoreLayout.Create(aLayout: TAnchorDockLayoutTree);
begin
FControlNames:=TStringList.Create;
FLayout:=aLayout;
UpdateControlNames;
end;
destructor TAnchorDockRestoreLayout.Destroy;
begin
FreeAndNil(FLayout);
FreeAndNil(FControlNames);
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;
while (Result>=0) and (CompareText(AName,FControlNames[Result])<>0) do
dec(Result);
end;
function TAnchorDockRestoreLayout.HasControlName(AName: string): boolean;
begin
Result:=IndexOfControlName(AName)>=0;
end;
procedure TAnchorDockRestoreLayout.RemoveControlName(AName: string);
var
i: Integer;
begin
for i:=FControlNames.Count-1 downto 0 do
if CompareText(AName,FControlNames[i])=0 then
FControlNames.Delete(i);
end;
procedure TAnchorDockRestoreLayout.UpdateControlNames;
procedure Check(Node: TAnchorDockLayoutTreeNode);
var
i: Integer;
begin
if (Node.Name<>'') and (Node.NodeType in [adltnControl,adltnCustomSite])
and (not HasControlName(Node.Name)) then
FControlNames.Add(Node.Name);
for i:=0 to Node.Count-1 do
Check(Node[i]);
end;
begin
FControlNames.Clear;
Check(Layout.Root);
end;
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;
Node: TAnchorDockLayoutTreeNode;
begin
FControlNames.Delimiter:=',';
FControlNames.StrictDelimiter:=true;
FControlNames.DelimitedText:=Config.GetValue(Path+'Names','');
Layout.LoadFromConfig(Path, 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.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;
Config.SetDeleteValue(Path+'Names',FControlNames.DelimitedText,'');
Layout.SaveToConfig(Path, Config);
end;
{ TAnchorDockRestoreLayouts }
function TAnchorDockRestoreLayouts.GetItems(Index: integer): TAnchorDockRestoreLayout;
begin
Result:=TAnchorDockRestoreLayout(fItems[Index]);
end;
constructor TAnchorDockRestoreLayouts.Create;
begin
fItems:=TFPList.Create;
end;
destructor TAnchorDockRestoreLayouts.Destroy;
begin
Clear;
FreeAndNil(fItems);
inherited Destroy;
end;
procedure TAnchorDockRestoreLayouts.Clear;
var
i: Integer;
begin
for i:=0 to fItems.Count-1 do
TObject(fItems[i]).Free;
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;
fItems.Delete(Index);
end;
function TAnchorDockRestoreLayouts.IndexOfName(AControlName: string): integer;
begin
Result:=Count-1;
while (Result>=0) and not Items[Result].HasControlName(AControlName) do
dec(Result);
end;
function TAnchorDockRestoreLayouts.FindByName(AControlName: string
): TAnchorDockRestoreLayout;
var
i: LongInt;
begin
i:=IndexOfName(AControlName);
if i>=0 then
Result:=Items[i]
else
Result:=nil;
end;
procedure TAnchorDockRestoreLayouts.Add(Layout: TAnchorDockRestoreLayout;
RemoveOther: boolean);
var
i: Integer;
begin
if Layout=nil then exit;
if RemoveOther then begin
for i:=0 to Layout.ControlNames.Count-1 do
RemoveByName(Layout.ControlNames[i]);
end;
fItems.Add(Layout);
end;
procedure TAnchorDockRestoreLayouts.RemoveByName(AControlName: string);
var
i: Integer;
Layout: TAnchorDockRestoreLayout;
begin
for i:=Count-1 downto 0 do begin
Layout:=Items[i];
Layout.RemoveControlName(AControlName);
if Layout.ControlNames.Count=0 then
Delete(i);
end;
end;
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;
i: Integer;
begin
Clear;
NewCount:=Config.GetValue(Path+'Count',0);
for i:=1 to NewCount do begin
NewItem:=TAnchorDockRestoreLayout.Create;
NewItem.LoadFromConfig(Path+'Item'+IntToStr(i+1)+'/', Config);
if NewItem.ControlNames.Count>0 then
fItems.Add(NewItem)
else
NewItem.Free;
end;
end;
procedure TAnchorDockRestoreLayouts.SaveToConfig(Path: string; Config: TRttiXMLConfig);
var
i: Integer;
begin
Config.SetDeleteValue(Path+'Count',Count,0);
for i:=0 to Count-1 do begin
Items[i].SaveToConfig(Path+'Item'+IntToStr(i+1)+'/', Config);
end;
end;
function TAnchorDockRestoreLayouts.ConfigIsEmpty(Config: TConfigStorage): boolean;
begin
Result:=Config.GetValue('Count',0)<=0;
end;
function TAnchorDockRestoreLayouts.Count: integer;
begin
Result:=fItems.Count;
end;
end.