{ 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 AnchorDockStorage; {$mode objfpc}{$H+} interface uses Math, Classes, SysUtils, LCLProc, AvgLvlTree, ExtCtrls, Forms, Controls, LazConfigStorage, AnchorDockStr; 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; FBoundsRect: TRect; FHeaderPosition: TADLHeaderPosition; FMonitor: integer; FName: string; FNodes: TFPList; // list of TAnchorDockLayoutTreeNode FNodeType: TADLTreeNodeType; FParent: TAnchorDockLayoutTreeNode; 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 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 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); procedure Assign(AControl: TControl); procedure LoadFromConfig(Config: TConfigStorage); procedure SaveToConfig(Config: TConfigStorage); 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 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; FModified: boolean; FRoot: TAnchorDockLayoutTreeRootNode; procedure SetModified(const AValue: boolean); public constructor Create; destructor Destroy; override; procedure Clear; procedure LoadFromConfig(Config: TConfigStorage); procedure SaveToConfig(Config: TConfigStorage); procedure IncreaseChangeStamp; property ChangeStamp: int64 read FChangeStamp; property Modified: boolean read FModified write SetModified; property Root: TAnchorDockLayoutTreeRootNode read FRoot; function NewNode(aParent: TAnchorDockLayoutTreeNode): TAnchorDockLayoutTreeNode; 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' ); 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.Leftnil 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 TCustomNotebook) 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,' ',AnchorNames[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)); if Node.WindowState<>wsNormal then DbgOut(' WindowState=',dbgs(Node.WindowState)); if Node.Monitor<>0 then DbgOut(' Monitor=',dbgs(Node.Monitor)); 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.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.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; 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) 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; 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; end else WindowState:=wsNormal; if AControl is TCustomNotebook then TabPosition:=TCustomNotebook(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); 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',AlignNames[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.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('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; 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 that all childs are connected check for topological sort check for not overlapping (the bounds can overlap because of constraints) } var i: Integer; Child: TAnchorDockLayoutTreeNode; Side: TAnchorKind; Sibling: TAnchorDockLayoutTreeNode; begin // check parent if (NodeType=adltnNone) and (Parent<>nil) then raise EAnchorDockLayoutError.Create('invalid parent'); if (NodeType=adltnCustomSite) and (Parent.NodeType<>adltnNone) then raise EAnchorDockLayoutError.Create('invalid parent'); // 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 grandchild for i:=0 to Count-1 do begin Child:=Nodes[i]; Child.CheckConsistency; 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 childs 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; if FModified=AValue then exit; FModified:=AValue; end; constructor TAnchorDockLayoutTree.Create; begin 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.SaveToConfig(Config: TConfigStorage); begin Config.AppendBasePath('Nodes/'); FRoot.SaveToConfig(Config); Config.UndoAppendBasePath; end; procedure TAnchorDockLayoutTree.IncreaseChangeStamp; begin if FChangeStamp=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; end.