lazarus/examples/anchordocking/anchordockstorage.pas

{ Unit implementing anchor docking storage tree.

  Copyright (C) 2010 Mattias Gaertner mattias@freepascal.org

  This library is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version with the following modification:

  As a special exception, the copyright holders of this library give you
  permission to link this library with independent modules to produce an
  executable, regardless of the license terms of these independent modules,and
  to copy and distribute the resulting executable under terms of your choice,
  provided that you also meet, for each linked independent module, the terms
  and conditions of the license of that module. An independent module is a
  module which is not derived from or based on this library. If you modify
  this library, you may extend this exception to your version of the library,
  but you are not obligated to do so. If you do not wish to do so, delete this
  exception statement from your version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a copy of the GNU Library General Public License
  along with this library; if not, write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
Unit AnchorDockStorage;

{$mode objfpc}{$H+}

interface

uses
  Math, Classes, SysUtils, LCLProc, AvgLvlTree, ExtCtrls, Forms, Controls,
  LazConfigStorage, AnchorDockStr;

const
  AnchorDockSplitterName = 'AnchorDockSplitter';
  AnchorDockSiteName = 'AnchorDockSite';
type
  TADLTreeNodeType = (
    adltnNone,
    adltnLayout,
    adltnControl,
    adltnSplitterHorizontal,
    adltnSplitterVertical,
    adltnPages,
    adltnCustomSite
    );
  TADLTreeNodeTypes = set of TADLTreeNodeType;

  TADLHeaderPosition = (
    adlhpAuto,
    adlhpTop,
    adlhpLeft,
    adlhpRight,
    adlhpBottom
    );
  TADLHeaderPositions = set of TADLHeaderPosition;

  EAnchorDockLayoutError = class(Exception);

  { TAnchorDockLayoutTreeNode }

  TAnchorDockLayoutTreeNode = class
  private
    FAlign: TAlign;
    fAnchors: array[TAnchorKind] of string;
    FBoundsRect: TRect;
    FHeaderPosition: TADLHeaderPosition;
    FMonitor: integer;
    FName: string;
    FNodes: TFPList; // list of TAnchorDockLayoutTreeNode
    FNodeType: TADLTreeNodeType;
    FParent: TAnchorDockLayoutTreeNode;
    FTabPosition: TTabPosition;
    FWindowState: TWindowState;
    function GetAnchors(Site: TAnchorKind): string;
    function GetBottom: integer;
    function GetHeight: integer;
    function GetLeft: integer;
    function GetNodes(Index: integer): TAnchorDockLayoutTreeNode;
    function GetRight: integer;
    function GetTop: integer;
    function GetWidth: integer;
    procedure SetAlign(const AValue: TAlign);
    procedure SetAnchors(Site: TAnchorKind; const AValue: string);
    procedure SetBottom(const AValue: integer);
    procedure SetBoundsRect(const AValue: TRect);
    procedure SetHeaderPosition(const AValue: TADLHeaderPosition);
    procedure SetHeight(const AValue: integer);
    procedure SetLeft(const AValue: integer);
    procedure SetMonitor(const AValue: integer);
    procedure SetName(const AValue: string);
    procedure SetNodeType(const AValue: TADLTreeNodeType);
    procedure SetParent(const AValue: TAnchorDockLayoutTreeNode);
    procedure SetRight(const AValue: integer);
    procedure SetTabPosition(const AValue: TTabPosition);
    procedure SetTop(const AValue: integer);
    procedure SetWidth(const AValue: integer);
    procedure SetWindowState(const AValue: TWindowState);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function IsEqual(Node: TAnchorDockLayoutTreeNode): boolean;
    procedure Assign(Node: TAnchorDockLayoutTreeNode);
    procedure Assign(AControl: TControl);
    procedure LoadFromConfig(Config: TConfigStorage);
    procedure SaveToConfig(Config: TConfigStorage);
    function FindChildNode(aName: string; Recursive: boolean): TAnchorDockLayoutTreeNode;
    function FindControlNode: TAnchorDockLayoutTreeNode;
    procedure CheckConsistency; virtual;

    // simplifying
    procedure Simplify(ExistingNames: TStrings);
    procedure DeleteNode(ChildNode: TAnchorDockLayoutTreeNode);
    function FindNodeBoundSplitter(ChildNode: TAnchorDockLayoutTreeNode;
                                   Side: TAnchorKind): TAnchorDockLayoutTreeNode;
    procedure DeleteNodeBoundSplitter(Splitter, ChildNode: TAnchorDockLayoutTreeNode;
                                      Side: TAnchorKind);
    procedure DeleteSpiralSplitter(ChildNode: TAnchorDockLayoutTreeNode);
    procedure ReplaceWithChildren(ChildNode: TAnchorDockLayoutTreeNode);

    // properties
    procedure IncreaseChangeStamp; virtual;
    property Name: string read FName write SetName;
    property NodeType: TADLTreeNodeType read FNodeType write SetNodeType;
    property Parent: TAnchorDockLayoutTreeNode read FParent write SetParent;
    property Left: integer read GetLeft write SetLeft;
    property Top: integer read GetTop write SetTop;
    property Width: integer read GetWidth write SetWidth;
    property Height: integer read GetHeight write SetHeight;
    property Right: integer read GetRight write SetRight;
    property Bottom: integer read GetBottom write SetBottom;
    property BoundsRect: TRect read FBoundsRect write SetBoundsRect;
    property Anchors[Site: TAnchorKind]: string read GetAnchors write SetAnchors; // empty means default (parent)
    property Align: TAlign read FAlign write SetAlign;
    property WindowState: TWindowState read FWindowState write SetWindowState;
    property Monitor: integer read FMonitor write SetMonitor;
    property HeaderPosition: TADLHeaderPosition read FHeaderPosition write SetHeaderPosition;
    property TabPosition: TTabPosition read FTabPosition write SetTabPosition;
    function Count: integer;
    function IsSplitter: boolean;
    function IsRootWindow: boolean;
    property Nodes[Index: integer]: TAnchorDockLayoutTreeNode read GetNodes; default;
  end;

  TAnchorDockLayoutTree = class;

  { TAnchorDockLayoutTreeRootNode }

  TAnchorDockLayoutTreeRootNode = class(TAnchorDockLayoutTreeNode)
  private
    FTree: TAnchorDockLayoutTree;
  public
    procedure IncreaseChangeStamp; override;
    property Tree: TAnchorDockLayoutTree read FTree write FTree;
    procedure CheckConsistency; override;
  end;

  { TAnchorDockLayoutTree }

  TAnchorDockLayoutTree = class
  private
    FChangeStamp: int64;
    FModified: boolean;
    FRoot: TAnchorDockLayoutTreeRootNode;
    procedure SetModified(const AValue: boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromConfig(Config: TConfigStorage);
    procedure SaveToConfig(Config: TConfigStorage);
    procedure IncreaseChangeStamp;
    property ChangeStamp: int64 read FChangeStamp;
    property Modified: boolean read FModified write SetModified;
    property Root: TAnchorDockLayoutTreeRootNode read FRoot;
    function NewNode(aParent: TAnchorDockLayoutTreeNode): TAnchorDockLayoutTreeNode;
  end;

  { TADNameToControl }

  TADNameToControl = class
  private
    fItems: TStringList;
    function IndexOfName(const aName: string): integer;
    function GetControl(const aName: string): TControl;
    procedure SetControl(const aName: string; const AValue: TControl);
  public
    constructor Create;
    destructor Destroy; override;
    function ControlToName(AControl: TControl): string;
    property Control[const aName: string]: TControl read GetControl write SetControl; default;
    procedure RemoveControl(AControl: TControl);
    procedure WriteDebugReport(Msg: string);
  end;

const
  ADLTreeNodeTypeNames: array[TADLTreeNodeType] of string = (
    'None',
    'Layout',
    'Control',
    'SplitterHorizontal',
    'SplitterVertical',
    'Pages',
    'CustomSite'
    );
  ADLWindowStateNames: array[TWindowState] of string = (
    'Normal',
    'Minimized',
    'Maximized'
    );
  ADLHeaderPositionNames: array[TADLHeaderPosition] of string = (
    'auto',
    'left',
    'top',
    'right',
    'bottom'
    );
  ADLTabPostionNames: array[TTabPosition] of string = (
    'Top',
    'Bottom',
    'Left',
    'Right'
    );
  ADLAlignNames: array[TAlign] of string = (
    'None',
    'Top',
    'Bottom',
    'Left',
    'Right',
    'Client',
    'Custom'
    );

function NameToADLTreeNodeType(s: string): TADLTreeNodeType;
function NameToADLWindowState(s: string): TWindowState;
function NameToADLHeaderPosition(s: string): TADLHeaderPosition;
function NameToADLTabPosition(s: string): TTabPosition;
function NameToADLAlign(s: string): TAlign;
function dbgs(const NodeType: TADLTreeNodeType): string; overload;

procedure WriteDebugLayout(Title: string; RootNode: TObject);
function DebugLayoutAsString(RootNode: TObject): string;
procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode); overload;
procedure DebugWriteChildAnchors(RootControl: TWinControl;
                                 OnlyWinControls, OnlyForms: boolean); overload;

implementation

function NameToADLTreeNodeType(s: string): TADLTreeNodeType;
begin
  for Result:=low(TADLTreeNodeType) to high(TADLTreeNodeType) do
    if s=ADLTreeNodeTypeNames[Result] then exit;
  Result:=adltnNone;
end;

function NameToADLWindowState(s: string): TWindowState;
begin
  for Result:=low(TWindowState) to high(TWindowState) do
    if s=ADLWindowStateNames[Result] then exit;
  Result:=wsNormal;
end;

function NameToADLHeaderPosition(s: string): TADLHeaderPosition;
begin
  for Result:=low(TADLHeaderPosition) to high(TADLHeaderPosition) do
    if s=ADLHeaderPositionNames[Result] then exit;
  Result:=adlhpAuto;
end;

function NameToADLTabPosition(s: string): TTabPosition;
begin
  for Result:=low(TTabPosition) to high(TTabPosition) do
    if s=ADLTabPostionNames[Result] then exit;
  Result:=tpTop;
end;

function NameToADLAlign(s: string): TAlign;
begin
  for Result:=low(TAlign) to high(TAlign) do
    if s=ADLAlignNames[Result] then exit;
  Result:=alNone;
end;

function dbgs(const NodeType: TADLTreeNodeType): string; overload;
begin
  Result:=ADLTreeNodeTypeNames[NodeType];
end;

procedure WriteDebugLayout(Title: string; RootNode: TObject);
begin
  debugln(['WriteDebugLayout ',Title,':']);
  debugln(DebugLayoutAsString(RootNode));
end;

function DebugLayoutAsString(RootNode: TObject): string;
type
  TNodeInfo = record
    MinSize: TPoint;
    MinSizeValid, MinSizeCalculating: boolean;
    MinLeft: integer;
    MinLeftValid, MinLeftCalculating: boolean;
    MinTop: Integer;
    MinTopValid, MinTopCalculating: boolean;
  end;
  PNodeInfo = ^TNodeInfo;
var
  Cols: LongInt;
  Rows: LongInt;
  LogCols: Integer;
  NodeInfos: TPointerToPointerTree;// TObject to PNodeInfo

  procedure InitNodeInfos;
  begin
    NodeInfos:=TPointerToPointerTree.Create;
  end;

  procedure FreeNodeInfos;
  var
    Item: PNodeInfo;
    NodePtr, InfoPtr: Pointer;
  begin
    NodeInfos.GetFirst(NodePtr,InfoPtr);
    repeat
      Item:=PNodeInfo(InfoPtr);
      if Item=nil then break;
      Dispose(Item);
    until not NodeInfos.GetNext(NodePtr,NodePtr,InfoPtr);
    NodeInfos.Free;
  end;

  function GetNodeInfo(Node: TObject): PNodeInfo;
  begin
    Result:=PNodeInfo(NodeInfos[Node]);
    if Result=nil then begin
      New(Result);
      FillChar(Result^,SizeOf(TNodeInfo),0);
      NodeInfos[Node]:=Result;
    end;
  end;

  procedure w(x,y: Integer; const s: string; MaxX: Integer = 0);
  var
    i: Integer;
  begin
    for i:=1 to length(s) do begin
      if (MaxX>0) and (x+i>MaxX) then exit;
      Result[LogCols*(y-1) + x + i-1]:=s[i];
    end;
  end;

  procedure wfillrect(const ARect: TRect; c: char);
  var
    x: LongInt;
    y: LongInt;
  begin
    for x:=ARect.Left to ARect.Right do
      for y:=ARect.Top to ARect.Bottom do
        w(x,y,c);
  end;

  procedure wrectangle(const ARect: TRect);
  begin
    w(ARect.Left,ARect.Top,'+');
    w(ARect.Right,ARect.Top,'+');
    w(ARect.Left,ARect.Bottom,'+');
    w(ARect.Right,ARect.Bottom,'+');
    if ARect.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 TCustomNotebook)
      or ((Node is TAnchorDockLayoutTreeNode)
          and (TAnchorDockLayoutTreeNode(Node).NodeType in [adltnPages,adltnNone]));
  end;

  function GetName(Node: TObject): string;
  begin
    if Node is TControl then
      Result:=TControl(Node).Name
    else if Node is TAnchorDockLayoutTreeNode then
      Result:=TAnchorDockLayoutTreeNode(Node).Name
    else
      Result:=DbgSName(Node);
  end;

  function GetChildCount(Node: TObject): integer;
  begin
    if Node is TWinControl then
      Result:=TWinControl(Node).ControlCount
    else if Node is TAnchorDockLayoutTreeNode then
      Result:=TAnchorDockLayoutTreeNode(Node).Count
    else
      Result:=0;
  end;

  function GetChild(Node: TObject; Index: integer): TObject;
  begin
    if Node is TWinControl then
      Result:=TWinControl(Node).Controls[Index]
    else if Node is TAnchorDockLayoutTreeNode then
      Result:=TAnchorDockLayoutTreeNode(Node).Nodes[Index]
    else
      Result:=nil;
  end;

  function GetMinSize(Node: TObject): TPoint; forward;

  function GetMinPos(Node: TObject; Side: TAnchorKind): Integer;
  // calculates left or top position of Node

    function Compute(var MinPosValid, MinPosCalculating: boolean;
      var MinPos: Integer): Integer;

      procedure Improve(Neighbour: TObject);
      var
        NeighbourPos: LongInt;
        NeighbourSize: TPoint;
        NeighbourLength: LongInt;
      begin
        if Neighbour=nil then exit;
        if GetParentNode(Neighbour)<>GetParentNode(Node) then exit;
        NeighbourPos:=GetMinPos(Neighbour,Side);
        NeighbourSize:=GetMinSize(Neighbour);
        if Side=akLeft then
          NeighbourLength:=NeighbourSize.X
        else
          NeighbourLength:=NeighbourSize.Y;
        MinPos:=Max(MinPos,NeighbourPos+NeighbourLength);
      end;

    var
      Sibling: TObject;
      i: Integer;
      ParentNode: TObject;
    begin
      if MinPosCalculating then begin
        DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected RootNode=',DbgSName(RootNode)]);
        if RootNode is TWinControl then
          DebugWriteChildAnchors(TWinControl(RootNode),true,true)
        else if RootNode is TAnchorDockLayoutTreeNode then
          DebugWriteChildAnchors(TAnchorDockLayoutTreeNode(RootNode));
        RaiseGDBException('circle detected');
      end;
      if (not MinPosValid) then begin
        MinPosValid:=true;
        MinPosCalculating:=true;
        Sibling:=GetSiblingNode(Node,Side);
        if Sibling<>nil then
          Improve(Sibling);
        ParentNode:=GetParentNode(Node);
        if ParentNode<>nil then begin
          for i:=0 to GetChildCount(ParentNode)-1 do begin
            Sibling:=GetChild(ParentNode,i);
            if Node=GetSiblingNode(Sibling,OppositeAnchor[Side]) then
              Improve(Sibling);
          end;
        end;
        MinPosCalculating:=false;
      end;
      Result:=MinPos;
    end;

  var
    Info: PNodeInfo;
  begin
    Info:=GetNodeInfo(Node);
    //DebugLn(['GetMinPos ',Node.Name,' ',AnchorNames[Side],' ',Info^.MinLeftCalculating]);
    if Side=akLeft then
      Result:=Compute(Info^.MinLeftValid,Info^.MinLeftCalculating,Info^.MinLeft)
    else
      Result:=Compute(Info^.MinTopValid,Info^.MinTopCalculating,Info^.MinTop);
  end;

  function GetChildsMinSize(Node: TObject): TPoint;
  // calculate the minimum size needed to draw the content of the node
  var
    i: Integer;
    Child: TObject;
    ChildMinSize: TPoint;
  begin
    //DebugLn(['GetChildsMinSize ',Node.name]);
    Result:=Point(0,0);
    if IsPages(Node) then begin
      // maximum size of all pages
      for i:=0 to GetChildCount(Node)-1 do begin
        ChildMinSize:=GetMinSize(GetChild(Node,i));
        Result.X:=Max(Result.X,ChildMinSize.X);
        Result.Y:=Max(Result.Y,ChildMinSize.Y);
      end;
    end else begin
      for i:=0 to GetChildCount(Node)-1 do begin
        Child:=GetChild(Node,i);
        ChildMinSize:=GetMinSize(Child);
        Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildMinSize.X);
        Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildMinSize.Y);
      end;
    end;
  end;

  function GetMinSize(Node: TObject): TPoint;
  // calculate the minimum size needed to draw the node
  var
    ChildMinSize: TPoint;
    Info: PNodeInfo;
  begin
    //DebugLn(['GetMinSize ',Node.name]);
    Info:=GetNodeInfo(Node);
    if Info^.MinSizeValid then begin
      Result:=Info^.MinSize;
      exit;
    end;
    if Info^.MinSizeCalculating then begin
      DebugLn(['DebugLayoutAsString.GetMinSize WARNING: anchor circle detected']);
      DumpStack;
      Result:=Point(1,1);
      exit;
    end;
    Info^.MinSizeCalculating:=true;
    Result.X:=2+length(GetName(Node));// border plus name
    Result.Y:=2;  // border
    if GetChildCount(Node)=0 then begin
      if IsSplitter(Node) then
        Result:=Point(1,1); // splitters don't need captions
    end else begin
      ChildMinSize:=GetChildsMinSize(Node);
      Result.X:=Max(Result.X,ChildMinSize.X+2);
      Result.Y:=Max(Result.Y,ChildMinSize.Y+2);
    end;
    //debugln(['GetMinSize ',GetName(Node),' Splitter=',IsSplitter(Node),' MinSize=',dbgs(Result)]);
    Info^.MinSize:=Result;
    Info^.MinSizeValid:=true;
    Info^.MinSizeCalculating:=false;
  end;

  procedure DrawNode(Node: TObject; ARect: TRect);
  var
    i: Integer;
    Child: TObject;
    ChildSize: TPoint;
    ChildRect: TRect;
    AnchorNode: TObject;
  begin
    DebugLn(['DrawNode Node=',GetName(Node),' ARect=',dbgs(ARect)]);
    wrectangle(ARect);
    w(ARect.Left+1,ARect.Top,GetName(Node),ARect.Right);

    for i := 0 to GetChildCount(Node)-1 do begin
      Child:=GetChild(Node,i);
      ChildRect.Left:=ARect.Left+1+GetMinPos(Child,akLeft);
      ChildRect.Top:=ARect.Top+1+GetMinPos(Child,akTop);
      ChildSize:=GetMinSize(Child);
      ChildRect.Right:=ChildRect.Left+ChildSize.X-1;
      ChildRect.Bottom:=ChildRect.Top+ChildSize.Y-1;
      AnchorNode:=GetAnchorNode(Child,akRight);
      if AnchorNode<>nil then begin
        if AnchorNode=Node then
          ChildRect.Right:=ARect.Right-1
        else if GetParentNode(AnchorNode)=Node then
          ChildRect.Right:=ARect.Left+1+GetMinPos(AnchorNode,akLeft)-1;
      end;
      AnchorNode:=GetAnchorNode(Child,akBottom);
      if AnchorNode<>nil then begin
        if AnchorNode=Node then
          ChildRect.Bottom:=ARect.Bottom-1
        else if GetParentNode(AnchorNode)=Node then
          ChildRect.Bottom:=ARect.Top+1+GetMinPos(AnchorNode,akTop)-1;
      end;
      DrawNode(Child,ChildRect);
      if IsPages(Node) then begin
        // paint only one page
        break;
      end;
    end;
  end;

var
  e: string;
  y: Integer;
begin
  Cols:=StrToIntDef(Application.GetOptionValue('ldcn-colunms'),79);
  Rows:=StrToIntDef(Application.GetOptionValue('ldcn-rows'),20);

  InitNodeInfos;
  try
    e:=LineEnding;
    LogCols:=Cols+length(e);
    SetLength(Result,LogCols*Rows);
    // fill space
    FillChar(Result[1],length(Result),' ');
    // add line endings
    for y:=1 to Rows do
      w(Cols+1,y,e);
    // draw node
    DrawNode(RootNode,Rect(1,1,Cols,Rows));
  finally
    FreeNodeInfos;
  end;
end;

procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode);

  procedure WriteControl(Node: TAnchorDockLayoutTreeNode; Prefix: string);
  var
    i: Integer;
    a: TAnchorKind;
    AnchorControl: TAnchorDockLayoutTreeNode;
    AnchorName: String;
  begin
    DbgOut(Prefix);
    DbgOut('"'+Node.Name+'"');
    DbgOut(' Type='+dbgs(Node.NodeType));
    DbgOut(' Bounds=',dbgs(Node.BoundsRect));
    if Node.WindowState<>wsNormal then
      DbgOut(' WindowState=',dbgs(Node.WindowState));
    if Node.Monitor<>0 then
      DbgOut(' Monitor=',dbgs(Node.Monitor));
    debugln;
    for a:=low(TAnchorKind) to high(TAnchorKind) do begin
      if Node.Anchors[a]<>'' then
        AnchorControl:=Node.Parent.FindChildNode(Node.Anchors[a],False)
      else
        AnchorControl:=nil;
      if AnchorControl=nil then
        AnchorName:='Parent'
      else
        AnchorName:=AnchorControl.Name;
      debugln([Prefix,'  ',dbgs(a),'=',AnchorName]);
    end;
    for i:=0 to Node.Count-1 do
      WriteControl(Node[i],Prefix+'  ');
  end;

var
  i: Integer;
begin
  debugln(['DebugWriteChildAnchors RootNode="',RootNode.Name,'" Type=',dbgs(RootNode.NodeType)]);
  for i:=0 to RootNode.Count-1 do
    WriteControl(RootNode[i],'  ');
end;

procedure DebugWriteChildAnchors(RootControl: TWinControl;
  OnlyWinControls, OnlyForms: boolean); overload;

  procedure WriteControl(AControl: TControl; Prefix: string);
  var
    i: Integer;
    a: TAnchorKind;
    AnchorControl: TControl;
    AnchorName: String;
  begin
    if OnlyWinControls and (not (AControl is TWinControl)) then exit;
    if OnlyForms and (not (AControl is TCustomForm)) then exit;
    if not AControl.IsControlVisible then exit;

    debugln([Prefix,DbgSName(AControl),' Caption="',dbgstr(AControl.Caption),'" Align=',dbgs(AControl.Align),' Bounds=',dbgs(AControl.BoundsRect)]);
    for a:=low(TAnchorKind) to high(TAnchorKind) do begin
      AnchorControl:=AControl.AnchorSide[a].Control;
      if AnchorControl=AControl.Parent then
        AnchorName:='Parent'
      else if AnchorControl is TCustomForm then
        AnchorName:='"'+AnchorControl.Name+'"'
      else
        AnchorName:=DbgSName(AnchorControl);
      debugln([Prefix,'  ',dbgs(a),'=',a in AControl.Anchors,' ',AnchorName,' ',dbgs(a,AControl.AnchorSide[a].Side)]);
    end;
    if AControl is TWinControl then begin
      for i:=0 to TWinControl(AControl).ControlCount-1 do
        WriteControl(TWinControl(AControl).Controls[i],Prefix+'  ');
    end;
  end;

var
  i: Integer;
begin
  debugln(['WriteChildAnchors ',DbgSName(RootControl),' Caption="',RootControl.Caption,'" Align=',dbgs(RootControl.Align)]);
  for i:=0 to RootControl.ControlCount-1 do
    WriteControl(RootControl.Controls[i],'  ');
end;

{ TAnchorDockLayoutTreeNode }

function TAnchorDockLayoutTreeNode.GetNodes(Index: integer
  ): TAnchorDockLayoutTreeNode;
begin
  Result:=TAnchorDockLayoutTreeNode(FNodes[Index]);
end;

function TAnchorDockLayoutTreeNode.GetRight: integer;
begin
  Result:=FBoundsRect.Right;
end;

function TAnchorDockLayoutTreeNode.GetHeight: integer;
begin
  Result:=FBoundsRect.Bottom-FBoundsRect.Top;
end;

function TAnchorDockLayoutTreeNode.GetBottom: integer;
begin
  Result:=FBoundsRect.Bottom;
end;

function TAnchorDockLayoutTreeNode.GetAnchors(Site: TAnchorKind): string;
begin
  Result:=fAnchors[Site];
end;

function TAnchorDockLayoutTreeNode.GetLeft: integer;
begin
  Result:=FBoundsRect.Left;
end;

function TAnchorDockLayoutTreeNode.GetTop: integer;
begin
  Result:=FBoundsRect.Top;
end;

function TAnchorDockLayoutTreeNode.GetWidth: integer;
begin
  Result:=FBoundsRect.Right-FBoundsRect.Left;
end;

procedure TAnchorDockLayoutTreeNode.SetAlign(const AValue: TAlign);
begin
  if FAlign=AValue then exit;
  FAlign:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetAnchors(Site: TAnchorKind;
  const AValue: string);
begin
  if Anchors[Site]=AValue then exit;
  fAnchors[Site]:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetBottom(const AValue: integer);
begin
  if GetBottom=AValue then exit;
  FBoundsRect.Bottom:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetBoundsRect(const AValue: TRect);
begin
  if CompareRect(@FBoundsRect,@AValue) then exit;
  FBoundsRect:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetHeaderPosition(
  const AValue: TADLHeaderPosition);
begin
  if FHeaderPosition=AValue then exit;
  FHeaderPosition:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetHeight(const AValue: integer);
begin
  if Height=AValue then exit;
  FBoundsRect.Bottom:=FBoundsRect.Top+AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetLeft(const AValue: integer);
begin
  if Left=AValue then exit;
  FBoundsRect.Left:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetMonitor(const AValue: integer);
begin
  if FMonitor=AValue then exit;
  FMonitor:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetName(const AValue: string);
begin
  if FName=AValue then exit;
  FName:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetNodeType(const AValue: TADLTreeNodeType
  );
begin
  if FNodeType=AValue then exit;
  FNodeType:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetParent(
  const AValue: TAnchorDockLayoutTreeNode);
begin
  if FParent=AValue then exit;
  if FParent<>nil then begin
    FParent.FNodes.Remove(Self);
    FParent.IncreaseChangeStamp;
  end;
  FParent:=AValue;
  if FParent<>nil then
    FParent.FNodes.Add(Self);
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetRight(const AValue: integer);
begin
  if Right=AValue then exit;
  FBoundsRect.Right:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetTabPosition(const AValue: TTabPosition);
begin
  if FTabPosition=AValue then exit;
  FTabPosition:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetTop(const AValue: integer);
begin
  if Top=AValue then exit;
  FBoundsRect.Top:=AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetWidth(const AValue: integer);
begin
  if Width=AValue then exit;
  FBoundsRect.Right:=FBoundsRect.Left+AValue;
  IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeNode.SetWindowState(const AValue: TWindowState);
begin
  if FWindowState=AValue then exit;
  FWindowState:=AValue;
  IncreaseChangeStamp;
end;

constructor TAnchorDockLayoutTreeNode.Create;
begin
  FNodes:=TFPList.Create;
end;

destructor TAnchorDockLayoutTreeNode.Destroy;
begin
  Parent:=nil;
  Clear;
  FreeAndNil(FNodes);
  inherited Destroy;
end;

procedure TAnchorDockLayoutTreeNode.Clear;
var
  a: TAnchorKind;
begin
  Name:='';
  FillByte(FBoundsRect,sizeOf(FBoundsRect),0);
  while Count>0 do Nodes[Count-1].Free;
  NodeType:=adltnNone;
  WindowState:=wsNormal;
  Monitor:=0;
  for a:=low(TAnchorKind) to high(TAnchorKind) do
    Anchors[a]:='';
end;

function TAnchorDockLayoutTreeNode.IsEqual(Node: TAnchorDockLayoutTreeNode
  ): boolean;
var
  i: Integer;
  a: TAnchorKind;
begin
  Result:=false;
  if (not CompareRect(@FBoundsRect,@Node.FBoundsRect))
  or (Count<>Node.Count)
  or (NodeType<>Node.NodeType)
  or (Name<>Node.Name)
  or (Align<>Node.Align)
  or (WindowState<>Node.WindowState)
  or (HeaderPosition<>Node.HeaderPosition)
  or (TabPosition<>Node.TabPosition)
  then
    exit;
  for a:=low(TAnchorKind) to high(TAnchorKind) do
    if Anchors[a]<>Node.Anchors[a] then exit;
  for i:=0 to Count-1 do
    if not Nodes[i].IsEqual(Node.Nodes[i]) then exit;
  Result:=true;
end;

procedure TAnchorDockLayoutTreeNode.Assign(Node: TAnchorDockLayoutTreeNode);
var
  i: Integer;
  Child: TAnchorDockLayoutTreeNode;
  a: TAnchorKind;
begin
  Name:=Node.Name;
  NodeType:=Node.NodeType;
  BoundsRect:=Node.BoundsRect;
  Align:=Node.Align;
  WindowState:=Node.WindowState;
  HeaderPosition:=Node.HeaderPosition;
  TabPosition:=Node.TabPosition;
  for a:=low(TAnchorKind) to high(TAnchorKind) do
    Anchors[a]:=Node.Anchors[a];
  while Count>Node.Count do Nodes[Count-1].Free;
  for i:=0 to Node.Count-1 do begin
    if i=Count then begin
      Child:=TAnchorDockLayoutTreeNode.Create;
      Child.Parent:=Self;
    end else begin
      Child:=Nodes[i];
    end;
    Child.Assign(Node.Nodes[i]);
  end;
end;

procedure TAnchorDockLayoutTreeNode.Assign(AControl: TControl);
var
  AnchorControl: TControl;
  a: TAnchorKind;
begin
  Name:=AControl.Name;
  BoundsRect:=AControl.BoundsRect;
  Align:=AControl.Align;
  if (AControl.Parent=nil) and (AControl is TCustomForm) then begin
    WindowState:=TCustomForm(AControl).WindowState;
    Monitor:=TCustomForm(AControl).Monitor.MonitorNum;
  end else
    WindowState:=wsNormal;
  if AControl is TCustomNotebook then
    TabPosition:=TCustomNotebook(AControl).TabPosition
  else
    TabPosition:=tpTop;
  for a:=low(TAnchorKind) to high(TAnchorKind) do begin
    AnchorControl:=AControl.AnchorSide[a].Control;
    if (AnchorControl=nil) or (AnchorControl=AControl.Parent) then
      Anchors[a]:=''
    else if AnchorControl.Parent=AControl.Parent then
      Anchors[a]:=AnchorControl.Name;
  end;
end;

procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Config: TConfigStorage);
var
  i: Integer;
  Child: TAnchorDockLayoutTreeNode;
  NewCount: longint;
begin
  Clear;
  Name:=Config.GetValue('Name','');
  NodeType:=NameToADLTreeNodeType(Config.GetValue('Type',ADLTreeNodeTypeNames[adltnNone]));
  Left:=Config.GetValue('Bounds/Left',0);
  Top:=Config.GetValue('Bounds/Top',0);
  Width:=Config.GetValue('Bounds/Width',0);
  Height:=Config.GetValue('Bounds/Height',0);
  Anchors[akLeft]:=Config.GetValue('Anchors/Left','');
  Anchors[akTop]:=Config.GetValue('Anchors/Top','');
  Anchors[akRight]:=Config.GetValue('Anchors/Right','');
  Anchors[akBottom]:=Config.GetValue('Anchors/Bottom','');
  Align:=NameToADLAlign(Config.GetValue('Anchors/Align',AlignNames[alNone]));
  WindowState:=NameToADLWindowState(Config.GetValue('WindowState',ADLWindowStateNames[wsNormal]));
  HeaderPosition:=NameToADLHeaderPosition(Config.GetValue('Header/Position',ADLHeaderPositionNames[adlhpAuto]));
  TabPosition:=NameToADLTabPosition(Config.GetValue('Header/TabPosition',ADLTabPostionNames[tpTop]));
  Monitor:=Config.GetValue('Monitor',0);
  NewCount:=Config.GetValue('ChildCount',0);
  for i:=1 to NewCount do begin
    Config.AppendBasePath('Item'+IntToStr(i)+'/');
    Child:=TAnchorDockLayoutTreeNode.Create;
    Child.Parent:=Self;
    Child.LoadFromConfig(Config);
    Config.UndoAppendBasePath;
  end;
end;

procedure TAnchorDockLayoutTreeNode.SaveToConfig(Config: TConfigStorage);
var
  i: Integer;
begin
  Config.SetDeleteValue('Name',Name,'');
  Config.SetDeleteValue('Type',ADLTreeNodeTypeNames[NodeType],
                               ADLTreeNodeTypeNames[adltnNone]);
  Config.SetDeleteValue('Bounds/Left',Left,0);
  Config.SetDeleteValue('Bounds/Top',Top,0);
  Config.SetDeleteValue('Bounds/Width',Width,0);
  Config.SetDeleteValue('Bounds/Height',Height,0);
  Config.SetDeleteValue('Anchors/Left',Anchors[akLeft],'');
  Config.SetDeleteValue('Anchors/Top',Anchors[akTop],'');
  Config.SetDeleteValue('Anchors/Right',Anchors[akRight],'');
  Config.SetDeleteValue('Anchors/Bottom',Anchors[akBottom],'');
  Config.SetDeleteValue('Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]);
  Config.SetDeleteValue('WindowState',ADLWindowStateNames[WindowState],
                                      ADLWindowStateNames[wsNormal]);
  Config.SetDeleteValue('Header/Position',ADLHeaderPositionNames[HeaderPosition],
                                          ADLHeaderPositionNames[adlhpAuto]);
  Config.SetDeleteValue('Header/TabPosition',ADLTabPostionNames[TabPosition],
                                             ADLTabPostionNames[tpTop]);
  Config.SetDeleteValue('Monitor',Monitor,0);
  Config.SetDeleteValue('ChildCount',Count,0);
  for i:=1 to Count do begin
    Config.AppendBasePath('Item'+IntToStr(i)+'/');
    Nodes[i-1].SaveToConfig(Config);
    Config.UndoAppendBasePath;
  end;
end;

function TAnchorDockLayoutTreeNode.FindChildNode(aName: string;
  Recursive: boolean): TAnchorDockLayoutTreeNode;
var
  i: Integer;
begin
  for i:=0 to Count-1 do begin
    Result:=Nodes[i];
    if CompareText(aName,Result.Name)=0 then exit;
    if Recursive then begin
      Result:=Result.FindChildNode(aName,true);
      if Result<>nil then exit;
    end;
  end;
  Result:=nil;
end;

function TAnchorDockLayoutTreeNode.FindControlNode: TAnchorDockLayoutTreeNode;
var
  i: Integer;
begin
  if NodeType=adltnControl then
    Result:=Self
  else
    for i:=0 to Count-1 do begin
      Result:=Nodes[i].FindControlNode;
      if Result<>nil then exit;
    end;
end;

procedure TAnchorDockLayoutTreeNode.CheckConsistency;
{ ToDo: check that all childs are connected
        check for topological sort
        check for not overlapping (the bounds can overlap because of constraints)
}
var
  i: Integer;
  Child: TAnchorDockLayoutTreeNode;
  Side: TAnchorKind;
  Sibling: TAnchorDockLayoutTreeNode;
begin
  // check parent
  if (NodeType=adltnNone) and (Parent<>nil) then
    raise EAnchorDockLayoutError.Create('invalid parent');
  if (NodeType=adltnCustomSite) and (Parent.NodeType<>adltnNone) then
    raise EAnchorDockLayoutError.Create('invalid parent');

  // check sides
  for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
    if Anchors[Side]<>'' then begin
      // anchor must be a sibling
      Sibling:=nil;
      if Parent<>nil then
        Sibling:=Parent.FindChildNode(Anchors[Side],false);
      if (Sibling=nil) then
        raise EAnchorDockLayoutError.Create(
          Format(adrsAnchorNotFoundNodeAnchors, ['"', Name, '"', dbgs(Side),
            '"', Anchors[Side], '"']));
      // only anchor to splitter
      if not Sibling.IsSplitter then
        raise EAnchorDockLayoutError.Create(
          Format(adrsAnchorIsNotSplitterNodeAnchors, ['"', Name, '"', dbgs(Side
            ), '"', Anchors[Side], '"']));
      // the free sides of a splitter must not be anchored
      if ((NodeType=adltnSplitterVertical) and (Side in [akLeft,akRight]))
      or ((NodeType=adltnSplitterHorizontal) and (Side in [akTop,akBottom]))
      then
        raise EAnchorDockLayoutError.Create(
          Format(adrsAFreeSideOfASplitterMustNotBeAnchoredNodeTypeAncho, ['"',
            Name, '"', ADLTreeNodeTypeNames[NodeType], dbgs(Side), '"', Anchors[
            Side], '"']));
      // a page must not be anchored
      if (Parent.NodeType=adltnPages) then
        raise EAnchorDockLayoutError.Create(
          Format(adrsAPageMustNotBeAnchoredNodeParentParentTypeAnchors, ['"',
            Name, '"', Parent.Name, ADLTreeNodeTypeNames[Parent.NodeType], dbgs(
            Side), '"', Anchors[Side], '"']));
      // check if anchored to the wrong side of a splitter
      if ((Sibling.NodeType=adltnSplitterHorizontal) and (Side in [akLeft,akRight]))
      or ((Sibling.NodeType=adltnSplitterVertical) and (Side in [akTop,akBottom]))
      then
        raise EAnchorDockLayoutError.Create(
          Format(adrsAnchorToWrongSideOfSplitterNodeAnchors, ['"', Name, '"',
            dbgs(Side), '"', Anchors[Side], '"']));
    end;
  end;

  // only the root node, pages, layouts and customsite can have children
  if (Parent<>nil) and (Count>0)
  and (not (NodeType in [adltnLayout,adltnPages,adltnCustomSite]))
  then
    raise EAnchorDockLayoutError.Create(
      Format(adrsNoChildrenAllowedForNodeType, ['"', Name, '"',
        ADLTreeNodeTypeNames[NodeType]]));
  if (NodeType=adltnCustomSite) then begin
    if (Count>1) then
      raise EAnchorDockLayoutError.Create(Format(
        adrsCustomDockSiteCanHaveOnlyOneSite, ['"', Name, '"']));
  end;

  // check grandchild
  for i:=0 to Count-1 do begin
    Child:=Nodes[i];
    Child.CheckConsistency;
  end;
end;

procedure TAnchorDockLayoutTreeNode.Simplify(ExistingNames: TStrings);
{ Simplification rules:
   1. Control nodes without existing name are deleted.
   2. Empty layouts and pages are deleted
   3. pages and layouts with only one child are removed and its content moved up
}
var
  i: Integer;
  ChildNode: TAnchorDockLayoutTreeNode;
begin
  // simplify childs
  i:=Count-1;
  while i>=0 do begin
    ChildNode:=Nodes[i];
    ChildNode.Simplify(ExistingNames);

    if (ChildNode.NodeType=adltnControl) then begin
      // leaf node => check if there is a control
      if (ChildNode.Name='') or (ExistingNames.IndexOf(ChildNode.Name)<0) then
        DeleteNode(ChildNode);
    end else if ChildNode.IsSplitter then begin
      // splitter
      // delete all children
      while ChildNode.Count>0 do
        ChildNode[0].Free;
    end else if ChildNode.NodeType=adltnCustomSite then begin
      // custom dock site
    end else if ChildNode.Count=0 then begin
      // inner node without child => delete
      DeleteNode(ChildNode);
    end else if (ChildNode.Count=1)
    and (ChildNode.NodeType in [adltnLayout,adltnPages]) then begin
      // layouts and pages with only one child
      // => move grandchildren up and delete childnode
      ReplaceWithChildren(ChildNode);
    end;

    i:=Min(i,Count)-1;
  end;
end;

procedure TAnchorDockLayoutTreeNode.DeleteNode(
  ChildNode: TAnchorDockLayoutTreeNode);
var
  i: Integer;
  Sibling: TAnchorDockLayoutTreeNode;
  Side: TAnchorKind;
  Splitter: TAnchorDockLayoutTreeNode;
begin
  WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode BEFORE DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self);
  ChildNode.Parent:=nil;
  try
    if not ChildNode.IsSplitter then begin
      // delete node bound splitter (= a splitter only anchored to this node)
      for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
        Splitter:=FindNodeBoundSplitter(ChildNode,Side);
        if Splitter<>nil then begin
          DeleteNodeBoundSplitter(Splitter,ChildNode,OppositeAnchor[Side]);
          exit;
        end;
      end;

      // delete spiral splitter
      for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
        Splitter:=FindChildNode(ChildNode.Anchors[Side],false);
        if (Splitter=nil) or (not Splitter.IsSplitter) then break;
        if Side=High(TAnchorKind) then begin
          DeleteSpiralSplitter(ChildNode);
          exit;
        end;
      end;
    end;
  finally
    // remove references
    for i:=0 to Count-1 do begin
      Sibling:=Nodes[i];
      for Side:=low(TAnchorKind) to high(TAnchorKind) do
        if Sibling.Anchors[Side]=ChildNode.Name then
          Sibling.Anchors[Side]:='';
    end;
    WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode AFTER DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self);
    // free node
    ChildNode.Free;
  end;
end;

function TAnchorDockLayoutTreeNode.FindNodeBoundSplitter(
  ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind
  ): TAnchorDockLayoutTreeNode;
var
  AnchorNode: TAnchorDockLayoutTreeNode;
  i: Integer;
  AnchorName: string;
begin
  Result:=nil;
  AnchorName:=ChildNode.Anchors[Side];
  if AnchorName='' then exit;
  AnchorNode:=FindChildNode(AnchorName,false);
  if (AnchorNode=nil) or (not AnchorNode.IsSplitter) then exit;
  for i:=0 to Count-1 do
    if (Nodes[i]<>ChildNode) and (Nodes[i].Anchors[Side]=AnchorName) then exit;
  Result:=AnchorNode;
end;

procedure TAnchorDockLayoutTreeNode.DeleteNodeBoundSplitter(Splitter,
  ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind);
{ delete node bound splitter (= a splitter only anchored to this node)

  Example: Side=akRight
                      #             #
    #####################     #########
       ---+S+--------+#         ---+#
       ---+S|AControl|#   --->  ---+#
       ---+S+--------+#         ---+#
    #####################     #########
}
var
  i: Integer;
  Sibling: TAnchorDockLayoutTreeNode;
begin
  for i:=0 to Count-1 do begin
    Sibling:=Nodes[i];
    if Sibling.Anchors[Side]=Splitter.Name then
      Sibling.Anchors[Side]:=ChildNode.Anchors[Side];
  end;
  DeleteNode(Splitter);
end;

procedure TAnchorDockLayoutTreeNode.DeleteSpiralSplitter(
  ChildNode: TAnchorDockLayoutTreeNode);
{ Merge two splitters and delete one of them.
  Prefer the pair with shortest distance between.

  For example:
               3            3
     11111111113            3
        2+----+3            3
        2|Node|3  --->  111111111
        2+----+3            2
        2444444444          2
        2                   2
   Everything anchored to 4 is now anchored to 1.
   And right side of 1 is now anchored to where the right side of 4 was anchored.
}
var
  Splitters: array[TAnchorKind] of TAnchorDockLayoutTreeNode;
  Side: TAnchorKind;
  i: Integer;
  Sibling: TAnchorDockLayoutTreeNode;
  Keep: TAnchorKind;
  DeleteSplitter: TAnchorDockLayoutTreeNode;
  NextSide: TAnchorKind;
begin
  // find the four splitters
  for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
    Splitters[Side]:=FindChildNode(ChildNode.Anchors[Side],false);
    if (Splitters[Side]=nil) or (not Splitters[Side].IsSplitter) then
      RaiseGDBException(''); // missing splitter
  end;
  for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
    // spiral splitters are connected to each other
    NextSide:=ClockwiseAnchor[Side];
    if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then begin
      NextSide:=OppositeAnchor[NextSide];
      if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then
        RaiseGDBException(''); // this is not a spiral splitter
    end;
  end;
  // Prefer the pair with shortest distance between
  if (Splitters[akRight].Left-Splitters[akLeft].Left)
    <(Splitters[akBottom].Top-Splitters[akTop].Top)
  then
    Keep:=akLeft
  else
    Keep:=akTop;
  DeleteSplitter:=Splitters[OppositeAnchor[Keep]];
  // transfer anchors from the deleting splitter to the kept splitter
  for i:=0 to Count-1 do begin
    Sibling:=Nodes[i];
    for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
      if FindChildNode(Sibling.Anchors[Side],false)=DeleteSplitter then
        Sibling.Anchors[Side]:=Splitters[Keep].Name;
    end;
  end;
  // longen kept splitter
  NextSide:=ClockwiseAnchor[Keep];
  if Splitters[Keep].Anchors[NextSide]<>Splitters[NextSide].Name then
    NextSide:=OppositeAnchor[NextSide];
  Splitters[Keep].Anchors[NextSide]:=DeleteSplitter.Anchors[NextSide];
  // delete the splitter
  DeleteNode(DeleteSplitter);
end;

procedure TAnchorDockLayoutTreeNode.ReplaceWithChildren(
  ChildNode: TAnchorDockLayoutTreeNode);
{ move all children of ChildNode up.
  All anchored to ChildNode (= their parent) use the anchors of ChildNode.
  ChildNode is freed.
}
var
  GrandChild: TAnchorDockLayoutTreeNode;
  Side: TAnchorKind;
begin
  WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren BEFORE REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self);
  DebugWriteChildAnchors(Self);
  while ChildNode.Count>0 do begin
    GrandChild:=ChildNode[0];
    GrandChild.Parent:=Self;
    OffsetRect(GrandChild.FBoundsRect,ChildNode.Left,ChildNode.Top);
    for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
      if GrandChild.Anchors[Side]='' then begin
        if ((GrandChild.NodeType=adltnSplitterHorizontal)
            and (Side in [akTop,akBottom]))
        or ((GrandChild.NodeType=adltnSplitterVertical)
            and (Side in [akLeft,akRight]))
        then
          continue; // a free splitter sides => don't anchor it
        GrandChild.Anchors[Side]:=ChildNode.Anchors[Side];
      end;
    end;
  end;
  WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren AFTER REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self);
  ChildNode.Free;
  DebugWriteChildAnchors(Self);
end;

procedure TAnchorDockLayoutTreeNode.IncreaseChangeStamp;
begin
  if Parent<>nil then Parent.IncreaseChangeStamp;
end;

function TAnchorDockLayoutTreeNode.IsSplitter: boolean;
begin
  Result:=NodeType in [adltnSplitterHorizontal,adltnSplitterVertical];
end;

function TAnchorDockLayoutTreeNode.IsRootWindow: boolean;
begin
  Result:=(NodeType in [adltnLayout,adltnPages,adltnControl,adltnCustomSite])
          and ((Parent=nil) or (Parent.NodeType in [adltnNone]));
end;

function TAnchorDockLayoutTreeNode.Count: integer;
begin
  Result:=FNodes.Count;
end;

{ TAnchorDockLayoutTreeRootNode }

procedure TAnchorDockLayoutTreeRootNode.IncreaseChangeStamp;
begin
  Tree.IncreaseChangeStamp;
end;

procedure TAnchorDockLayoutTreeRootNode.CheckConsistency;
var
  Names: TStringList;

  procedure RaiseNodePath(const Msg: string; Node: TAnchorDockLayoutTreeNode);
  var
    s: String;
  begin
    s:='';
    while Node<>nil do begin
      if s<>'' then
        s:='/'+s;
      s:=Node.Name+s;
      Node:=Node.Parent;
    end;
    s:=Msg+s;
  end;

  procedure CheckNames(Node: TAnchorDockLayoutTreeNode);
  var
    i: Integer;
  begin
    if (Node.Name='') and (Node<>Self) then
      RaiseNodePath(adrsEmptyName, Node);
    for i:=0 to Names.Count-1 do
      if CompareText(Names[i],Node.Name)=0 then
        RaiseNodePath(adrsDuplicateName, Node);
    Names.Add(Node.Name);
    for i:=0 to Node.Count-1 do
      CheckNames(Node[i]);
  end;

begin
  // check that all names are unique
  Names:=TStringList.Create;
  try
    CheckNames(Self);
  finally
    Names.Free;
  end;
  inherited CheckConsistency;
end;

{ TAnchorDockLayoutTree }

procedure TAnchorDockLayoutTree.SetModified(const AValue: boolean);
begin
  if AValue then IncreaseChangeStamp;
  if FModified=AValue then exit;
  FModified:=AValue;
end;

constructor TAnchorDockLayoutTree.Create;
begin
  FRoot:=TAnchorDockLayoutTreeRootNode.Create;
  Root.FTree:=Self;
end;

destructor TAnchorDockLayoutTree.Destroy;
begin
  FreeAndNil(FRoot);
  inherited Destroy;
end;

procedure TAnchorDockLayoutTree.Clear;
begin
  FRoot.Clear;
  Modified:=false;
end;

procedure TAnchorDockLayoutTree.LoadFromConfig(Config: TConfigStorage);
begin
  Config.AppendBasePath('Nodes/');
  FRoot.LoadFromConfig(Config);
  Config.UndoAppendBasePath;
  Root.CheckConsistency;
end;

procedure TAnchorDockLayoutTree.SaveToConfig(Config: TConfigStorage);
begin
  Config.AppendBasePath('Nodes/');
  FRoot.SaveToConfig(Config);
  Config.UndoAppendBasePath;
end;

procedure TAnchorDockLayoutTree.IncreaseChangeStamp;
begin
  if FChangeStamp<High(FChangeStamp) then
    inc(FChangeStamp)
  else
    FChangeStamp:=Low(FChangeStamp);
end;

function TAnchorDockLayoutTree.NewNode(aParent: TAnchorDockLayoutTreeNode
  ): TAnchorDockLayoutTreeNode;
begin
  Result:=TAnchorDockLayoutTreeNode.Create;
  Result.Parent:=aParent;
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;

end.