← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/anchordocking/anchordockstorage.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/anchordocking/anchordockstorage.pas
 
1
{ Unit implementing anchor docking storage tree.
 
2
 
 
3
  Copyright (C) 2010 Mattias Gaertner mattias@freepascal.org
 
4
 
 
5
  This library is free software; you can redistribute it and/or modify it
 
6
  under the terms of the GNU Library General Public License as published by
 
7
  the Free Software Foundation; either version 2 of the License, or (at your
 
8
  option) any later version with the following modification:
 
9
 
 
10
  As a special exception, the copyright holders of this library give you
 
11
  permission to link this library with independent modules to produce an
 
12
  executable, regardless of the license terms of these independent modules,and
 
13
  to copy and distribute the resulting executable under terms of your choice,
 
14
  provided that you also meet, for each linked independent module, the terms
 
15
  and conditions of the license of that module. An independent module is a
 
16
  module which is not derived from or based on this library. If you modify
 
17
  this library, you may extend this exception to your version of the library,
 
18
  but you are not obligated to do so. If you do not wish to do so, delete this
 
19
  exception statement from your version.
 
20
 
 
21
  This program is distributed in the hope that it will be useful, but WITHOUT
 
22
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
23
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
 
24
  for more details.
 
25
 
 
26
  You should have received a copy of the GNU Library General Public License
 
27
  along with this library; if not, write to the Free Software Foundation,
 
28
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
29
}
 
30
Unit AnchorDockStorage;
 
31
 
 
32
{$mode objfpc}{$H+}
 
33
 
 
34
interface
 
35
 
 
36
uses
 
37
  Math, Classes, SysUtils, LCLProc, AvgLvlTree, ExtCtrls, ComCtrls, Forms,
 
38
  Controls, LazConfigStorage, AnchorDockStr;
 
39
 
 
40
const
 
41
  AnchorDockSplitterName = 'AnchorDockSplitter';
 
42
  AnchorDockSiteName = 'AnchorDockSite';
 
43
type
 
44
  TADLTreeNodeType = (
 
45
    adltnNone,
 
46
    adltnLayout,
 
47
    adltnControl,
 
48
    adltnSplitterHorizontal,
 
49
    adltnSplitterVertical,
 
50
    adltnPages,
 
51
    adltnCustomSite
 
52
    );
 
53
  TADLTreeNodeTypes = set of TADLTreeNodeType;
 
54
 
 
55
  TADLHeaderPosition = (
 
56
    adlhpAuto,
 
57
    adlhpTop,
 
58
    adlhpLeft,
 
59
    adlhpRight,
 
60
    adlhpBottom
 
61
    );
 
62
  TADLHeaderPositions = set of TADLHeaderPosition;
 
63
 
 
64
  EAnchorDockLayoutError = class(Exception);
 
65
 
 
66
  { TAnchorDockLayoutTreeNode }
 
67
 
 
68
  TAnchorDockLayoutTreeNode = class
 
69
  private
 
70
    FAlign: TAlign;
 
71
    fAnchors: array[TAnchorKind] of string;
 
72
    FBoundSplitterPos: integer;
 
73
    FBoundsRect: TRect;
 
74
    FHeaderPosition: TADLHeaderPosition;
 
75
    FMonitor: integer;
 
76
    FName: string;
 
77
    FNodes: TFPList; // list of TAnchorDockLayoutTreeNode
 
78
    FNodeType: TADLTreeNodeType;
 
79
    FParent: TAnchorDockLayoutTreeNode;
 
80
    FWorkAreaRect: TRect;
 
81
    FTabPosition: TTabPosition;
 
82
    FWindowState: TWindowState;
 
83
    function GetAnchors(Site: TAnchorKind): string;
 
84
    function GetBottom: integer;
 
85
    function GetHeight: integer;
 
86
    function GetLeft: integer;
 
87
    function GetNodes(Index: integer): TAnchorDockLayoutTreeNode;
 
88
    function GetRight: integer;
 
89
    function GetTop: integer;
 
90
    function GetWidth: integer;
 
91
    procedure SetAlign(const AValue: TAlign);
 
92
    procedure SetAnchors(Site: TAnchorKind; const AValue: string);
 
93
    procedure SetBottom(const AValue: integer);
 
94
    procedure SetBoundSplitterPos(const AValue: integer);
 
95
    procedure SetBoundsRect(const AValue: TRect);
 
96
    procedure SetHeaderPosition(const AValue: TADLHeaderPosition);
 
97
    procedure SetHeight(const AValue: integer);
 
98
    procedure SetLeft(const AValue: integer);
 
99
    procedure SetMonitor(const AValue: integer);
 
100
    procedure SetName(const AValue: string);
 
101
    procedure SetNodeType(const AValue: TADLTreeNodeType);
 
102
    procedure SetParent(const AValue: TAnchorDockLayoutTreeNode);
 
103
    procedure SetRight(const AValue: integer);
 
104
    procedure SetWorkAreaRect(const AValue: TRect);
 
105
    procedure SetTabPosition(const AValue: TTabPosition);
 
106
    procedure SetTop(const AValue: integer);
 
107
    procedure SetWidth(const AValue: integer);
 
108
    procedure SetWindowState(const AValue: TWindowState);
 
109
  public
 
110
    constructor Create;
 
111
    destructor Destroy; override;
 
112
    procedure Clear;
 
113
    function IsEqual(Node: TAnchorDockLayoutTreeNode): boolean;
 
114
    procedure Assign(Node: TAnchorDockLayoutTreeNode);
 
115
    procedure Assign(AControl: TControl);
 
116
    procedure LoadFromConfig(Config: TConfigStorage);
 
117
    procedure SaveToConfig(Config: TConfigStorage);
 
118
    function FindChildNode(aName: string; Recursive: boolean): TAnchorDockLayoutTreeNode;
 
119
    function FindControlNode: TAnchorDockLayoutTreeNode;
 
120
    procedure CheckConsistency; virtual;
 
121
 
 
122
    // simplifying
 
123
    procedure Simplify(ExistingNames: TStrings);
 
124
    procedure DeleteNode(ChildNode: TAnchorDockLayoutTreeNode);
 
125
    function FindNodeBoundSplitter(ChildNode: TAnchorDockLayoutTreeNode;
 
126
                                   Side: TAnchorKind): TAnchorDockLayoutTreeNode;
 
127
    procedure DeleteNodeBoundSplitter(Splitter, ChildNode: TAnchorDockLayoutTreeNode;
 
128
                                      Side: TAnchorKind);
 
129
    procedure DeleteSpiralSplitter(ChildNode: TAnchorDockLayoutTreeNode);
 
130
    procedure ReplaceWithChildren(ChildNode: TAnchorDockLayoutTreeNode);
 
131
 
 
132
    // properties
 
133
    procedure IncreaseChangeStamp; virtual;
 
134
    property Name: string read FName write SetName;
 
135
    property NodeType: TADLTreeNodeType read FNodeType write SetNodeType;
 
136
    property Parent: TAnchorDockLayoutTreeNode read FParent write SetParent;
 
137
    property Left: integer read GetLeft write SetLeft;
 
138
    property Top: integer read GetTop write SetTop;
 
139
    property Width: integer read GetWidth write SetWidth;
 
140
    property Height: integer read GetHeight write SetHeight;
 
141
    property Right: integer read GetRight write SetRight;
 
142
    property Bottom: integer read GetBottom write SetBottom;
 
143
    property BoundsRect: TRect read FBoundsRect write SetBoundsRect;
 
144
    property BoundSplitterPos: integer read FBoundSplitterPos write SetBoundSplitterPos;
 
145
    property WorkAreaRect: TRect read FWorkAreaRect write SetWorkAreaRect;
 
146
    property Anchors[Site: TAnchorKind]: string read GetAnchors write SetAnchors; // empty means default (parent)
 
147
    property Align: TAlign read FAlign write SetAlign;
 
148
    property WindowState: TWindowState read FWindowState write SetWindowState;
 
149
    property Monitor: integer read FMonitor write SetMonitor;
 
150
    property HeaderPosition: TADLHeaderPosition read FHeaderPosition write SetHeaderPosition;
 
151
    property TabPosition: TTabPosition read FTabPosition write SetTabPosition;
 
152
    function Count: integer;
 
153
    function IsSplitter: boolean;
 
154
    function IsRootWindow: boolean;
 
155
    property Nodes[Index: integer]: TAnchorDockLayoutTreeNode read GetNodes; default;
 
156
  end;
 
157
 
 
158
  TAnchorDockLayoutTree = class;
 
159
 
 
160
  { TAnchorDockLayoutTreeRootNode }
 
161
 
 
162
  TAnchorDockLayoutTreeRootNode = class(TAnchorDockLayoutTreeNode)
 
163
  private
 
164
    FTree: TAnchorDockLayoutTree;
 
165
  public
 
166
    procedure IncreaseChangeStamp; override;
 
167
    property Tree: TAnchorDockLayoutTree read FTree write FTree;
 
168
    procedure CheckConsistency; override;
 
169
  end;
 
170
 
 
171
  { TAnchorDockLayoutTree }
 
172
 
 
173
  TAnchorDockLayoutTree = class
 
174
  private
 
175
    FChangeStamp: int64;
 
176
    FModified: boolean;
 
177
    FRoot: TAnchorDockLayoutTreeRootNode;
 
178
    procedure SetModified(const AValue: boolean);
 
179
  public
 
180
    constructor Create;
 
181
    destructor Destroy; override;
 
182
    procedure Clear;
 
183
    procedure LoadFromConfig(Config: TConfigStorage);
 
184
    procedure SaveToConfig(Config: TConfigStorage);
 
185
    procedure IncreaseChangeStamp;
 
186
    property ChangeStamp: int64 read FChangeStamp;
 
187
    property Modified: boolean read FModified write SetModified;
 
188
    property Root: TAnchorDockLayoutTreeRootNode read FRoot;
 
189
    function NewNode(aParent: TAnchorDockLayoutTreeNode): TAnchorDockLayoutTreeNode;
 
190
  end;
 
191
 
 
192
  { TAnchorDockRestoreLayout }
 
193
 
 
194
  TAnchorDockRestoreLayout = class
 
195
  private
 
196
    FControlNames: TStrings;
 
197
    FLayout: TAnchorDockLayoutTree;
 
198
    procedure SetControlNames(const AValue: TStrings);
 
199
  public
 
200
    constructor Create; overload;
 
201
    constructor Create(aLayout: TAnchorDockLayoutTree); overload;
 
202
    destructor Destroy; override;
 
203
    function IndexOfControlName(AName: string): integer;
 
204
    function HasControlName(AName: string): boolean;
 
205
    procedure RemoveControlName(AName: string);
 
206
    procedure UpdateControlNames;
 
207
    procedure LoadFromConfig(Config: TConfigStorage);
 
208
    procedure SaveToConfig(Config: TConfigStorage);
 
209
    property ControlNames: TStrings read FControlNames write SetControlNames;
 
210
    property Layout: TAnchorDockLayoutTree read FLayout;
 
211
  end;
 
212
 
 
213
  { TAnchorDockRestoreLayouts }
 
214
 
 
215
  TAnchorDockRestoreLayouts = class
 
216
  private
 
217
    fItems: TFPList;
 
218
    function GetItems(Index: integer): TAnchorDockRestoreLayout;
 
219
  public
 
220
    constructor Create;
 
221
    destructor Destroy; override;
 
222
    procedure Clear;
 
223
    procedure Delete(Index: integer);
 
224
    function IndexOfName(AControlName: string): integer;
 
225
    function FindByName(AControlName: string): TAnchorDockRestoreLayout;
 
226
    procedure Add(Layout: TAnchorDockRestoreLayout; RemoveOther: boolean);
 
227
    procedure RemoveByName(AControlName: string);
 
228
    procedure LoadFromConfig(Config: TConfigStorage);
 
229
    procedure SaveToConfig(Config: TConfigStorage);
 
230
    function ConfigIsEmpty(Config: TConfigStorage): boolean;
 
231
    function Count: integer;
 
232
    property Items[Index: integer]: TAnchorDockRestoreLayout read GetItems;
 
233
  end;
 
234
 
 
235
  { TADNameToControl }
 
236
 
 
237
  TADNameToControl = class
 
238
  private
 
239
    fItems: TStringList;
 
240
    function IndexOfName(const aName: string): integer;
 
241
    function GetControl(const aName: string): TControl;
 
242
    procedure SetControl(const aName: string; const AValue: TControl);
 
243
  public
 
244
    constructor Create;
 
245
    destructor Destroy; override;
 
246
    function ControlToName(AControl: TControl): string;
 
247
    property Control[const aName: string]: TControl read GetControl write SetControl; default;
 
248
    procedure RemoveControl(AControl: TControl);
 
249
    procedure WriteDebugReport(Msg: string);
 
250
  end;
 
251
 
 
252
const
 
253
  ADLTreeNodeTypeNames: array[TADLTreeNodeType] of string = (
 
254
    'None',
 
255
    'Layout',
 
256
    'Control',
 
257
    'SplitterHorizontal',
 
258
    'SplitterVertical',
 
259
    'Pages',
 
260
    'CustomSite'
 
261
    );
 
262
  ADLWindowStateNames: array[TWindowState] of string = (
 
263
    'Normal',
 
264
    'Minimized',
 
265
    'Maximized',
 
266
    'Fullscreen'
 
267
    );
 
268
  ADLHeaderPositionNames: array[TADLHeaderPosition] of string = (
 
269
    'auto',
 
270
    'left',
 
271
    'top',
 
272
    'right',
 
273
    'bottom'
 
274
    );
 
275
  ADLTabPostionNames: array[TTabPosition] of string = (
 
276
    'Top',
 
277
    'Bottom',
 
278
    'Left',
 
279
    'Right'
 
280
    );
 
281
  ADLAlignNames: array[TAlign] of string = (
 
282
    'None',
 
283
    'Top',
 
284
    'Bottom',
 
285
    'Left',
 
286
    'Right',
 
287
    'Client',
 
288
    'Custom'
 
289
    );
 
290
 
 
291
function NameToADLTreeNodeType(s: string): TADLTreeNodeType;
 
292
function NameToADLWindowState(s: string): TWindowState;
 
293
function NameToADLHeaderPosition(s: string): TADLHeaderPosition;
 
294
function NameToADLTabPosition(s: string): TTabPosition;
 
295
function NameToADLAlign(s: string): TAlign;
 
296
function dbgs(const NodeType: TADLTreeNodeType): string; overload;
 
297
 
 
298
procedure WriteDebugLayout(Title: string; RootNode: TObject);
 
299
function DebugLayoutAsString(RootNode: TObject): string;
 
300
procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode); overload;
 
301
procedure DebugWriteChildAnchors(RootControl: TWinControl;
 
302
                                 OnlyWinControls, OnlyForms: boolean); overload;
 
303
 
 
304
implementation
 
305
 
 
306
function NameToADLTreeNodeType(s: string): TADLTreeNodeType;
 
307
begin
 
308
  for Result:=low(TADLTreeNodeType) to high(TADLTreeNodeType) do
 
309
    if s=ADLTreeNodeTypeNames[Result] then exit;
 
310
  Result:=adltnNone;
 
311
end;
 
312
 
 
313
function NameToADLWindowState(s: string): TWindowState;
 
314
begin
 
315
  for Result:=low(TWindowState) to high(TWindowState) do
 
316
    if s=ADLWindowStateNames[Result] then exit;
 
317
  Result:=wsNormal;
 
318
end;
 
319
 
 
320
function NameToADLHeaderPosition(s: string): TADLHeaderPosition;
 
321
begin
 
322
  for Result:=low(TADLHeaderPosition) to high(TADLHeaderPosition) do
 
323
    if s=ADLHeaderPositionNames[Result] then exit;
 
324
  Result:=adlhpAuto;
 
325
end;
 
326
 
 
327
function NameToADLTabPosition(s: string): TTabPosition;
 
328
begin
 
329
  for Result:=low(TTabPosition) to high(TTabPosition) do
 
330
    if s=ADLTabPostionNames[Result] then exit;
 
331
  Result:=tpTop;
 
332
end;
 
333
 
 
334
function NameToADLAlign(s: string): TAlign;
 
335
begin
 
336
  for Result:=low(TAlign) to high(TAlign) do
 
337
    if s=ADLAlignNames[Result] then exit;
 
338
  Result:=alNone;
 
339
end;
 
340
 
 
341
function dbgs(const NodeType: TADLTreeNodeType): string; overload;
 
342
begin
 
343
  Result:=ADLTreeNodeTypeNames[NodeType];
 
344
end;
 
345
 
 
346
procedure WriteDebugLayout(Title: string; RootNode: TObject);
 
347
begin
 
348
  debugln(['WriteDebugLayout ',Title,':']);
 
349
  debugln(DebugLayoutAsString(RootNode));
 
350
end;
 
351
 
 
352
function DebugLayoutAsString(RootNode: TObject): string;
 
353
type
 
354
  TNodeInfo = record
 
355
    MinSize: TPoint;
 
356
    MinSizeValid, MinSizeCalculating: boolean;
 
357
    MinLeft: integer;
 
358
    MinLeftValid, MinLeftCalculating: boolean;
 
359
    MinTop: Integer;
 
360
    MinTopValid, MinTopCalculating: boolean;
 
361
  end;
 
362
  PNodeInfo = ^TNodeInfo;
 
363
var
 
364
  Cols: LongInt;
 
365
  Rows: LongInt;
 
366
  LogCols: Integer;
 
367
  NodeInfos: TPointerToPointerTree;// TObject to PNodeInfo
 
368
 
 
369
  procedure InitNodeInfos;
 
370
  begin
 
371
    NodeInfos:=TPointerToPointerTree.Create;
 
372
  end;
 
373
 
 
374
  procedure FreeNodeInfos;
 
375
  var
 
376
    Item: PNodeInfo;
 
377
    NodePtr, InfoPtr: Pointer;
 
378
  begin
 
379
    NodeInfos.GetFirst(NodePtr,InfoPtr);
 
380
    repeat
 
381
      Item:=PNodeInfo(InfoPtr);
 
382
      if Item=nil then break;
 
383
      Dispose(Item);
 
384
    until not NodeInfos.GetNext(NodePtr,NodePtr,InfoPtr);
 
385
    NodeInfos.Free;
 
386
  end;
 
387
 
 
388
  function GetNodeInfo(Node: TObject): PNodeInfo;
 
389
  begin
 
390
    Result:=PNodeInfo(NodeInfos[Node]);
 
391
    if Result=nil then begin
 
392
      New(Result);
 
393
      FillChar(Result^,SizeOf(TNodeInfo),0);
 
394
      NodeInfos[Node]:=Result;
 
395
    end;
 
396
  end;
 
397
 
 
398
  procedure w(x,y: Integer; const s: string; MaxX: Integer = 0);
 
399
  var
 
400
    i: Integer;
 
401
  begin
 
402
    for i:=1 to length(s) do begin
 
403
      if (MaxX>0) and (x+i>MaxX) then exit;
 
404
      Result[LogCols*(y-1) + x + i-1]:=s[i];
 
405
    end;
 
406
  end;
 
407
 
 
408
  procedure wfillrect(const ARect: TRect; c: char);
 
409
  var
 
410
    x: LongInt;
 
411
    y: LongInt;
 
412
  begin
 
413
    for x:=ARect.Left to ARect.Right do
 
414
      for y:=ARect.Top to ARect.Bottom do
 
415
        w(x,y,c);
 
416
  end;
 
417
 
 
418
  procedure wrectangle(const ARect: TRect);
 
419
  begin
 
420
    w(ARect.Left,ARect.Top,'+');
 
421
    w(ARect.Right,ARect.Top,'+');
 
422
    w(ARect.Left,ARect.Bottom,'+');
 
423
    w(ARect.Right,ARect.Bottom,'+');
 
424
    if ARect.Left<ARect.Right then begin
 
425
      if ARect.Top<ARect.Bottom then begin
 
426
        wfillrect(Rect(ARect.Left+1,ARect.Top,ARect.Right-1,ARect.Top),'-');// top line
 
427
        wfillrect(Rect(ARect.Left+1,ARect.Bottom,ARect.Right-1,ARect.Bottom),'-');// bottom line
 
428
        wfillrect(Rect(ARect.Left,ARect.Top+1,ARect.Left,ARect.Bottom-1),'|');// left line
 
429
        wfillrect(Rect(ARect.Right,ARect.Top+1,ARect.Right,ARect.Bottom-1),'|');// right line
 
430
      end else begin
 
431
        wfillrect(Rect(ARect.Left+1,ARect.Top,ARect.Right-1,ARect.Top),'=');// horizontal line
 
432
      end;
 
433
    end else begin
 
434
      wfillrect(Rect(ARect.Left,ARect.Top+1,ARect.Left,ARect.Bottom-1),'#');// vertical line
 
435
    end;
 
436
  end;
 
437
 
 
438
  function MapRect(const OriginalRect, OldBounds, NewBounds: TRect): TRect;
 
439
 
 
440
    function MapX(i: Integer): Integer;
 
441
    begin
 
442
      Result:=NewBounds.Left+
 
443
        (((i-OldBounds.Left)*(NewBounds.Right-NewBounds.Left))
 
444
         div (OldBounds.Right-OldBounds.Left));
 
445
    end;
 
446
 
 
447
    function MapY(i: Integer): Integer;
 
448
    begin
 
449
      Result:=NewBounds.Top+
 
450
        (((i-OldBounds.Top)*(NewBounds.Bottom-NewBounds.Top))
 
451
         div (OldBounds.Bottom-OldBounds.Top));
 
452
    end;
 
453
 
 
454
  begin
 
455
    Result.Left:=MapX(OriginalRect.Left);
 
456
    Result.Top:=MapY(OriginalRect.Left);
 
457
    Result.Right:=MapX(OriginalRect.Left);
 
458
    Result.Bottom:=MapY(OriginalRect.Left);
 
459
  end;
 
460
 
 
461
  function GetParentNode(Node: TObject): TObject;
 
462
  begin
 
463
    if Node is TControl then
 
464
      Result:=TControl(Node).Parent
 
465
    else if Node is TAnchorDockLayoutTreeNode then
 
466
      Result:=TAnchorDockLayoutTreeNode(Node).Parent
 
467
    else
 
468
      Result:=nil;
 
469
  end;
 
470
 
 
471
  function GetSiblingNode(Node: TObject; Side: TAnchorKind): TObject;
 
472
  begin
 
473
    Result:=nil;
 
474
    if Node=nil then exit;
 
475
    if Node is TControl then begin
 
476
      if not (Side in TControl(Node).Anchors) then exit;
 
477
      Result:=TControl(Node).AnchorSide[Side].Control;
 
478
      if Result=TControl(Node).Parent then
 
479
        Result:=nil;
 
480
    end else if Node is TAnchorDockLayoutTreeNode then begin
 
481
      if TAnchorDockLayoutTreeNode(Node).Parent<>nil then
 
482
        Result:=TAnchorDockLayoutTreeNode(Node).Parent.FindChildNode(
 
483
          TAnchorDockLayoutTreeNode(Node).Anchors[Side],false);
 
484
    end;
 
485
  end;
 
486
 
 
487
  function GetAnchorNode(Node: TObject; Side: TAnchorKind): TObject;
 
488
  var
 
489
    ADLNode: TAnchorDockLayoutTreeNode;
 
490
  begin
 
491
    Result:=nil;
 
492
    if Node=nil then exit;
 
493
    if Node is TControl then begin
 
494
      if not (Side in TControl(Node).Anchors) then exit;
 
495
      Result:=TControl(Node).AnchorSide[Side].Control;
 
496
    end else if Node is TAnchorDockLayoutTreeNode then begin
 
497
      ADLNode:=TAnchorDockLayoutTreeNode(Node);
 
498
      if ((ADLNode.NodeType=adltnSplitterVertical)
 
499
          and (Side in [akLeft,akRight]))
 
500
      or ((ADLNode.NodeType=adltnSplitterHorizontal)
 
501
          and (Side in [akTop,akBottom]))
 
502
      then
 
503
        Result:=nil
 
504
      else if (ADLNode.Anchors[Side]<>'') then begin
 
505
        if ADLNode.Parent<>nil then
 
506
          Result:=ADLNode.Parent.FindChildNode(
 
507
            ADLNode.Anchors[Side],false);
 
508
      end else
 
509
        Result:=GetParentNode(Node);
 
510
    end;
 
511
  end;
 
512
 
 
513
  function IsSplitter(Node: TObject): boolean;
 
514
  begin
 
515
    Result:=(Node is TCustomSplitter)
 
516
      or ((Node is TAnchorDockLayoutTreeNode)
 
517
          and (TAnchorDockLayoutTreeNode(Node).IsSplitter));
 
518
  end;
 
519
 
 
520
  function IsPages(Node: TObject): boolean;
 
521
  begin
 
522
    Result:=(Node is TCustomTabControl)
 
523
      or ((Node is TAnchorDockLayoutTreeNode)
 
524
          and (TAnchorDockLayoutTreeNode(Node).NodeType in [adltnPages,adltnNone]));
 
525
  end;
 
526
 
 
527
  function GetName(Node: TObject): string;
 
528
  begin
 
529
    if Node is TControl then
 
530
      Result:=TControl(Node).Name
 
531
    else if Node is TAnchorDockLayoutTreeNode then
 
532
      Result:=TAnchorDockLayoutTreeNode(Node).Name
 
533
    else
 
534
      Result:=DbgSName(Node);
 
535
  end;
 
536
 
 
537
  function GetChildCount(Node: TObject): integer;
 
538
  begin
 
539
    if Node is TWinControl then
 
540
      Result:=TWinControl(Node).ControlCount
 
541
    else if Node is TAnchorDockLayoutTreeNode then
 
542
      Result:=TAnchorDockLayoutTreeNode(Node).Count
 
543
    else
 
544
      Result:=0;
 
545
  end;
 
546
 
 
547
  function GetChild(Node: TObject; Index: integer): TObject;
 
548
  begin
 
549
    if Node is TWinControl then
 
550
      Result:=TWinControl(Node).Controls[Index]
 
551
    else if Node is TAnchorDockLayoutTreeNode then
 
552
      Result:=TAnchorDockLayoutTreeNode(Node).Nodes[Index]
 
553
    else
 
554
      Result:=nil;
 
555
  end;
 
556
 
 
557
  function GetMinSize(Node: TObject): TPoint; forward;
 
558
 
 
559
  function GetMinPos(Node: TObject; Side: TAnchorKind): Integer;
 
560
  // calculates left or top position of Node
 
561
 
 
562
    function Compute(var MinPosValid, MinPosCalculating: boolean;
 
563
      var MinPos: Integer): Integer;
 
564
 
 
565
      procedure Improve(Neighbour: TObject);
 
566
      var
 
567
        NeighbourPos: LongInt;
 
568
        NeighbourSize: TPoint;
 
569
        NeighbourLength: LongInt;
 
570
      begin
 
571
        if Neighbour=nil then exit;
 
572
        if GetParentNode(Neighbour)<>GetParentNode(Node) then exit;
 
573
        NeighbourPos:=GetMinPos(Neighbour,Side);
 
574
        NeighbourSize:=GetMinSize(Neighbour);
 
575
        if Side=akLeft then
 
576
          NeighbourLength:=NeighbourSize.X
 
577
        else
 
578
          NeighbourLength:=NeighbourSize.Y;
 
579
        MinPos:=Max(MinPos,NeighbourPos+NeighbourLength);
 
580
      end;
 
581
 
 
582
    var
 
583
      Sibling: TObject;
 
584
      i: Integer;
 
585
      ParentNode: TObject;
 
586
    begin
 
587
      if MinPosCalculating then begin
 
588
        DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected RootNode=',DbgSName(RootNode)]);
 
589
        if RootNode is TWinControl then
 
590
          DebugWriteChildAnchors(TWinControl(RootNode),true,true)
 
591
        else if RootNode is TAnchorDockLayoutTreeNode then
 
592
          DebugWriteChildAnchors(TAnchorDockLayoutTreeNode(RootNode));
 
593
        RaiseGDBException('circle detected');
 
594
      end;
 
595
      if (not MinPosValid) then begin
 
596
        MinPosValid:=true;
 
597
        MinPosCalculating:=true;
 
598
        Sibling:=GetSiblingNode(Node,Side);
 
599
        if Sibling<>nil then
 
600
          Improve(Sibling);
 
601
        ParentNode:=GetParentNode(Node);
 
602
        if ParentNode<>nil then begin
 
603
          for i:=0 to GetChildCount(ParentNode)-1 do begin
 
604
            Sibling:=GetChild(ParentNode,i);
 
605
            if Node=GetSiblingNode(Sibling,OppositeAnchor[Side]) then
 
606
              Improve(Sibling);
 
607
          end;
 
608
        end;
 
609
        MinPosCalculating:=false;
 
610
      end;
 
611
      Result:=MinPos;
 
612
    end;
 
613
 
 
614
  var
 
615
    Info: PNodeInfo;
 
616
  begin
 
617
    Info:=GetNodeInfo(Node);
 
618
    //DebugLn(['GetMinPos ',Node.Name,' ',DbgS(Side),' ',Info^.MinLeftCalculating]);
 
619
    if Side=akLeft then
 
620
      Result:=Compute(Info^.MinLeftValid,Info^.MinLeftCalculating,Info^.MinLeft)
 
621
    else
 
622
      Result:=Compute(Info^.MinTopValid,Info^.MinTopCalculating,Info^.MinTop);
 
623
  end;
 
624
 
 
625
  function GetChildsMinSize(Node: TObject): TPoint;
 
626
  // calculate the minimum size needed to draw the content of the node
 
627
  var
 
628
    i: Integer;
 
629
    Child: TObject;
 
630
    ChildMinSize: TPoint;
 
631
  begin
 
632
    //DebugLn(['GetChildsMinSize ',Node.name]);
 
633
    Result:=Point(0,0);
 
634
    if IsPages(Node) then begin
 
635
      // maximum size of all pages
 
636
      for i:=0 to GetChildCount(Node)-1 do begin
 
637
        ChildMinSize:=GetMinSize(GetChild(Node,i));
 
638
        Result.X:=Max(Result.X,ChildMinSize.X);
 
639
        Result.Y:=Max(Result.Y,ChildMinSize.Y);
 
640
      end;
 
641
    end else begin
 
642
      for i:=0 to GetChildCount(Node)-1 do begin
 
643
        Child:=GetChild(Node,i);
 
644
        ChildMinSize:=GetMinSize(Child);
 
645
        Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildMinSize.X);
 
646
        Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildMinSize.Y);
 
647
      end;
 
648
    end;
 
649
  end;
 
650
 
 
651
  function GetMinSize(Node: TObject): TPoint;
 
652
  // calculate the minimum size needed to draw the node
 
653
  var
 
654
    ChildMinSize: TPoint;
 
655
    Info: PNodeInfo;
 
656
  begin
 
657
    //DebugLn(['GetMinSize ',Node.name]);
 
658
    Info:=GetNodeInfo(Node);
 
659
    if Info^.MinSizeValid then begin
 
660
      Result:=Info^.MinSize;
 
661
      exit;
 
662
    end;
 
663
    if Info^.MinSizeCalculating then begin
 
664
      DebugLn(['DebugLayoutAsString.GetMinSize WARNING: anchor circle detected']);
 
665
      DumpStack;
 
666
      Result:=Point(1,1);
 
667
      exit;
 
668
    end;
 
669
    Info^.MinSizeCalculating:=true;
 
670
    Result.X:=2+length(GetName(Node));// border plus name
 
671
    Result.Y:=2;  // border
 
672
    if GetChildCount(Node)=0 then begin
 
673
      if IsSplitter(Node) then
 
674
        Result:=Point(1,1); // splitters don't need captions
 
675
    end else begin
 
676
      ChildMinSize:=GetChildsMinSize(Node);
 
677
      Result.X:=Max(Result.X,ChildMinSize.X+2);
 
678
      Result.Y:=Max(Result.Y,ChildMinSize.Y+2);
 
679
    end;
 
680
    //debugln(['GetMinSize ',GetName(Node),' Splitter=',IsSplitter(Node),' MinSize=',dbgs(Result)]);
 
681
    Info^.MinSize:=Result;
 
682
    Info^.MinSizeValid:=true;
 
683
    Info^.MinSizeCalculating:=false;
 
684
  end;
 
685
 
 
686
  procedure DrawNode(Node: TObject; ARect: TRect);
 
687
  var
 
688
    i: Integer;
 
689
    Child: TObject;
 
690
    ChildSize: TPoint;
 
691
    ChildRect: TRect;
 
692
    AnchorNode: TObject;
 
693
  begin
 
694
    DebugLn(['DrawNode Node=',GetName(Node),' ARect=',dbgs(ARect)]);
 
695
    wrectangle(ARect);
 
696
    w(ARect.Left+1,ARect.Top,GetName(Node),ARect.Right);
 
697
 
 
698
    for i := 0 to GetChildCount(Node)-1 do begin
 
699
      Child:=GetChild(Node,i);
 
700
      ChildRect.Left:=ARect.Left+1+GetMinPos(Child,akLeft);
 
701
      ChildRect.Top:=ARect.Top+1+GetMinPos(Child,akTop);
 
702
      ChildSize:=GetMinSize(Child);
 
703
      ChildRect.Right:=ChildRect.Left+ChildSize.X-1;
 
704
      ChildRect.Bottom:=ChildRect.Top+ChildSize.Y-1;
 
705
      AnchorNode:=GetAnchorNode(Child,akRight);
 
706
      if AnchorNode<>nil then begin
 
707
        if AnchorNode=Node then
 
708
          ChildRect.Right:=ARect.Right-1
 
709
        else if GetParentNode(AnchorNode)=Node then
 
710
          ChildRect.Right:=ARect.Left+1+GetMinPos(AnchorNode,akLeft)-1;
 
711
      end;
 
712
      AnchorNode:=GetAnchorNode(Child,akBottom);
 
713
      if AnchorNode<>nil then begin
 
714
        if AnchorNode=Node then
 
715
          ChildRect.Bottom:=ARect.Bottom-1
 
716
        else if GetParentNode(AnchorNode)=Node then
 
717
          ChildRect.Bottom:=ARect.Top+1+GetMinPos(AnchorNode,akTop)-1;
 
718
      end;
 
719
      DrawNode(Child,ChildRect);
 
720
      if IsPages(Node) then begin
 
721
        // paint only one page
 
722
        break;
 
723
      end;
 
724
    end;
 
725
  end;
 
726
 
 
727
var
 
728
  e: string;
 
729
  y: Integer;
 
730
begin
 
731
  Cols:=StrToIntDef(Application.GetOptionValue('ldcn-colunms'),79);
 
732
  Rows:=StrToIntDef(Application.GetOptionValue('ldcn-rows'),20);
 
733
 
 
734
  InitNodeInfos;
 
735
  try
 
736
    e:=LineEnding;
 
737
    LogCols:=Cols+length(e);
 
738
    SetLength(Result,LogCols*Rows);
 
739
    // fill space
 
740
    FillChar(Result[1],length(Result),' ');
 
741
    // add line endings
 
742
    for y:=1 to Rows do
 
743
      w(Cols+1,y,e);
 
744
    // draw node
 
745
    DrawNode(RootNode,Rect(1,1,Cols,Rows));
 
746
  finally
 
747
    FreeNodeInfos;
 
748
  end;
 
749
end;
 
750
 
 
751
procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode);
 
752
 
 
753
  procedure WriteControl(Node: TAnchorDockLayoutTreeNode; Prefix: string);
 
754
  var
 
755
    i: Integer;
 
756
    a: TAnchorKind;
 
757
    AnchorControl: TAnchorDockLayoutTreeNode;
 
758
    AnchorName: String;
 
759
  begin
 
760
    DbgOut(Prefix);
 
761
    DbgOut('"'+Node.Name+'"');
 
762
    DbgOut(' Type='+dbgs(Node.NodeType));
 
763
    DbgOut(' Bounds=',dbgs(Node.BoundsRect)
 
764
              ,',w=',dbgs(Node.BoundsRect.Right-Node.BoundsRect.Left)
 
765
              ,',h=',dbgs(Node.BoundsRect.Bottom-Node.BoundsRect.Top));
 
766
    if Node.WindowState<>wsNormal then
 
767
      DbgOut(' WindowState=',dbgs(Node.WindowState));
 
768
    if Node.Monitor<>0 then
 
769
      DbgOut(' Monitor=',dbgs(Node.Monitor));
 
770
    if Node.BoundSplitterPos<>0 then
 
771
      DbgOut(' SplitterPos=',dbgs(Node.BoundSplitterPos));
 
772
    if (Node.WorkAreaRect.Right>0) and (Node.WorkAreaRect.Bottom>0) then
 
773
      DbgOut(' WorkArea=',dbgs(Node.WorkAreaRect));
 
774
    debugln;
 
775
    for a:=low(TAnchorKind) to high(TAnchorKind) do begin
 
776
      if Node.Anchors[a]<>'' then
 
777
        AnchorControl:=Node.Parent.FindChildNode(Node.Anchors[a],False)
 
778
      else
 
779
        AnchorControl:=nil;
 
780
      if AnchorControl=nil then
 
781
        AnchorName:='Parent'
 
782
      else
 
783
        AnchorName:=AnchorControl.Name;
 
784
      debugln([Prefix,'  ',dbgs(a),'=',AnchorName]);
 
785
    end;
 
786
    for i:=0 to Node.Count-1 do
 
787
      WriteControl(Node[i],Prefix+'  ');
 
788
  end;
 
789
 
 
790
var
 
791
  i: Integer;
 
792
begin
 
793
  debugln(['DebugWriteChildAnchors RootNode="',RootNode.Name,'" Type=',dbgs(RootNode.NodeType)]);
 
794
  for i:=0 to RootNode.Count-1 do
 
795
    WriteControl(RootNode[i],'  ');
 
796
end;
 
797
 
 
798
procedure DebugWriteChildAnchors(RootControl: TWinControl;
 
799
  OnlyWinControls, OnlyForms: boolean); overload;
 
800
 
 
801
  procedure WriteControl(AControl: TControl; Prefix: string);
 
802
  var
 
803
    i: Integer;
 
804
    a: TAnchorKind;
 
805
    AnchorControl: TControl;
 
806
    AnchorName: String;
 
807
  begin
 
808
    if OnlyWinControls and (not (AControl is TWinControl)) then exit;
 
809
    if OnlyForms and (not (AControl is TCustomForm)) then exit;
 
810
    if not AControl.IsControlVisible then exit;
 
811
 
 
812
    debugln([Prefix,DbgSName(AControl),' Caption="',dbgstr(AControl.Caption),'" Align=',dbgs(AControl.Align),' Bounds=',dbgs(AControl.BoundsRect)]);
 
813
    for a:=low(TAnchorKind) to high(TAnchorKind) do begin
 
814
      AnchorControl:=AControl.AnchorSide[a].Control;
 
815
      if AnchorControl=AControl.Parent then
 
816
        AnchorName:='Parent'
 
817
      else if AnchorControl is TCustomForm then
 
818
        AnchorName:='"'+AnchorControl.Name+'"'
 
819
      else
 
820
        AnchorName:=DbgSName(AnchorControl);
 
821
      debugln([Prefix,'  ',dbgs(a),'=',a in AControl.Anchors,' ',AnchorName,' ',dbgs(a,AControl.AnchorSide[a].Side)]);
 
822
    end;
 
823
    if AControl is TWinControl then begin
 
824
      for i:=0 to TWinControl(AControl).ControlCount-1 do
 
825
        WriteControl(TWinControl(AControl).Controls[i],Prefix+'  ');
 
826
    end;
 
827
  end;
 
828
 
 
829
var
 
830
  i: Integer;
 
831
begin
 
832
  debugln(['WriteChildAnchors ',DbgSName(RootControl),' Caption="',RootControl.Caption,'" Align=',dbgs(RootControl.Align)]);
 
833
  for i:=0 to RootControl.ControlCount-1 do
 
834
    WriteControl(RootControl.Controls[i],'  ');
 
835
end;
 
836
 
 
837
{ TAnchorDockLayoutTreeNode }
 
838
 
 
839
function TAnchorDockLayoutTreeNode.GetNodes(Index: integer
 
840
  ): TAnchorDockLayoutTreeNode;
 
841
begin
 
842
  Result:=TAnchorDockLayoutTreeNode(FNodes[Index]);
 
843
end;
 
844
 
 
845
function TAnchorDockLayoutTreeNode.GetRight: integer;
 
846
begin
 
847
  Result:=FBoundsRect.Right;
 
848
end;
 
849
 
 
850
function TAnchorDockLayoutTreeNode.GetHeight: integer;
 
851
begin
 
852
  Result:=FBoundsRect.Bottom-FBoundsRect.Top;
 
853
end;
 
854
 
 
855
function TAnchorDockLayoutTreeNode.GetBottom: integer;
 
856
begin
 
857
  Result:=FBoundsRect.Bottom;
 
858
end;
 
859
 
 
860
function TAnchorDockLayoutTreeNode.GetAnchors(Site: TAnchorKind): string;
 
861
begin
 
862
  Result:=fAnchors[Site];
 
863
end;
 
864
 
 
865
function TAnchorDockLayoutTreeNode.GetLeft: integer;
 
866
begin
 
867
  Result:=FBoundsRect.Left;
 
868
end;
 
869
 
 
870
function TAnchorDockLayoutTreeNode.GetTop: integer;
 
871
begin
 
872
  Result:=FBoundsRect.Top;
 
873
end;
 
874
 
 
875
function TAnchorDockLayoutTreeNode.GetWidth: integer;
 
876
begin
 
877
  Result:=FBoundsRect.Right-FBoundsRect.Left;
 
878
end;
 
879
 
 
880
procedure TAnchorDockLayoutTreeNode.SetAlign(const AValue: TAlign);
 
881
begin
 
882
  if FAlign=AValue then exit;
 
883
  FAlign:=AValue;
 
884
  IncreaseChangeStamp;
 
885
end;
 
886
 
 
887
procedure TAnchorDockLayoutTreeNode.SetAnchors(Site: TAnchorKind;
 
888
  const AValue: string);
 
889
begin
 
890
  if Anchors[Site]=AValue then exit;
 
891
  fAnchors[Site]:=AValue;
 
892
  IncreaseChangeStamp;
 
893
end;
 
894
 
 
895
procedure TAnchorDockLayoutTreeNode.SetBottom(const AValue: integer);
 
896
begin
 
897
  if GetBottom=AValue then exit;
 
898
  FBoundsRect.Bottom:=AValue;
 
899
  IncreaseChangeStamp;
 
900
end;
 
901
 
 
902
procedure TAnchorDockLayoutTreeNode.SetBoundSplitterPos(const AValue: integer);
 
903
begin
 
904
  if FBoundSplitterPos=AValue then exit;
 
905
  FBoundSplitterPos:=AValue;
 
906
  IncreaseChangeStamp;
 
907
end;
 
908
 
 
909
procedure TAnchorDockLayoutTreeNode.SetBoundsRect(const AValue: TRect);
 
910
begin
 
911
  if CompareRect(@FBoundsRect,@AValue) then exit;
 
912
  FBoundsRect:=AValue;
 
913
  IncreaseChangeStamp;
 
914
end;
 
915
 
 
916
procedure TAnchorDockLayoutTreeNode.SetHeaderPosition(
 
917
  const AValue: TADLHeaderPosition);
 
918
begin
 
919
  if FHeaderPosition=AValue then exit;
 
920
  FHeaderPosition:=AValue;
 
921
  IncreaseChangeStamp;
 
922
end;
 
923
 
 
924
procedure TAnchorDockLayoutTreeNode.SetHeight(const AValue: integer);
 
925
begin
 
926
  if Height=AValue then exit;
 
927
  FBoundsRect.Bottom:=FBoundsRect.Top+AValue;
 
928
  IncreaseChangeStamp;
 
929
end;
 
930
 
 
931
procedure TAnchorDockLayoutTreeNode.SetLeft(const AValue: integer);
 
932
begin
 
933
  if Left=AValue then exit;
 
934
  FBoundsRect.Left:=AValue;
 
935
  IncreaseChangeStamp;
 
936
end;
 
937
 
 
938
procedure TAnchorDockLayoutTreeNode.SetMonitor(const AValue: integer);
 
939
begin
 
940
  if FMonitor=AValue then exit;
 
941
  FMonitor:=AValue;
 
942
  IncreaseChangeStamp;
 
943
end;
 
944
 
 
945
procedure TAnchorDockLayoutTreeNode.SetName(const AValue: string);
 
946
begin
 
947
  if FName=AValue then exit;
 
948
  FName:=AValue;
 
949
  IncreaseChangeStamp;
 
950
end;
 
951
 
 
952
procedure TAnchorDockLayoutTreeNode.SetNodeType(const AValue: TADLTreeNodeType);
 
953
begin
 
954
  if FNodeType=AValue then exit;
 
955
  FNodeType:=AValue;
 
956
  IncreaseChangeStamp;
 
957
end;
 
958
 
 
959
procedure TAnchorDockLayoutTreeNode.SetParent(
 
960
  const AValue: TAnchorDockLayoutTreeNode);
 
961
begin
 
962
  if FParent=AValue then exit;
 
963
  if FParent<>nil then begin
 
964
    FParent.FNodes.Remove(Self);
 
965
    FParent.IncreaseChangeStamp;
 
966
  end;
 
967
  FParent:=AValue;
 
968
  if FParent<>nil then
 
969
    FParent.FNodes.Add(Self);
 
970
  IncreaseChangeStamp;
 
971
end;
 
972
 
 
973
procedure TAnchorDockLayoutTreeNode.SetRight(const AValue: integer);
 
974
begin
 
975
  if Right=AValue then exit;
 
976
  FBoundsRect.Right:=AValue;
 
977
  IncreaseChangeStamp;
 
978
end;
 
979
 
 
980
procedure TAnchorDockLayoutTreeNode.SetWorkAreaRect(const AValue: TRect);
 
981
begin
 
982
  if CompareRect(@FWorkAreaRect,@AValue) then exit;
 
983
  FWorkAreaRect:=AValue;
 
984
  IncreaseChangeStamp;
 
985
end;
 
986
 
 
987
procedure TAnchorDockLayoutTreeNode.SetTabPosition(const AValue: TTabPosition);
 
988
begin
 
989
  if FTabPosition=AValue then exit;
 
990
  FTabPosition:=AValue;
 
991
  IncreaseChangeStamp;
 
992
end;
 
993
 
 
994
procedure TAnchorDockLayoutTreeNode.SetTop(const AValue: integer);
 
995
begin
 
996
  if Top=AValue then exit;
 
997
  FBoundsRect.Top:=AValue;
 
998
  IncreaseChangeStamp;
 
999
end;
 
1000
 
 
1001
procedure TAnchorDockLayoutTreeNode.SetWidth(const AValue: integer);
 
1002
begin
 
1003
  if Width=AValue then exit;
 
1004
  FBoundsRect.Right:=FBoundsRect.Left+AValue;
 
1005
  IncreaseChangeStamp;
 
1006
end;
 
1007
 
 
1008
procedure TAnchorDockLayoutTreeNode.SetWindowState(const AValue: TWindowState);
 
1009
begin
 
1010
  if FWindowState=AValue then exit;
 
1011
  FWindowState:=AValue;
 
1012
  IncreaseChangeStamp;
 
1013
end;
 
1014
 
 
1015
constructor TAnchorDockLayoutTreeNode.Create;
 
1016
begin
 
1017
  FNodes:=TFPList.Create;
 
1018
end;
 
1019
 
 
1020
destructor TAnchorDockLayoutTreeNode.Destroy;
 
1021
begin
 
1022
  Parent:=nil;
 
1023
  Clear;
 
1024
  FreeAndNil(FNodes);
 
1025
  inherited Destroy;
 
1026
end;
 
1027
 
 
1028
procedure TAnchorDockLayoutTreeNode.Clear;
 
1029
var
 
1030
  a: TAnchorKind;
 
1031
begin
 
1032
  Name:='';
 
1033
  FillByte(FBoundsRect,sizeOf(FBoundsRect),0);
 
1034
  while Count>0 do Nodes[Count-1].Free;
 
1035
  NodeType:=adltnNone;
 
1036
  WindowState:=wsNormal;
 
1037
  Monitor:=0;
 
1038
  Align:=alNone;
 
1039
  HeaderPosition:=adlhpAuto;
 
1040
  TabPosition:=tpTop;
 
1041
  BoundSplitterPos:=0;
 
1042
  WorkAreaRect:=Rect(0,0,0,0);
 
1043
  for a:=low(TAnchorKind) to high(TAnchorKind) do
 
1044
    Anchors[a]:='';
 
1045
end;
 
1046
 
 
1047
function TAnchorDockLayoutTreeNode.IsEqual(Node: TAnchorDockLayoutTreeNode
 
1048
  ): boolean;
 
1049
var
 
1050
  i: Integer;
 
1051
  a: TAnchorKind;
 
1052
begin
 
1053
  Result:=false;
 
1054
  if (not CompareRect(@FBoundsRect,@Node.FBoundsRect))
 
1055
  or (Count<>Node.Count)
 
1056
  or (NodeType<>Node.NodeType)
 
1057
  or (Name<>Node.Name)
 
1058
  or (Align<>Node.Align)
 
1059
  or (WindowState<>Node.WindowState)
 
1060
  or (HeaderPosition<>Node.HeaderPosition)
 
1061
  or (TabPosition<>Node.TabPosition)
 
1062
  or (BoundSplitterPos<>Node.BoundSplitterPos)
 
1063
  or (not CompareRect(@FWorkAreaRect,@Node.FWorkAreaRect))
 
1064
  then
 
1065
    exit;
 
1066
  for a:=low(TAnchorKind) to high(TAnchorKind) do
 
1067
    if Anchors[a]<>Node.Anchors[a] then exit;
 
1068
  for i:=0 to Count-1 do
 
1069
    if not Nodes[i].IsEqual(Node.Nodes[i]) then exit;
 
1070
  Result:=true;
 
1071
end;
 
1072
 
 
1073
procedure TAnchorDockLayoutTreeNode.Assign(Node: TAnchorDockLayoutTreeNode);
 
1074
var
 
1075
  i: Integer;
 
1076
  Child: TAnchorDockLayoutTreeNode;
 
1077
  a: TAnchorKind;
 
1078
begin
 
1079
  Name:=Node.Name;
 
1080
  NodeType:=Node.NodeType;
 
1081
  BoundsRect:=Node.BoundsRect;
 
1082
  Align:=Node.Align;
 
1083
  WindowState:=Node.WindowState;
 
1084
  HeaderPosition:=Node.HeaderPosition;
 
1085
  TabPosition:=Node.TabPosition;
 
1086
  BoundSplitterPos:=Node.BoundSplitterPos;
 
1087
  WorkAreaRect:=Node.WorkAreaRect;
 
1088
  for a:=low(TAnchorKind) to high(TAnchorKind) do
 
1089
    Anchors[a]:=Node.Anchors[a];
 
1090
  while Count>Node.Count do Nodes[Count-1].Free;
 
1091
  for i:=0 to Node.Count-1 do begin
 
1092
    if i=Count then begin
 
1093
      Child:=TAnchorDockLayoutTreeNode.Create;
 
1094
      Child.Parent:=Self;
 
1095
    end else begin
 
1096
      Child:=Nodes[i];
 
1097
    end;
 
1098
    Child.Assign(Node.Nodes[i]);
 
1099
  end;
 
1100
end;
 
1101
 
 
1102
procedure TAnchorDockLayoutTreeNode.Assign(AControl: TControl);
 
1103
var
 
1104
  AnchorControl: TControl;
 
1105
  a: TAnchorKind;
 
1106
begin
 
1107
  Name:=AControl.Name;
 
1108
  BoundsRect:=AControl.BoundsRect;
 
1109
  Align:=AControl.Align;
 
1110
  if (AControl.Parent=nil) and (AControl is TCustomForm) then begin
 
1111
    WindowState:=TCustomForm(AControl).WindowState;
 
1112
    Monitor:=TCustomForm(AControl).Monitor.MonitorNum;
 
1113
    WorkAreaRect:=TCustomForm(AControl).Monitor.WorkareaRect;
 
1114
  end else
 
1115
    WindowState:=wsNormal;
 
1116
  if AControl is TCustomTabControl then
 
1117
    TabPosition:=TCustomTabControl(AControl).TabPosition
 
1118
  else
 
1119
    TabPosition:=tpTop;
 
1120
  for a:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1121
    AnchorControl:=AControl.AnchorSide[a].Control;
 
1122
    if (AnchorControl=nil) or (AnchorControl=AControl.Parent) then
 
1123
      Anchors[a]:=''
 
1124
    else if AnchorControl.Parent=AControl.Parent then
 
1125
      Anchors[a]:=AnchorControl.Name;
 
1126
  end;
 
1127
end;
 
1128
 
 
1129
procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Config: TConfigStorage);
 
1130
var
 
1131
  i: Integer;
 
1132
  Child: TAnchorDockLayoutTreeNode;
 
1133
  NewCount: longint;
 
1134
begin
 
1135
  Clear;
 
1136
  Name:=Config.GetValue('Name','');
 
1137
  NodeType:=NameToADLTreeNodeType(Config.GetValue('Type',ADLTreeNodeTypeNames[adltnNone]));
 
1138
  Left:=Config.GetValue('Bounds/Left',0);
 
1139
  Top:=Config.GetValue('Bounds/Top',0);
 
1140
  Width:=Config.GetValue('Bounds/Width',0);
 
1141
  Height:=Config.GetValue('Bounds/Height',0);
 
1142
  BoundSplitterPos:=Config.GetValue('Bounds/SplitterPos',0);
 
1143
  Config.GetValue('Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0));
 
1144
  Anchors[akLeft]:=Config.GetValue('Anchors/Left','');
 
1145
  Anchors[akTop]:=Config.GetValue('Anchors/Top','');
 
1146
  Anchors[akRight]:=Config.GetValue('Anchors/Right','');
 
1147
  Anchors[akBottom]:=Config.GetValue('Anchors/Bottom','');
 
1148
  Align:=NameToADLAlign(Config.GetValue('Anchors/Align',dbgs(alNone)));
 
1149
  WindowState:=NameToADLWindowState(Config.GetValue('WindowState',ADLWindowStateNames[wsNormal]));
 
1150
  HeaderPosition:=NameToADLHeaderPosition(Config.GetValue('Header/Position',ADLHeaderPositionNames[adlhpAuto]));
 
1151
  TabPosition:=NameToADLTabPosition(Config.GetValue('Header/TabPosition',ADLTabPostionNames[tpTop]));
 
1152
  Monitor:=Config.GetValue('Monitor',0);
 
1153
  NewCount:=Config.GetValue('ChildCount',0);
 
1154
  for i:=1 to NewCount do begin
 
1155
    Config.AppendBasePath('Item'+IntToStr(i)+'/');
 
1156
    Child:=TAnchorDockLayoutTreeNode.Create;
 
1157
    Child.Parent:=Self;
 
1158
    Child.LoadFromConfig(Config);
 
1159
    Config.UndoAppendBasePath;
 
1160
  end;
 
1161
end;
 
1162
 
 
1163
procedure TAnchorDockLayoutTreeNode.SaveToConfig(Config: TConfigStorage);
 
1164
var
 
1165
  i: Integer;
 
1166
begin
 
1167
  Config.SetDeleteValue('Name',Name,'');
 
1168
  Config.SetDeleteValue('Type',ADLTreeNodeTypeNames[NodeType],
 
1169
                               ADLTreeNodeTypeNames[adltnNone]);
 
1170
  Config.SetDeleteValue('Bounds/Left',Left,0);
 
1171
  Config.SetDeleteValue('Bounds/Top',Top,0);
 
1172
  Config.SetDeleteValue('Bounds/Width',Width,0);
 
1173
  Config.SetDeleteValue('Bounds/Height',Height,0);
 
1174
  Config.SetDeleteValue('Bounds/SplitterPos',BoundSplitterPos,0);
 
1175
  Config.SetDeleteValue('Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0));
 
1176
  Config.SetDeleteValue('Anchors/Left',Anchors[akLeft],'');
 
1177
  Config.SetDeleteValue('Anchors/Top',Anchors[akTop],'');
 
1178
  Config.SetDeleteValue('Anchors/Right',Anchors[akRight],'');
 
1179
  Config.SetDeleteValue('Anchors/Bottom',Anchors[akBottom],'');
 
1180
  Config.SetDeleteValue('Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]);
 
1181
  Config.SetDeleteValue('WindowState',ADLWindowStateNames[WindowState],
 
1182
                                      ADLWindowStateNames[wsNormal]);
 
1183
  Config.SetDeleteValue('Header/Position',ADLHeaderPositionNames[HeaderPosition],
 
1184
                                          ADLHeaderPositionNames[adlhpAuto]);
 
1185
  Config.SetDeleteValue('Header/TabPosition',ADLTabPostionNames[TabPosition],
 
1186
                                             ADLTabPostionNames[tpTop]);
 
1187
  Config.SetDeleteValue('Monitor',Monitor,0);
 
1188
  Config.SetDeleteValue('ChildCount',Count,0);
 
1189
  for i:=1 to Count do begin
 
1190
    Config.AppendBasePath('Item'+IntToStr(i)+'/');
 
1191
    Nodes[i-1].SaveToConfig(Config);
 
1192
    Config.UndoAppendBasePath;
 
1193
  end;
 
1194
end;
 
1195
 
 
1196
function TAnchorDockLayoutTreeNode.FindChildNode(aName: string;
 
1197
  Recursive: boolean): TAnchorDockLayoutTreeNode;
 
1198
var
 
1199
  i: Integer;
 
1200
begin
 
1201
  for i:=0 to Count-1 do begin
 
1202
    Result:=Nodes[i];
 
1203
    if CompareText(aName,Result.Name)=0 then exit;
 
1204
    if Recursive then begin
 
1205
      Result:=Result.FindChildNode(aName,true);
 
1206
      if Result<>nil then exit;
 
1207
    end;
 
1208
  end;
 
1209
  Result:=nil;
 
1210
end;
 
1211
 
 
1212
function TAnchorDockLayoutTreeNode.FindControlNode: TAnchorDockLayoutTreeNode;
 
1213
var
 
1214
  i: Integer;
 
1215
begin
 
1216
  if NodeType=adltnControl then
 
1217
    Result:=Self
 
1218
  else
 
1219
    for i:=0 to Count-1 do begin
 
1220
      Result:=Nodes[i].FindControlNode;
 
1221
      if Result<>nil then exit;
 
1222
    end;
 
1223
end;
 
1224
 
 
1225
procedure TAnchorDockLayoutTreeNode.CheckConsistency;
 
1226
{ ToDo: check for topological sort }
 
1227
 
 
1228
  procedure CheckCornerIsUnique(Side1: TAnchorKind; Side1AnchorName: string;
 
1229
    Side2: TAnchorKind; Side2AnchorName: string);
 
1230
  var
 
1231
    i: Integer;
 
1232
    Child, Found: TAnchorDockLayoutTreeNode;
 
1233
  begin
 
1234
    Found:=nil;
 
1235
    for i:=0 to Count-1 do begin
 
1236
      Child:=Nodes[i];
 
1237
      if Child.IsSplitter then continue;
 
1238
      if CompareText(Child.Anchors[Side1],Side1AnchorName)<>0 then continue;
 
1239
      if CompareText(Child.Anchors[Side2],Side2AnchorName)<>0 then continue;
 
1240
      if Found<>nil then
 
1241
        raise EAnchorDockLayoutError.Create('overlapping controls found :'+Found.Name+','+Child.Name);
 
1242
      Found:=Child;
 
1243
    end;
 
1244
    if Found=nil then
 
1245
      raise EAnchorDockLayoutError.Create('empty space found :'+Name+' '+dbgs(Side1)+'='+Side1AnchorName+' '+dbgs(Side2)+'='+Side2AnchorName);
 
1246
  end;
 
1247
 
 
1248
var
 
1249
  i: Integer;
 
1250
  Child: TAnchorDockLayoutTreeNode;
 
1251
  Side: TAnchorKind;
 
1252
  Sibling: TAnchorDockLayoutTreeNode;
 
1253
begin
 
1254
  // check parent
 
1255
  if (NodeType=adltnNone) and (Parent<>nil) then
 
1256
    raise EAnchorDockLayoutError.Create('invalid parent, root node');
 
1257
  if (NodeType=adltnCustomSite) and (Parent.NodeType<>adltnNone) then
 
1258
    raise EAnchorDockLayoutError.Create('invalid parent, custom sites parent must be nil');
 
1259
  if (Parent<>nil) and IsSplitter and (Parent.NodeType<>adltnLayout) then
 
1260
    raise EAnchorDockLayoutError.Create('invalid parent, splitter needs parent layout');
 
1261
 
 
1262
  // check sides
 
1263
  for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1264
    if Anchors[Side]<>'' then begin
 
1265
      // anchor must be a sibling
 
1266
      Sibling:=nil;
 
1267
      if Parent<>nil then
 
1268
        Sibling:=Parent.FindChildNode(Anchors[Side],false);
 
1269
      if (Sibling=nil) then
 
1270
        raise EAnchorDockLayoutError.Create(
 
1271
          Format(adrsAnchorNotFoundNodeAnchors, ['"', Name, '"', dbgs(Side),
 
1272
            '"', Anchors[Side], '"']));
 
1273
      // only anchor to splitter
 
1274
      if not Sibling.IsSplitter then
 
1275
        raise EAnchorDockLayoutError.Create(
 
1276
          Format(adrsAnchorIsNotSplitterNodeAnchors, ['"', Name, '"', dbgs(Side
 
1277
            ), '"', Anchors[Side], '"']));
 
1278
      // the free sides of a splitter must not be anchored
 
1279
      if ((NodeType=adltnSplitterVertical) and (Side in [akLeft,akRight]))
 
1280
      or ((NodeType=adltnSplitterHorizontal) and (Side in [akTop,akBottom]))
 
1281
      then
 
1282
        raise EAnchorDockLayoutError.Create(
 
1283
          Format(adrsAFreeSideOfASplitterMustNotBeAnchoredNodeTypeAncho, ['"',
 
1284
            Name, '"', ADLTreeNodeTypeNames[NodeType], dbgs(Side), '"', Anchors[
 
1285
            Side], '"']));
 
1286
      // a page must not be anchored
 
1287
      if (Parent.NodeType=adltnPages) then
 
1288
        raise EAnchorDockLayoutError.Create(
 
1289
          Format(adrsAPageMustNotBeAnchoredNodeParentParentTypeAnchors, ['"',
 
1290
            Name, '"', Parent.Name, ADLTreeNodeTypeNames[Parent.NodeType], dbgs(
 
1291
            Side), '"', Anchors[Side], '"']));
 
1292
      // check if anchored to the wrong side of a splitter
 
1293
      if ((Sibling.NodeType=adltnSplitterHorizontal) and (Side in [akLeft,akRight]))
 
1294
      or ((Sibling.NodeType=adltnSplitterVertical) and (Side in [akTop,akBottom]))
 
1295
      then
 
1296
        raise EAnchorDockLayoutError.Create(
 
1297
          Format(adrsAnchorToWrongSideOfSplitterNodeAnchors, ['"', Name, '"',
 
1298
            dbgs(Side), '"', Anchors[Side], '"']));
 
1299
    end;
 
1300
  end;
 
1301
 
 
1302
  // only the root node, pages, layouts and customsite can have children
 
1303
  if (Parent<>nil) and (Count>0)
 
1304
  and (not (NodeType in [adltnLayout,adltnPages,adltnCustomSite]))
 
1305
  then
 
1306
    raise EAnchorDockLayoutError.Create(
 
1307
      Format(adrsNoChildrenAllowedForNodeType, ['"', Name, '"',
 
1308
        ADLTreeNodeTypeNames[NodeType]]));
 
1309
  if (NodeType=adltnCustomSite) then begin
 
1310
    if (Count>1) then
 
1311
      raise EAnchorDockLayoutError.Create(Format(
 
1312
        adrsCustomDockSiteCanHaveOnlyOneSite, ['"', Name, '"']));
 
1313
  end;
 
1314
 
 
1315
  // check if in each corner sits exactly one child
 
1316
  if NodeType=adltnLayout then
 
1317
    for Side:=low(TAnchorKind) to high(TAnchorKind) do
 
1318
      CheckCornerIsUnique(Side,'',ClockwiseAnchor[Side],'');
 
1319
 
 
1320
  // check grandchild
 
1321
  for i:=0 to Count-1 do begin
 
1322
    Child:=Nodes[i];
 
1323
    Child.CheckConsistency;
 
1324
 
 
1325
    if (Child.NodeType=adltnSplitterHorizontal) then begin
 
1326
      // check if splitter corners have exactly one sibling
 
1327
      CheckCornerIsUnique(akLeft,Child.Anchors[akLeft],akTop,Child.Name);
 
1328
      CheckCornerIsUnique(akLeft,Child.Anchors[akLeft],akBottom,Child.Name);
 
1329
      CheckCornerIsUnique(akRight,Child.Anchors[akRight],akTop,Child.Name);
 
1330
      CheckCornerIsUnique(akRight,Child.Anchors[akRight],akBottom,Child.Name);
 
1331
    end;
 
1332
    if (Child.NodeType=adltnSplitterVertical) then begin
 
1333
      // check if splitter corners have exactly one sibling
 
1334
      CheckCornerIsUnique(akTop,Child.Anchors[akTop],akLeft,Child.Name);
 
1335
      CheckCornerIsUnique(akTop,Child.Anchors[akTop],akRight,Child.Name);
 
1336
      CheckCornerIsUnique(akBottom,Child.Anchors[akBottom],akLeft,Child.Name);
 
1337
      CheckCornerIsUnique(akBottom,Child.Anchors[akBottom],akRight,Child.Name);
 
1338
    end;
 
1339
  end;
 
1340
end;
 
1341
 
 
1342
procedure TAnchorDockLayoutTreeNode.Simplify(ExistingNames: TStrings);
 
1343
{ Simplification rules:
 
1344
   1. Control nodes without existing name are deleted.
 
1345
   2. Empty layouts and pages are deleted
 
1346
   3. pages and layouts with only one child are removed and its content moved up
 
1347
}
 
1348
var
 
1349
  i: Integer;
 
1350
  ChildNode: TAnchorDockLayoutTreeNode;
 
1351
begin
 
1352
  // simplify children
 
1353
  i:=Count-1;
 
1354
  while i>=0 do begin
 
1355
    ChildNode:=Nodes[i];
 
1356
    ChildNode.Simplify(ExistingNames);
 
1357
 
 
1358
    if (ChildNode.NodeType=adltnControl) then begin
 
1359
      // leaf node => check if there is a control
 
1360
      if (ChildNode.Name='') or (ExistingNames.IndexOf(ChildNode.Name)<0) then
 
1361
        DeleteNode(ChildNode);
 
1362
    end else if ChildNode.IsSplitter then begin
 
1363
      // splitter
 
1364
      // delete all children
 
1365
      while ChildNode.Count>0 do
 
1366
        ChildNode[0].Free;
 
1367
    end else if ChildNode.NodeType=adltnCustomSite then begin
 
1368
      // custom dock site
 
1369
    end else if ChildNode.Count=0 then begin
 
1370
      // inner node without child => delete
 
1371
      DeleteNode(ChildNode);
 
1372
    end else if (ChildNode.Count=1)
 
1373
    and (ChildNode.NodeType in [adltnLayout,adltnPages]) then begin
 
1374
      // layouts and pages with only one child
 
1375
      // => move grandchildren up and delete childnode
 
1376
      ReplaceWithChildren(ChildNode);
 
1377
    end;
 
1378
 
 
1379
    i:=Min(i,Count)-1;
 
1380
  end;
 
1381
end;
 
1382
 
 
1383
procedure TAnchorDockLayoutTreeNode.DeleteNode(
 
1384
  ChildNode: TAnchorDockLayoutTreeNode);
 
1385
var
 
1386
  i: Integer;
 
1387
  Sibling: TAnchorDockLayoutTreeNode;
 
1388
  Side: TAnchorKind;
 
1389
  Splitter: TAnchorDockLayoutTreeNode;
 
1390
begin
 
1391
  WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode BEFORE DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self);
 
1392
  ChildNode.Parent:=nil;
 
1393
  try
 
1394
    if not ChildNode.IsSplitter then begin
 
1395
      // delete node bound splitter (= a splitter only anchored to this node)
 
1396
      for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1397
        Splitter:=FindNodeBoundSplitter(ChildNode,Side);
 
1398
        if Splitter<>nil then begin
 
1399
          DeleteNodeBoundSplitter(Splitter,ChildNode,OppositeAnchor[Side]);
 
1400
          exit;
 
1401
        end;
 
1402
      end;
 
1403
 
 
1404
      // delete spiral splitter
 
1405
      for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1406
        Splitter:=FindChildNode(ChildNode.Anchors[Side],false);
 
1407
        if (Splitter=nil) or (not Splitter.IsSplitter) then break;
 
1408
        if Side=High(TAnchorKind) then begin
 
1409
          DeleteSpiralSplitter(ChildNode);
 
1410
          exit;
 
1411
        end;
 
1412
      end;
 
1413
    end;
 
1414
  finally
 
1415
    // remove references
 
1416
    for i:=0 to Count-1 do begin
 
1417
      Sibling:=Nodes[i];
 
1418
      for Side:=low(TAnchorKind) to high(TAnchorKind) do
 
1419
        if Sibling.Anchors[Side]=ChildNode.Name then
 
1420
          Sibling.Anchors[Side]:='';
 
1421
    end;
 
1422
    WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode AFTER DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self);
 
1423
    // free node
 
1424
    ChildNode.Free;
 
1425
  end;
 
1426
end;
 
1427
 
 
1428
function TAnchorDockLayoutTreeNode.FindNodeBoundSplitter(
 
1429
  ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind
 
1430
  ): TAnchorDockLayoutTreeNode;
 
1431
var
 
1432
  AnchorNode: TAnchorDockLayoutTreeNode;
 
1433
  i: Integer;
 
1434
  AnchorName: string;
 
1435
begin
 
1436
  Result:=nil;
 
1437
  AnchorName:=ChildNode.Anchors[Side];
 
1438
  if AnchorName='' then exit;
 
1439
  AnchorNode:=FindChildNode(AnchorName,false);
 
1440
  if (AnchorNode=nil) or (not AnchorNode.IsSplitter) then exit;
 
1441
  for i:=0 to Count-1 do
 
1442
    if (Nodes[i]<>ChildNode) and (Nodes[i].Anchors[Side]=AnchorName) then exit;
 
1443
  Result:=AnchorNode;
 
1444
end;
 
1445
 
 
1446
procedure TAnchorDockLayoutTreeNode.DeleteNodeBoundSplitter(Splitter,
 
1447
  ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind);
 
1448
{ delete node bound splitter (= a splitter only anchored to this node)
 
1449
 
 
1450
  Example: Side=akRight
 
1451
                      #             #
 
1452
    #####################     #########
 
1453
       ---+S+--------+#         ---+#
 
1454
       ---+S|AControl|#   --->  ---+#
 
1455
       ---+S+--------+#         ---+#
 
1456
    #####################     #########
 
1457
}
 
1458
var
 
1459
  i: Integer;
 
1460
  Sibling: TAnchorDockLayoutTreeNode;
 
1461
begin
 
1462
  for i:=0 to Count-1 do begin
 
1463
    Sibling:=Nodes[i];
 
1464
    if Sibling.Anchors[Side]=Splitter.Name then
 
1465
      Sibling.Anchors[Side]:=ChildNode.Anchors[Side];
 
1466
  end;
 
1467
  DeleteNode(Splitter);
 
1468
end;
 
1469
 
 
1470
procedure TAnchorDockLayoutTreeNode.DeleteSpiralSplitter(
 
1471
  ChildNode: TAnchorDockLayoutTreeNode);
 
1472
{ Merge two splitters and delete one of them.
 
1473
  Prefer the pair with shortest distance between.
 
1474
 
 
1475
  For example:
 
1476
               3            3
 
1477
     11111111113            3
 
1478
        2+----+3            3
 
1479
        2|Node|3  --->  111111111
 
1480
        2+----+3            2
 
1481
        2444444444          2
 
1482
        2                   2
 
1483
   Everything anchored to 4 is now anchored to 1.
 
1484
   And right side of 1 is now anchored to where the right side of 4 was anchored.
 
1485
}
 
1486
var
 
1487
  Splitters: array[TAnchorKind] of TAnchorDockLayoutTreeNode;
 
1488
  Side: TAnchorKind;
 
1489
  i: Integer;
 
1490
  Sibling: TAnchorDockLayoutTreeNode;
 
1491
  Keep: TAnchorKind;
 
1492
  DeleteSplitter: TAnchorDockLayoutTreeNode;
 
1493
  NextSide: TAnchorKind;
 
1494
begin
 
1495
  // find the four splitters
 
1496
  for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1497
    Splitters[Side]:=FindChildNode(ChildNode.Anchors[Side],false);
 
1498
    if (Splitters[Side]=nil) or (not Splitters[Side].IsSplitter) then
 
1499
      RaiseGDBException(''); // missing splitter
 
1500
  end;
 
1501
  for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1502
    // spiral splitters are connected to each other
 
1503
    NextSide:=ClockwiseAnchor[Side];
 
1504
    if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then begin
 
1505
      NextSide:=OppositeAnchor[NextSide];
 
1506
      if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then
 
1507
        RaiseGDBException(''); // this is not a spiral splitter
 
1508
    end;
 
1509
  end;
 
1510
  // Prefer the pair with shortest distance between
 
1511
  if (Splitters[akRight].Left-Splitters[akLeft].Left)
 
1512
    <(Splitters[akBottom].Top-Splitters[akTop].Top)
 
1513
  then
 
1514
    Keep:=akLeft
 
1515
  else
 
1516
    Keep:=akTop;
 
1517
  DeleteSplitter:=Splitters[OppositeAnchor[Keep]];
 
1518
  // transfer anchors from the deleting splitter to the kept splitter
 
1519
  for i:=0 to Count-1 do begin
 
1520
    Sibling:=Nodes[i];
 
1521
    for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1522
      if FindChildNode(Sibling.Anchors[Side],false)=DeleteSplitter then
 
1523
        Sibling.Anchors[Side]:=Splitters[Keep].Name;
 
1524
    end;
 
1525
  end;
 
1526
  // longen kept splitter
 
1527
  NextSide:=ClockwiseAnchor[Keep];
 
1528
  if Splitters[Keep].Anchors[NextSide]<>Splitters[NextSide].Name then
 
1529
    NextSide:=OppositeAnchor[NextSide];
 
1530
  Splitters[Keep].Anchors[NextSide]:=DeleteSplitter.Anchors[NextSide];
 
1531
  // delete the splitter
 
1532
  DeleteNode(DeleteSplitter);
 
1533
end;
 
1534
 
 
1535
procedure TAnchorDockLayoutTreeNode.ReplaceWithChildren(
 
1536
  ChildNode: TAnchorDockLayoutTreeNode);
 
1537
{ move all children of ChildNode up.
 
1538
  All anchored to ChildNode (= their parent) use the anchors of ChildNode.
 
1539
  ChildNode is freed.
 
1540
}
 
1541
var
 
1542
  GrandChild: TAnchorDockLayoutTreeNode;
 
1543
  Side: TAnchorKind;
 
1544
begin
 
1545
  WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren BEFORE REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self);
 
1546
  DebugWriteChildAnchors(Self);
 
1547
  while ChildNode.Count>0 do begin
 
1548
    GrandChild:=ChildNode[0];
 
1549
    GrandChild.Parent:=Self;
 
1550
    OffsetRect(GrandChild.FBoundsRect,ChildNode.Left,ChildNode.Top);
 
1551
    for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
 
1552
      if GrandChild.Anchors[Side]='' then begin
 
1553
        if ((GrandChild.NodeType=adltnSplitterHorizontal)
 
1554
            and (Side in [akTop,akBottom]))
 
1555
        or ((GrandChild.NodeType=adltnSplitterVertical)
 
1556
            and (Side in [akLeft,akRight]))
 
1557
        then
 
1558
          continue; // a free splitter sides => don't anchor it
 
1559
        GrandChild.Anchors[Side]:=ChildNode.Anchors[Side];
 
1560
      end;
 
1561
    end;
 
1562
  end;
 
1563
  WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren AFTER REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self);
 
1564
  ChildNode.Free;
 
1565
  DebugWriteChildAnchors(Self);
 
1566
end;
 
1567
 
 
1568
procedure TAnchorDockLayoutTreeNode.IncreaseChangeStamp;
 
1569
begin
 
1570
  if Parent<>nil then Parent.IncreaseChangeStamp;
 
1571
end;
 
1572
 
 
1573
function TAnchorDockLayoutTreeNode.IsSplitter: boolean;
 
1574
begin
 
1575
  Result:=NodeType in [adltnSplitterHorizontal,adltnSplitterVertical];
 
1576
end;
 
1577
 
 
1578
function TAnchorDockLayoutTreeNode.IsRootWindow: boolean;
 
1579
begin
 
1580
  Result:=(NodeType in [adltnLayout,adltnPages,adltnControl,adltnCustomSite])
 
1581
          and ((Parent=nil) or (Parent.NodeType in [adltnNone]));
 
1582
end;
 
1583
 
 
1584
function TAnchorDockLayoutTreeNode.Count: integer;
 
1585
begin
 
1586
  Result:=FNodes.Count;
 
1587
end;
 
1588
 
 
1589
{ TAnchorDockLayoutTreeRootNode }
 
1590
 
 
1591
procedure TAnchorDockLayoutTreeRootNode.IncreaseChangeStamp;
 
1592
begin
 
1593
  Tree.IncreaseChangeStamp;
 
1594
end;
 
1595
 
 
1596
procedure TAnchorDockLayoutTreeRootNode.CheckConsistency;
 
1597
var
 
1598
  Names: TStringList;
 
1599
 
 
1600
  procedure RaiseNodePath(const Msg: string; Node: TAnchorDockLayoutTreeNode);
 
1601
  var
 
1602
    s: String;
 
1603
  begin
 
1604
    s:='';
 
1605
    while Node<>nil do begin
 
1606
      if s<>'' then
 
1607
        s:='/'+s;
 
1608
      s:=Node.Name+s;
 
1609
      Node:=Node.Parent;
 
1610
    end;
 
1611
    s:=Msg+s;
 
1612
  end;
 
1613
 
 
1614
  procedure CheckNames(Node: TAnchorDockLayoutTreeNode);
 
1615
  var
 
1616
    i: Integer;
 
1617
  begin
 
1618
    if (Node.Name='') and (Node<>Self) then
 
1619
      RaiseNodePath(adrsEmptyName, Node);
 
1620
    for i:=0 to Names.Count-1 do
 
1621
      if CompareText(Names[i],Node.Name)=0 then
 
1622
        RaiseNodePath(adrsDuplicateName, Node);
 
1623
    Names.Add(Node.Name);
 
1624
    for i:=0 to Node.Count-1 do
 
1625
      CheckNames(Node[i]);
 
1626
  end;
 
1627
 
 
1628
begin
 
1629
  // check that all names are unique
 
1630
  Names:=TStringList.Create;
 
1631
  try
 
1632
    CheckNames(Self);
 
1633
  finally
 
1634
    Names.Free;
 
1635
  end;
 
1636
  inherited CheckConsistency;
 
1637
end;
 
1638
 
 
1639
{ TAnchorDockLayoutTree }
 
1640
 
 
1641
procedure TAnchorDockLayoutTree.SetModified(const AValue: boolean);
 
1642
begin
 
1643
  if AValue then IncreaseChangeStamp;
 
1644
  if FModified=AValue then exit;
 
1645
  FModified:=AValue;
 
1646
end;
 
1647
 
 
1648
constructor TAnchorDockLayoutTree.Create;
 
1649
begin
 
1650
  FRoot:=TAnchorDockLayoutTreeRootNode.Create;
 
1651
  Root.FTree:=Self;
 
1652
end;
 
1653
 
 
1654
destructor TAnchorDockLayoutTree.Destroy;
 
1655
begin
 
1656
  FreeAndNil(FRoot);
 
1657
  inherited Destroy;
 
1658
end;
 
1659
 
 
1660
procedure TAnchorDockLayoutTree.Clear;
 
1661
begin
 
1662
  FRoot.Clear;
 
1663
  Modified:=false;
 
1664
end;
 
1665
 
 
1666
procedure TAnchorDockLayoutTree.LoadFromConfig(Config: TConfigStorage);
 
1667
begin
 
1668
  Config.AppendBasePath('Nodes/');
 
1669
  FRoot.LoadFromConfig(Config);
 
1670
  Config.UndoAppendBasePath;
 
1671
  Root.CheckConsistency;
 
1672
end;
 
1673
 
 
1674
procedure TAnchorDockLayoutTree.SaveToConfig(Config: TConfigStorage);
 
1675
begin
 
1676
  Config.AppendBasePath('Nodes/');
 
1677
  FRoot.SaveToConfig(Config);
 
1678
  Config.UndoAppendBasePath;
 
1679
end;
 
1680
 
 
1681
procedure TAnchorDockLayoutTree.IncreaseChangeStamp;
 
1682
begin
 
1683
  if FChangeStamp<High(FChangeStamp) then
 
1684
    inc(FChangeStamp)
 
1685
  else
 
1686
    FChangeStamp:=Low(FChangeStamp);
 
1687
end;
 
1688
 
 
1689
function TAnchorDockLayoutTree.NewNode(aParent: TAnchorDockLayoutTreeNode
 
1690
  ): TAnchorDockLayoutTreeNode;
 
1691
begin
 
1692
  Result:=TAnchorDockLayoutTreeNode.Create;
 
1693
  Result.Parent:=aParent;
 
1694
end;
 
1695
 
 
1696
{ TADNameToControl }
 
1697
 
 
1698
function TADNameToControl.IndexOfName(const aName: string): integer;
 
1699
begin
 
1700
  Result:=fItems.Count-1;
 
1701
  while (Result>=0) and (CompareText(aName,fItems[Result])<>0) do
 
1702
    dec(Result);
 
1703
end;
 
1704
 
 
1705
function TADNameToControl.GetControl(const aName: string): TControl;
 
1706
var
 
1707
  i: LongInt;
 
1708
begin
 
1709
  i:=IndexOfName(aName);
 
1710
  if i>=0 then
 
1711
    Result:=TControl(fItems.Objects[i])
 
1712
  else
 
1713
    Result:=nil;
 
1714
end;
 
1715
 
 
1716
procedure TADNameToControl.SetControl(const aName: string;
 
1717
  const AValue: TControl);
 
1718
var
 
1719
  i: LongInt;
 
1720
begin
 
1721
  i:=IndexOfName(aName);
 
1722
  if i>=0 then begin
 
1723
    fItems[i]:=aName;
 
1724
    fItems.Objects[i]:=AValue;
 
1725
  end else
 
1726
    fItems.AddObject(aName,AValue);
 
1727
end;
 
1728
 
 
1729
constructor TADNameToControl.Create;
 
1730
begin
 
1731
  fItems:=TStringList.Create;
 
1732
end;
 
1733
 
 
1734
destructor TADNameToControl.Destroy;
 
1735
begin
 
1736
  FreeAndNil(fItems);
 
1737
  inherited Destroy;
 
1738
end;
 
1739
 
 
1740
function TADNameToControl.ControlToName(AControl: TControl): string;
 
1741
var
 
1742
  i: Integer;
 
1743
begin
 
1744
  i:=fItems.Count-1;
 
1745
  while i>=0 do begin
 
1746
    if fItems.Objects[i]=AControl then begin
 
1747
      Result:=fItems[i];
 
1748
      exit;
 
1749
    end;
 
1750
    dec(i);
 
1751
  end;
 
1752
  Result:='';
 
1753
end;
 
1754
 
 
1755
procedure TADNameToControl.RemoveControl(AControl: TControl);
 
1756
var
 
1757
  i: Integer;
 
1758
begin
 
1759
  i:=fItems.Count-1;
 
1760
  while i>=0 do begin
 
1761
    if fItems.Objects[i]=AControl then
 
1762
      fItems.Delete(i);
 
1763
    dec(i);
 
1764
  end;
 
1765
end;
 
1766
 
 
1767
procedure TADNameToControl.WriteDebugReport(Msg: string);
 
1768
var
 
1769
  i: Integer;
 
1770
begin
 
1771
  debugln(['TADNameToControl.WriteDebugReport ',fItems.Count,' ',Msg]);
 
1772
  for i:=0 to fItems.Count-1 do begin
 
1773
    debugln(['  ',i,'/',fItems.Count,' "',dbgstr(fItems[i]),'" Control=',dbgsname(TControl(fItems.Objects[i]))]);
 
1774
  end;
 
1775
end;
 
1776
 
 
1777
{ TAnchorDockRestoreLayout }
 
1778
 
 
1779
procedure TAnchorDockRestoreLayout.SetControlNames(const AValue: TStrings);
 
1780
begin
 
1781
  if FControlNames=AValue then exit;
 
1782
  FControlNames.Assign(AValue);
 
1783
end;
 
1784
 
 
1785
constructor TAnchorDockRestoreLayout.Create;
 
1786
begin
 
1787
  FControlNames:=TStringList.Create;
 
1788
  FLayout:=TAnchorDockLayoutTree.Create;
 
1789
end;
 
1790
 
 
1791
constructor TAnchorDockRestoreLayout.Create(aLayout: TAnchorDockLayoutTree);
 
1792
begin
 
1793
  FControlNames:=TStringList.Create;
 
1794
  FLayout:=aLayout;
 
1795
  UpdateControlNames;
 
1796
end;
 
1797
 
 
1798
destructor TAnchorDockRestoreLayout.Destroy;
 
1799
begin
 
1800
  FreeAndNil(FLayout);
 
1801
  FreeAndNil(FControlNames);
 
1802
  inherited Destroy;
 
1803
end;
 
1804
 
 
1805
function TAnchorDockRestoreLayout.IndexOfControlName(AName: string): integer;
 
1806
begin
 
1807
  Result:=fControlNames.Count-1;
 
1808
  while (Result>=0) and (CompareText(AName,FControlNames[Result])<>0) do
 
1809
    dec(Result);
 
1810
end;
 
1811
 
 
1812
function TAnchorDockRestoreLayout.HasControlName(AName: string): boolean;
 
1813
begin
 
1814
  Result:=IndexOfControlName(AName)>=0;
 
1815
end;
 
1816
 
 
1817
procedure TAnchorDockRestoreLayout.RemoveControlName(AName: string);
 
1818
var
 
1819
  i: Integer;
 
1820
begin
 
1821
  for i:=FControlNames.Count-1 downto 0 do
 
1822
    if CompareText(AName,FControlNames[i])=0 then
 
1823
      FControlNames.Delete(i);
 
1824
end;
 
1825
 
 
1826
procedure TAnchorDockRestoreLayout.UpdateControlNames;
 
1827
 
 
1828
  procedure Check(Node: TAnchorDockLayoutTreeNode);
 
1829
  var
 
1830
    i: Integer;
 
1831
  begin
 
1832
    if (Node.Name<>'') and (Node.NodeType in [adltnControl,adltnCustomSite])
 
1833
    and (not HasControlName(Node.Name)) then
 
1834
      FControlNames.Add(Node.Name);
 
1835
    for i:=0 to Node.Count-1 do
 
1836
      Check(Node[i]);
 
1837
  end;
 
1838
 
 
1839
begin
 
1840
  FControlNames.Clear;
 
1841
  Check(Layout.Root);
 
1842
end;
 
1843
 
 
1844
procedure TAnchorDockRestoreLayout.LoadFromConfig(Config: TConfigStorage);
 
1845
var
 
1846
  i: Integer;
 
1847
  AName: string;
 
1848
  Node: TAnchorDockLayoutTreeNode;
 
1849
begin
 
1850
  FControlNames.Delimiter:=',';
 
1851
  FControlNames.StrictDelimiter:=true;
 
1852
  FControlNames.DelimitedText:=Config.GetValue('Names','');
 
1853
  Layout.LoadFromConfig(Config);
 
1854
  for i:=FControlNames.Count-1 downto 0 do begin
 
1855
    AName:=FControlNames[i];
 
1856
    if (AName<>'') and IsValidIdent(AName)
 
1857
    and (Layout.Root<>nil) then begin
 
1858
      Node:=Layout.Root.FindChildNode(AName,true);
 
1859
      if (Node<>nil) and (Node.NodeType in [adltnControl,adltnCustomSite]) then
 
1860
        continue;
 
1861
    end;
 
1862
    FControlNames.Delete(i);
 
1863
  end;
 
1864
end;
 
1865
 
 
1866
procedure TAnchorDockRestoreLayout.SaveToConfig(Config: TConfigStorage);
 
1867
begin
 
1868
  FControlNames.Delimiter:=',';
 
1869
  FControlNames.StrictDelimiter:=true;
 
1870
  Config.SetDeleteValue('Names',FControlNames.DelimitedText,'');
 
1871
  Layout.SaveToConfig(Config);
 
1872
end;
 
1873
 
 
1874
{ TAnchorDockRestoreLayouts }
 
1875
 
 
1876
function TAnchorDockRestoreLayouts.GetItems(Index: integer
 
1877
  ): TAnchorDockRestoreLayout;
 
1878
begin
 
1879
  Result:=TAnchorDockRestoreLayout(fItems[Index]);
 
1880
end;
 
1881
 
 
1882
constructor TAnchorDockRestoreLayouts.Create;
 
1883
begin
 
1884
  fItems:=TFPList.Create;
 
1885
end;
 
1886
 
 
1887
destructor TAnchorDockRestoreLayouts.Destroy;
 
1888
begin
 
1889
  Clear;
 
1890
  FreeAndNil(fItems);
 
1891
  inherited Destroy;
 
1892
end;
 
1893
 
 
1894
procedure TAnchorDockRestoreLayouts.Clear;
 
1895
var
 
1896
  i: Integer;
 
1897
begin
 
1898
  for i:=0 to fItems.Count-1 do
 
1899
    TObject(fItems[i]).Free;
 
1900
  fItems.Clear;
 
1901
end;
 
1902
 
 
1903
procedure TAnchorDockRestoreLayouts.Delete(Index: integer);
 
1904
begin
 
1905
  TObject(fItems[Index]).Free;
 
1906
  fItems.Delete(Index);
 
1907
end;
 
1908
 
 
1909
function TAnchorDockRestoreLayouts.IndexOfName(AControlName: string): integer;
 
1910
begin
 
1911
  Result:=Count-1;
 
1912
  while (Result>=0) and not Items[Result].HasControlName(AControlName) do
 
1913
    dec(Result);
 
1914
end;
 
1915
 
 
1916
function TAnchorDockRestoreLayouts.FindByName(AControlName: string
 
1917
  ): TAnchorDockRestoreLayout;
 
1918
var
 
1919
  i: LongInt;
 
1920
begin
 
1921
  i:=IndexOfName(AControlName);
 
1922
  if i>=0 then
 
1923
    Result:=Items[i]
 
1924
  else
 
1925
    Result:=nil;
 
1926
end;
 
1927
 
 
1928
procedure TAnchorDockRestoreLayouts.Add(Layout: TAnchorDockRestoreLayout;
 
1929
  RemoveOther: boolean);
 
1930
var
 
1931
  i: Integer;
 
1932
begin
 
1933
  if Layout=nil then exit;
 
1934
  if RemoveOther then begin
 
1935
    for i:=0 to Layout.ControlNames.Count-1 do
 
1936
      RemoveByName(Layout.ControlNames[i]);
 
1937
  end;
 
1938
  fItems.Add(Layout);
 
1939
end;
 
1940
 
 
1941
procedure TAnchorDockRestoreLayouts.RemoveByName(AControlName: string);
 
1942
var
 
1943
  i: Integer;
 
1944
  Layout: TAnchorDockRestoreLayout;
 
1945
begin
 
1946
  for i:=Count-1 downto 0 do begin
 
1947
    Layout:=Items[i];
 
1948
    Layout.RemoveControlName(AControlName);
 
1949
    if Layout.ControlNames.Count=0 then
 
1950
      Delete(i);
 
1951
  end;
 
1952
end;
 
1953
 
 
1954
procedure TAnchorDockRestoreLayouts.LoadFromConfig(Config: TConfigStorage);
 
1955
var
 
1956
  NewCount: longint;
 
1957
  NewItem: TAnchorDockRestoreLayout;
 
1958
  i: Integer;
 
1959
begin
 
1960
  Clear;
 
1961
  NewCount:=Config.GetValue('Count',0);
 
1962
  for i:=1 to NewCount do begin
 
1963
    NewItem:=TAnchorDockRestoreLayout.Create;
 
1964
    Config.AppendBasePath('Item'+IntToStr(i+1)+'/');
 
1965
    try
 
1966
      NewItem.LoadFromConfig(Config);
 
1967
    finally
 
1968
      Config.UndoAppendBasePath;
 
1969
    end;
 
1970
    if NewItem.ControlNames.Count>0 then
 
1971
      fItems.Add(NewItem)
 
1972
    else
 
1973
      NewItem.Free;
 
1974
  end;
 
1975
end;
 
1976
 
 
1977
procedure TAnchorDockRestoreLayouts.SaveToConfig(Config: TConfigStorage);
 
1978
var
 
1979
  i: Integer;
 
1980
begin
 
1981
  Config.SetDeleteValue('Count',Count,0);
 
1982
  for i:=0 to Count-1 do begin
 
1983
    Config.AppendBasePath('Item'+IntToStr(i+1)+'/');
 
1984
    try
 
1985
      Items[i].SaveToConfig(Config);
 
1986
    finally
 
1987
      Config.UndoAppendBasePath;
 
1988
    end;
 
1989
  end;
 
1990
end;
 
1991
 
 
1992
function TAnchorDockRestoreLayouts.ConfigIsEmpty(Config: TConfigStorage
 
1993
  ): boolean;
 
1994
begin
 
1995
  Result:=Config.GetValue('Count',0)<=0;
 
1996
end;
 
1997
 
 
1998
function TAnchorDockRestoreLayouts.Count: integer;
 
1999
begin
 
2000
  Result:=fItems.Count;
 
2001
end;
 
2002
 
 
2003
end.
 
2004