mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-11-04 12:49:42 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			2188 lines
		
	
	
		
			68 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			2188 lines
		
	
	
		
			68 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{ 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
 | 
						|
}
 | 
						|
Unit AnchorDockStorage;
 | 
						|
 | 
						|
{$mode objfpc}{$H+}
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
uses
 | 
						|
  Math, Classes, SysUtils, LCLProc, ExtCtrls, ComCtrls, Forms, Controls,
 | 
						|
  AvgLvlTree, LazConfigStorage, Laz2_XMLCfg,
 | 
						|
  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
 | 
						|
    );
 | 
						|
 | 
						|
  TADLControlLocation = (
 | 
						|
    adlclWrongly,
 | 
						|
    adlclCorrect
 | 
						|
    );
 | 
						|
  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;
 | 
						|
    FControlLocation: TADLControlLocation;
 | 
						|
    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; OverrideBoundsRect: Boolean=false); 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;
 | 
						|
    property ControlLocation: TADLControlLocation read FControlLocation write FControlLocation;
 | 
						|
  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;
 | 
						|
  FControlLocation:=adlclwrongly;//control located wrongly by default
 | 
						|
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; OverrideBoundsRect: Boolean=false);
 | 
						|
var
 | 
						|
  AnchorControl: TControl;
 | 
						|
  a: TAnchorKind;
 | 
						|
begin
 | 
						|
  Name:=AControl.Name;
 | 
						|
  if OverrideBoundsRect then
 | 
						|
    BoundsRect:=GetParentForm(AControl).BoundsRect
 | 
						|
  else
 | 
						|
    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:=GetParentForm(AControl).WindowState;
 | 
						|
  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 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 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.
 | 
						|
 |