← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/ldockctrl.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:
lcl/ldockctrl.pas
1
 
{
2
 
 /***************************************************************************
3
 
                               LDockCtrl.pas
4
 
                             -----------------
5
 
 
6
 
 ***************************************************************************/
7
 
 
8
 
 *****************************************************************************
9
 
 *                                                                           *
10
 
 *  This file is part of the Lazarus Component Library (LCL)                 *
11
 
 *                                                                           *
12
 
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
13
 
 *  for details about the copyright.                                         *
14
 
 *                                                                           *
15
 
 *  This program is distributed in the hope that it will be useful,          *
16
 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
17
 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
18
 
 *                                                                           *
19
 
 *****************************************************************************
20
 
 
21
 
  Author: Mattias Gaertner
22
 
 
23
 
  Abstract:
24
 
    This unit contains visual components for docking and streaming.
25
 
 
26
 
  ToDo:
27
 
    - move the docking code to TCustomAnchoredDockManager
28
 
      and keep only the resizing code here.
29
 
    - restoring layout: pages
30
 
    - restoring layout: move form after inserting a control
31
 
    - restoring layout: spiral splitter
32
 
    - save TLazDockConfigNode to stream (atm only xml implemented)
33
 
    - load TLazDockConfigNode from stream (atm only xml implemented)
34
 
}
35
 
unit LDockCtrl;
36
 
 
37
 
{$mode objfpc}{$H+}
38
 
 
39
 
interface
40
 
 
41
 
uses
42
 
  Classes, Math, SysUtils, TypInfo, LCLProc, Controls, Forms, Menus,
43
 
  LCLStrConsts, AvgLvlTree, StringHashList, ExtCtrls, LazConfigStorage,
44
 
  LDockCtrlEdit, LDockTree;
45
 
 
46
 
type
47
 
  TNonDockConfigNames = (
48
 
    ndcnControlName, // '-Control ' + AControl.Name
49
 
    ndcnChildIndex,  // '-ID ' + IntToStr(AControl index in Parent) +' '+ AControl.ClassName
50
 
    ndcnParent       // '-Parent' : AControl.Parent
51
 
    );
52
 
 
53
 
const
54
 
  NonDockConfigNamePrefixes: array[TNonDockConfigNames] of string = (
55
 
    '-Name ',
56
 
    '-ID ',
57
 
    '-Parent');
58
 
 
59
 
type
60
 
  TLDConfigNodeType = (
61
 
    ldcntControl,
62
 
    ldcntForm,
63
 
    ldcntSplitterLeftRight,// vertical splitter, can be moved left/right
64
 
    ldcntSplitterUpDown,   // horizontal splitter, can be moved up/down
65
 
    ldcntPages,
66
 
    ldcntPage
67
 
    );
68
 
    
69
 
const
70
 
  LDConfigNodeTypeNames: array[TLDConfigNodeType] of string = (
71
 
    'Control',
72
 
    'Form',
73
 
    'SplitterLeftRight',
74
 
    'SplitterUpDown',
75
 
    'Pages',
76
 
    'Page'
77
 
    );
78
 
 
79
 
type
80
 
 
81
 
  { TLazDockConfigNode }
82
 
 
83
 
  TLazDockConfigNode = class(TPersistent)
84
 
  private
85
 
    FBounds: TRect;
86
 
    FClientBounds: TRect;
87
 
    FName: string;
88
 
    FParent: TLazDockConfigNode;
89
 
    FSides: array[TAnchorKind] of string;
90
 
    FTheType: TLDConfigNodeType;
91
 
    FChilds: TFPList;
92
 
    FWindowState: TWindowState;
93
 
    function GetChildCount: Integer;
94
 
    function GetChilds(Index: integer): TLazDockConfigNode;
95
 
    function GetSides(Side: TAnchorKind): string;
96
 
    procedure SetBounds(const AValue: TRect);
97
 
    procedure SetClientBounds(const AValue: TRect);
98
 
    procedure SetName(const AValue: string);
99
 
    procedure SetParent(const AValue: TLazDockConfigNode);
100
 
    procedure SetSides(Side: TAnchorKind; const AValue: string);
101
 
    procedure SetTheType(const AValue: TLDConfigNodeType);
102
 
    procedure DoAdd(ChildNode: TLazDockConfigNode);
103
 
    procedure DoRemove(ChildNode: TLazDockConfigNode);
104
 
  public
105
 
    constructor Create(ParentNode: TLazDockConfigNode);
106
 
    constructor Create(ParentNode: TLazDockConfigNode; const AName: string);
107
 
    destructor Destroy; override;
108
 
    procedure Clear;
109
 
    procedure Assign(Source: TPersistent); override;
110
 
    function FindByName(const AName: string; Recursive: boolean = false;
111
 
                        WithRoot: boolean = true): TLazDockConfigNode;
112
 
    function IndexOf(const AName: string): Integer;
113
 
    function GetScreenBounds: TRect;
114
 
    function FindNeighbour(SiblingSide: TAnchorKind;
115
 
                           NilIfAmbiguous: boolean;
116
 
                           IgnoreSplitters: boolean = true): TLazDockConfigNode;
117
 
    function IsTheOnlyNeighbour(Node: TLazDockConfigNode;
118
 
                                SiblingSide: TAnchorKind): boolean;
119
 
    procedure SaveToConfig(Config: TConfigStorage; const Path: string = '');
120
 
    procedure LoadFromConfig(Config: TConfigStorage; const Path: string = '');
121
 
    function GetPath: string;
122
 
    procedure WriteDebugReport;
123
 
    function DebugLayoutAsString: string;
124
 
  public
125
 
    property Bounds: TRect read FBounds write SetBounds;
126
 
    property ClientBounds: TRect read FClientBounds write SetClientBounds;
127
 
    property Parent: TLazDockConfigNode read FParent write SetParent;
128
 
    property Sides[Side: TAnchorKind]: string read GetSides write SetSides;
129
 
    property ChildCount: Integer read GetChildCount;
130
 
    property Children[Index: integer]: TLazDockConfigNode read GetChilds; default;
131
 
  published
132
 
    property TheType: TLDConfigNodeType read FTheType write SetTheType
133
 
                                                      default ldcntControl;
134
 
    property Name: string read FName write SetName;
135
 
    property WindowState: TWindowState read FWindowState write FWindowState;
136
 
  end;
137
 
  
138
 
  { TLazDockerConfig }
139
 
 
140
 
  TLazDockerConfig = class
141
 
  private
142
 
    FDockerName: string;
143
 
    FRoot: TLazDockConfigNode;
144
 
  public
145
 
    constructor Create(const ADockerName: string; ANode: TLazDockConfigNode);
146
 
    destructor Destroy; override;
147
 
    procedure WriteDebugReport;
148
 
    property DockerName: string read FDockerName;
149
 
    property Root: TLazDockConfigNode read FRoot;
150
 
  end;
151
 
  
152
 
  TCustomLazControlDocker = class;
153
 
  TCustomLazDockingManager = class;
154
 
  
155
 
  { TAnchoredDockManager }
156
 
 
157
 
  TAnchoredDockManager = class(TCustomAnchoredDockManager)
158
 
  private
159
 
    FConfigs: TCustomLazDockingManager;
160
 
  public
161
 
    procedure DisableLayout(Control: TControl); override;
162
 
    procedure EnableLayout(Control: TControl); override;
163
 
    property Configs: TCustomLazDockingManager read FConfigs;
164
 
  end;
165
 
 
166
 
  { TCustomLazDockingManager }
167
 
 
168
 
  TCustomLazDockingManager = class(TComponent)
169
 
  private
170
 
    FDockers: TFPList;
171
 
    FManager: TAnchoredDockManager;
172
 
    FConfigs: TFPList;// list of TLazDockerConfig
173
 
    function GetConfigCount: Integer;
174
 
    function GetConfigs(Index: Integer): TLazDockerConfig;
175
 
    function GetDockerCount: Integer;
176
 
    function GetDockers(Index: Integer): TCustomLazControlDocker;
177
 
  protected
178
 
    procedure Remove(Docker: TCustomLazControlDocker);
179
 
    function Add(Docker: TCustomLazControlDocker): Integer;
180
 
  public
181
 
    constructor Create(TheOwner: TComponent); override;
182
 
    destructor Destroy; override;
183
 
    function FindDockerByName(const ADockerName: string;
184
 
                Ignore: TCustomLazControlDocker = nil): TCustomLazControlDocker;
185
 
    function FindControlByDockerName(const ADockerName: string;
186
 
                Ignore: TCustomLazControlDocker = nil): TControl;
187
 
    function FindDockerByControl(AControl: TControl;
188
 
                Ignore: TCustomLazControlDocker = nil): TCustomLazControlDocker;
189
 
    function CreateUniqueName(const AName: string;
190
 
                              Ignore: TCustomLazControlDocker): string;
191
 
    function GetControlConfigName(AControl: TControl): string;
192
 
    procedure DisableLayout(Control: TControl);
193
 
    procedure EnableLayout(Control: TControl);
194
 
    procedure SaveToConfig(Config: TConfigStorage; const Path: string = '');
195
 
    procedure LoadFromConfig(Config: TConfigStorage; const Path: string = '');
196
 
    procedure AddOrReplaceConfig(const DockerName: string;
197
 
                                 Config: TLazDockConfigNode);
198
 
    procedure ClearConfigs;
199
 
    function GetConfigWithDockerName(const DockerName: string
200
 
                                     ): TLazDockerConfig;
201
 
    function CreateLayout(const DockerName: string; VisibleControl: TControl;
202
 
                          ExceptionOnError: boolean = false): TLazDockConfigNode;
203
 
    function ConfigIsCompatible(RootNode: TLazDockConfigNode;
204
 
                                ExceptionOnError: boolean = false): boolean;
205
 
 
206
 
    procedure WriteDebugReport;
207
 
  public
208
 
    property Manager: TAnchoredDockManager read FManager;
209
 
    property DockerCount: Integer read GetDockerCount;
210
 
    property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers; default;
211
 
    property ConfigCount: Integer read GetConfigCount;
212
 
    property Configs[Index: Integer]: TLazDockerConfig read GetConfigs;
213
 
  end;
214
 
 
215
 
  { TLazDockingManager }
216
 
 
217
 
  TLazDockingManager = class(TCustomLazDockingManager)
218
 
  published
219
 
  end;
220
 
  
221
 
  { TLCDMenuItem }
222
 
 
223
 
  TLCDMenuItem = class
224
 
  public
225
 
    Menu: TPopupMenu;
226
 
    Item: TMenuItem;
227
 
  end;
228
 
 
229
 
  { TCustomLazControlDocker
230
 
    A component to connect a form to the TLazDockingManager.
231
 
    When the control gets visible TCustomLazControlDocker restores the layout.
232
 
    Before the control gets invisible, TCustomLazControlDocker saves the layout.
233
 
    }
234
 
  TCustomLazControlDocker = class(TComponent)
235
 
  private
236
 
    FControl: TControl;
237
 
    FDockerName: string;
238
 
    FEnabled: boolean;
239
 
    FExtendPopupMenu: boolean;
240
 
    FLayoutLock: integer;
241
 
    FLocalizedName: string;
242
 
    FManager: TCustomLazDockingManager;
243
 
    FMenus: TFPList;// list of TLCDMenuItem
244
 
    FPopupMenuItem: TMenuItem;
245
 
    procedure SetControl(const AValue: TControl);
246
 
    procedure SetDockerName(const AValue: string);
247
 
    procedure SetExtendPopupMenu(const AValue: boolean);
248
 
    procedure SetLocalizedName(const AValue: string);
249
 
    procedure SetManager(const AValue: TCustomLazDockingManager);
250
 
    procedure PopupMenuItemClick(Sender: TObject);
251
 
  protected
252
 
    procedure UpdatePopupMenu; virtual;
253
 
    procedure Loaded; override;
254
 
    function GetLocalizedName: string;
255
 
    procedure ControlVisibleChanging(Sender: TObject);
256
 
    procedure ControlVisibleChanged(Sender: TObject);
257
 
    function CreateFormAndDockWithSplitter(Layout: TLazDockConfigNode;
258
 
                                           Side: TAnchorKind): boolean;
259
 
    function DockAsPage(Layout: TLazDockConfigNode): boolean;
260
 
    procedure FixControlBounds(Layout: TLazDockConfigNode;
261
 
                               ResizedControl: TControl);
262
 
    procedure ShrinkNeighbourhood(Layout: TLazDockConfigNode;
263
 
                                  AControl: TControl; Sides: TAnchors);
264
 
    function FindPageNeighbours(Layout: TLazDockConfigNode;
265
 
                                StartControl: TControl;
266
 
                                out AnchorControls: TAnchorControlsRect
267
 
                                ): TFPList; // list of TControls
268
 
    procedure Notification(AComponent: TComponent;
269
 
                           Operation: TOperation); override;
270
 
    function FindLCDMenuItem(AMenu: TMenu): TLCDMenuItem;
271
 
    function FindLCDMenuItem(AMenuItem: TMenuItem): TLCDMenuItem;
272
 
  public
273
 
    constructor Create(TheOwner: TComponent); override;
274
 
    destructor Destroy; override;
275
 
    procedure ShowDockingEditor; virtual;
276
 
    function GetLayoutFromControl: TLazDockConfigNode;
277
 
    procedure SaveLayout;
278
 
    procedure RestoreLayout;
279
 
    procedure DisableLayout;
280
 
    procedure EnableLayout;
281
 
    function ControlIsDocked: boolean;
282
 
    function GetControlName(AControl: TControl): string;
283
 
    procedure AddPopupMenu(Menu: TPopupMenu);
284
 
    procedure RemovePopupMenu(Menu: TPopupMenu);
285
 
    property Control: TControl read FControl write SetControl;
286
 
    property Manager: TCustomLazDockingManager read FManager write SetManager;
287
 
    property ExtendPopupMenu: boolean read FExtendPopupMenu write SetExtendPopupMenu default true;
288
 
    property PopupMenuItem: TMenuItem read FPopupMenuItem;
289
 
    property LocalizedName: string read FLocalizedName write SetLocalizedName;
290
 
    property DockerName: string read FDockerName write SetDockerName;
291
 
    property Enabled: boolean read FEnabled write FEnabled;// true to auto restore layout on show
292
 
    property LayoutLock: integer read FLayoutLock;
293
 
  end;
294
 
 
295
 
  { TLazControlDocker }
296
 
 
297
 
  TLazControlDocker = class(TCustomLazControlDocker)
298
 
  published
299
 
    property Control;
300
 
    property Manager;
301
 
    property ExtendPopupMenu;
302
 
    property DockerName;
303
 
    property Enabled;
304
 
  end;
305
 
 
306
 
 
307
 
function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType;
308
 
 
309
 
function FindExclusiveSplitter(ControlList: TFPList; Side: TAnchorKind
310
 
                               ): TLazDockSplitter;
311
 
function FindNextControlAnchoredToBoundary(AControl: TControl;
312
 
                          Boundary, SearchDirection: TAnchorKind): TControl;
313
 
function FindSplitterRectangularNeighbourhood(Splitter: TLazDockSplitter;
314
 
           SplitterSide: TAnchorKind; out Bounds: TAnchorControlsRect): TFPList;
315
 
 
316
 
function dbgs(Node: TLazDockConfigNode): string; overload;
317
 
 
318
 
procedure Register;
319
 
 
320
 
 
321
 
implementation
322
 
 
323
 
 
324
 
procedure Register;
325
 
begin
326
 
  RegisterComponents('Misc',[TLazDockingManager,TLazControlDocker]);
327
 
end;
328
 
 
329
 
function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType;
330
 
begin
331
 
  for Result:=Low(TLDConfigNodeType) to High(TLDConfigNodeType) do
332
 
    if CompareText(LDConfigNodeTypeNames[Result],s)=0 then exit;
333
 
  Result:=ldcntControl;
334
 
end;
335
 
 
336
 
function FindExclusiveSplitter(ControlList: TFPList;
337
 
  Side: TAnchorKind): TLazDockSplitter;
338
 
{ find a splitter, that is not part of ControlList and anchored on one side
339
 
  only to the controls in ControlList
340
 
 
341
 
  For example: A,B,C,S1,S2 (S1,S2 are the splitters between)
342
 
 
343
 
    |+-----+
344
 
    ||  A  |
345
 
    |+-----+
346
 
    |-------
347
 
    |+-+|+-+
348
 
    ||B|||C|
349
 
    |+-+|+-+
350
 
  will return the splitter to the left and Side=akLeft.
351
 
}
352
 
var
353
 
  AControl: TControl;
354
 
  i: Integer;
355
 
  AParent: TWinControl;
356
 
  j: Integer;
357
 
  AnchoredToControlList: Boolean;
358
 
  AnchoredToOther: Boolean;
359
 
begin
360
 
  Result:=nil;
361
 
  if (ControlList=nil) or (ControlList.Count=0) then exit;
362
 
  AControl:=TControl(ControlList[0]);
363
 
  if AControl.Parent=nil then exit;
364
 
  AParent:=AControl.Parent;
365
 
  for i:=0 to AParent.ControlCount-1 do begin
366
 
    Result:=TLazDockSplitter(AParent.Controls[i]);
367
 
    if (Result is TLazDockSplitter)
368
 
    and (ControlList.IndexOf(Result)<0)
369
 
    then begin
370
 
      // ASplitter is a splitter which is not in the ControlList
371
 
      // => check if the splitter is exclusively anchored
372
 
      AnchoredToControlList:=false;
373
 
      AnchoredToOther:=false;
374
 
      for j:=0 to AParent.ControlCount-1 do begin
375
 
        AControl:=TControl(ControlList[j]);
376
 
        if (AControl.AnchorSide[Side].Control=Result) then
377
 
        begin
378
 
          if ControlList.IndexOf(AControl)>=0 then
379
 
            AnchoredToControlList:=true
380
 
          else begin
381
 
            AnchoredToOther:=true;
382
 
            break;
383
 
          end;
384
 
        end;
385
 
        if AnchoredToControlList and not AnchoredToOther then
386
 
          exit;
387
 
      end;
388
 
    end;
389
 
  end;
390
 
  Result:=nil;
391
 
end;
392
 
 
393
 
function FindNextControlAnchoredToBoundary(
394
 
  AControl: TControl; Boundary, SearchDirection: TAnchorKind): TControl;
395
 
{ Finds the next control anchored to the same as AControl
396
 
  For example:
397
 
 
398
 
  ------------------------------------
399
 
    +-+|+-+|+-+|
400
 
    |A|||B|||C||
401
 
 
402
 
  With Boundary=akTop and SearchDirection=akRight the next of A is the splitter
403
 
  to the right, then the splitter right of B, then C, ...
404
 
}
405
 
var
406
 
  AParent: TWinControl;
407
 
  i: Integer;
408
 
  BoundaryControl: TControl;
409
 
begin
410
 
  Result:=AControl.AnchorSide[SearchDirection].Control;
411
 
  if (Result<>nil) then begin
412
 
    if Result.Parent=AControl.Parent then
413
 
      exit
414
 
    else
415
 
      exit(nil);
416
 
  end else begin
417
 
    AParent:=AControl.Parent;
418
 
    if AParent=nil then exit;
419
 
    BoundaryControl:=AControl.AnchorSide[Boundary].Control;
420
 
    if BoundaryControl=nil then exit;
421
 
    for i:=0 to AParent.ControlCount-1 do begin
422
 
      Result:=AParent.Controls[i];
423
 
      if (Result.AnchorSide[Boundary].Control=BoundaryControl)
424
 
      and (Result.AnchorSide[OppositeAnchor[SearchDirection]].Control=AControl)
425
 
      then
426
 
        exit;
427
 
    end;
428
 
    Result:=nil;
429
 
  end;
430
 
end;
431
 
 
432
 
function FindSplitterRectangularNeighbourhood(
433
 
  Splitter: TLazDockSplitter; SplitterSide: TAnchorKind;
434
 
  out Bounds: TAnchorControlsRect): TFPList;
435
 
{ Find a list of controls, building a rectangular area (without holes) touching
436
 
  the complete SplitterSide of Splitter.
437
 
  RectBounds will be the four bounding controls (Parent or Siblings).
438
 
 
439
 
  For example: akRight of
440
 
 
441
 
    |+-----+
442
 
    ||  A  |
443
 
    |+-----+
444
 
    |-------
445
 
    |+-+|+-+
446
 
    ||B|||C|
447
 
    |+-+|+-+
448
 
 
449
 
  will find A,B,C and the two splitter controls between A,B,C.
450
 
}
451
 
 
452
 
  function IsBoundary(AControl: TControl): boolean;
453
 
  var
454
 
    a: TAnchorKind;
455
 
  begin
456
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do if Bounds[a]=AControl then
457
 
      exit(true);
458
 
    Result:=false;
459
 
  end;
460
 
 
461
 
var
462
 
  BoundSide1: TAnchorKind;
463
 
  BoundSide2: TAnchorKind;
464
 
  AControl: TControl;
465
 
  a: TAnchorKind;
466
 
  Candidate: TControl;
467
 
  j: Integer;
468
 
  i: Integer;
469
 
  OppSide: TAnchorKind;
470
 
begin
471
 
  Result:=nil;
472
 
  BoundSide1:=ClockwiseAnchor[SplitterSide];
473
 
  BoundSide2:=OppositeAnchor[BoundSide1];
474
 
  OppSide:=OppositeAnchor[SplitterSide];
475
 
  Bounds[OppSide]:=Splitter;
476
 
  Bounds[BoundSide1]:=Splitter.AnchorSide[BoundSide1].Control;
477
 
  Bounds[BoundSide2]:=Splitter.AnchorSide[BoundSide2].Control;
478
 
  Bounds[SplitterSide]:=nil;
479
 
  if (Bounds[BoundSide1]=nil) or (Bounds[BoundSide2]=nil) then exit;
480
 
 
481
 
  { search for a splitter, bounded the same as Splitter
482
 
    --------
483
 
      |   |
484
 
      |   |
485
 
    --------
486
 
  }
487
 
  AControl:=Splitter;
488
 
  repeat
489
 
    AControl:=FindNextControlAnchoredToBoundary(AControl,BoundSide1,SplitterSide);
490
 
    if AControl=nil then break;
491
 
    if (AControl is TLazDockSplitter)
492
 
    and (AControl.AnchorSide[BoundSide1].Control=Bounds[BoundSide1])
493
 
    and (AControl.AnchorSide[BoundSide2].Control=Bounds[BoundSide2]) then begin
494
 
      // found
495
 
      Bounds[SplitterSide]:=AControl;
496
 
      break;
497
 
    end;
498
 
  until false;
499
 
 
500
 
  if (Bounds[SplitterSide]=nil)
501
 
  and (Bounds[BoundSide1]<>Splitter.Parent) then begin
502
 
    { check for example
503
 
      ------|
504
 
        |   |   "Splitter" is the left one
505
 
        |   |
506
 
      --------
507
 
    }
508
 
    AControl:=Bounds[BoundSide1].AnchorSide[SplitterSide].Control;
509
 
    if (AControl is TLazDockSplitter)
510
 
    and (AControl.AnchorSide[BoundSide2].Control=Bounds[BoundSide2]) then
511
 
      Bounds[SplitterSide]:=AControl;
512
 
  end;
513
 
 
514
 
  if (Bounds[SplitterSide]=nil)
515
 
  and (Bounds[BoundSide2]<>Splitter.Parent) then begin
516
 
    { check for example
517
 
      --------
518
 
        |   |   "Splitter" is the left one
519
 
        |   |
520
 
      ------|
521
 
    }
522
 
    AControl:=Bounds[BoundSide2].AnchorSide[SplitterSide].Control;
523
 
    if (AControl is TLazDockSplitter)
524
 
    and (AControl.AnchorSide[BoundSide1].Control=Bounds[BoundSide1]) then
525
 
      Bounds[SplitterSide]:=AControl;
526
 
  end;
527
 
 
528
 
  if (Bounds[SplitterSide]=nil)
529
 
  and (Bounds[BoundSide1]<>Splitter.Parent) then begin
530
 
    { check for example
531
 
      ------|
532
 
        |   |   "Splitter" is the left one
533
 
        |   |
534
 
      ------|
535
 
    }
536
 
    AControl:=Bounds[BoundSide1].AnchorSide[SplitterSide].Control;
537
 
    if (Acontrol<>nil)
538
 
    and (Bounds[BoundSide2]<>nil)
539
 
    and (AControl=Bounds[BoundSide2].AnchorSide[SplitterSide].Control) then
540
 
      Bounds[SplitterSide]:=AControl;
541
 
  end;
542
 
 
543
 
  if Bounds[SplitterSide]=nil then exit;
544
 
 
545
 
  // find all controls between the Bounds
546
 
 
547
 
  // find a first control in the area
548
 
  AControl:=FindNextControlAnchoredToBoundary(Splitter,BoundSide1,SplitterSide);
549
 
  if (AControl=nil) or (AControl=Bounds[SplitterSide]) then exit;
550
 
  Result:=TFPlist.Create;
551
 
  Result.Add(AControl);
552
 
 
553
 
  // add the others with flood fill
554
 
  i:=0;
555
 
  while i<Result.Count-1 do begin
556
 
    AControl:=TControl(Result[i]);
557
 
    // test all anchored to
558
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
559
 
      Candidate:=AControl.AnchorSide[a].Control;
560
 
      if (not IsBoundary(Candidate)) and (Result.IndexOf(Candidate)<0) then
561
 
        Result.Add(Candidate);
562
 
    end;
563
 
    // test all anchored by
564
 
    for j:=0 to Splitter.Parent.ControlCount-1 do begin
565
 
      Candidate:=Splitter.Parent.Controls[j];
566
 
      if IsBoundary(Candidate) then continue;
567
 
      if Result.IndexOf(Candidate)>=0 then continue;
568
 
      for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
569
 
        if Candidate.AnchorSide[a].Control=AControl then begin
570
 
          Result.Add(Candidate);
571
 
          break;
572
 
        end;
573
 
      end;
574
 
    end;
575
 
    inc(i);
576
 
  end;
577
 
end;
578
 
 
579
 
function dbgs(Node: TLazDockConfigNode): string;
580
 
begin
581
 
  if Node=nil then begin
582
 
    Result:='nil';
583
 
  end else begin
584
 
    Result:=Node.Name+'{Type='+LDConfigNodeTypeNames[Node.TheType]
585
 
                     +',ChildCnt='+IntToStr(Node.ChildCount)+'}';
586
 
  end;
587
 
end;
588
 
 
589
 
{ TCustomLazControlDocker }
590
 
 
591
 
procedure TCustomLazControlDocker.SetManager(
592
 
  const AValue: TCustomLazDockingManager);
593
 
begin
594
 
  if FManager=AValue then exit;
595
 
  //DebugLn('TCustomLazControlDocker.SetManager Old=',DbgSName(Manager),' New=',DbgSName(AValue));
596
 
  if FManager<>nil then FManager.Remove(Self);
597
 
  FManager:=AValue;
598
 
  if FManager<>nil then FManager.Add(Self);
599
 
  UpdatePopupMenu;
600
 
end;
601
 
 
602
 
procedure TCustomLazControlDocker.UpdatePopupMenu;
603
 
// creates or deletes the PopupMenuItem to the PopupMenu of Control
604
 
begin
605
 
  if [csDesigning, csLoading, csDestroying] * ComponentState <> [] then Exit;
606
 
 
607
 
  //DebugLn('TCustomLazControlDocker.UpdatePopupMenu ',DbgSName(Control),' Manager=',DbgSName(Manager),' PopupMenu=',dbgs((Control<>nil) and (Control.PopupMenu<>nil)),' ExtendPopupMenu=',dbgs(ExtendPopupMenu));
608
 
 
609
 
  if ExtendPopupMenu and (Control<>nil) and (Control.PopupMenu<>nil)
610
 
  and (Manager<>nil) then begin
611
 
    //DebugLn('TCustomLazControlDocker.UpdatePopupMenu ADDING');
612
 
    AddPopupMenu(Control.PopupMenu);
613
 
  end else begin
614
 
    // delete PopupMenuItem
615
 
    if (Control<>nil) and (Control.PopupMenu<>nil) then
616
 
      RemovePopupMenu(Control.PopupMenu);
617
 
  end;
618
 
end;
619
 
 
620
 
procedure TCustomLazControlDocker.Loaded;
621
 
begin
622
 
  inherited Loaded;
623
 
  UpdatePopupMenu;
624
 
end;
625
 
 
626
 
procedure TCustomLazControlDocker.ShowDockingEditor;
627
 
var
628
 
  Dlg: TLazDockControlEditorDlg;
629
 
  i: Integer;
630
 
  TargetDocker: TCustomLazControlDocker;
631
 
  Side: TAlign;
632
 
  CurDocker: TCustomLazControlDocker;
633
 
  Anchor: TAnchorKind;
634
 
begin
635
 
  if (Manager=nil) or (Control=nil) then
636
 
    raise Exception.Create('TCustomLazControlDocker.ShowDockingEditor no docking available');
637
 
  Dlg:=TLazDockControlEditorDlg.Create(nil);
638
 
  try
639
 
    // fill the list of controls this control can dock to
640
 
    Dlg.DockControlComboBox.Text:='';
641
 
    Dlg.DockControlComboBox.Items.BeginUpdate;
642
 
    //DebugLn('TCustomLazControlDocker.ShowDockingEditor Self=',DockerName,' Manager.DockerCount=',dbgs(Manager.DockerCount));
643
 
    try
644
 
      Dlg.DockControlComboBox.Items.Clear;
645
 
      for i:=0 to Manager.DockerCount-1 do begin
646
 
        CurDocker:=Manager.Dockers[i];
647
 
        //DebugLn('TCustomLazControlDocker.ShowDockingEditor Self=',DockerName,' CurDocker=',CurDocker.DockerName);
648
 
        if CurDocker=Self then continue;
649
 
        if CurDocker.Control=nil then continue;
650
 
        Dlg.DockControlComboBox.Items.Add(CurDocker.GetLocalizedName);
651
 
      end;
652
 
      Dlg.DockControlComboBox.Enabled:=Dlg.DockControlComboBox.Items.Count>0;
653
 
    finally
654
 
      Dlg.DockControlComboBox.Items.EndUpdate;
655
 
    end;
656
 
 
657
 
    // enable Undock button, if Control is docked
658
 
    Dlg.UndockGroupBox.Enabled:=ControlIsDocked;
659
 
                                 
660
 
    // enable enlarge buttons
661
 
    Dlg.EnlargeLeftSpeedButton.Visible:=
662
 
                            Manager.Manager.EnlargeControl(Control,akLeft,true);
663
 
    Dlg.EnlargeTopSpeedButton.Visible:=
664
 
                             Manager.Manager.EnlargeControl(Control,akTop,true);
665
 
    Dlg.EnlargeRightSpeedButton.Visible:=
666
 
                           Manager.Manager.EnlargeControl(Control,akRight,true);
667
 
    Dlg.EnlargeBottomSpeedButton.Visible:=
668
 
                          Manager.Manager.EnlargeControl(Control,akBottom,true);
669
 
 
670
 
    Dlg.EnlargeGroupBox.Visible := Dlg.EnlargeLeftSpeedButton.Visible or 
671
 
                                   Dlg.EnlargeTopSpeedButton.Visible or
672
 
                                   Dlg.EnlargeRightSpeedButton.Visible or
673
 
                                   Dlg.EnlargeBottomSpeedButton.Visible;
674
 
 
675
 
    if Dlg.ShowModal=mrOk then begin
676
 
      // dock or undock
677
 
      case Dlg.DlgResult of
678
 
      ldcedrUndock:
679
 
        // undock
680
 
        Manager.Manager.UndockControl(Control,true);
681
 
      ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop,
682
 
        ldcedrDockBottom,ldcedrDockPage:
683
 
        // dock
684
 
        begin
685
 
          TargetDocker:=nil;
686
 
          for i:=0 to Manager.DockerCount-1 do begin
687
 
            CurDocker:=Manager.Dockers[i];
688
 
            if CurDocker=Self then continue;
689
 
            if Dlg.DockControlComboBox.Text=CurDocker.GetLocalizedName then
690
 
              TargetDocker:=CurDocker;
691
 
          end;
692
 
          if TargetDocker=nil then begin
693
 
            RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor TargetDocker=nil');
694
 
          end;
695
 
          case Dlg.DlgResult of
696
 
          ldcedrDockLeft: Side:=alLeft;
697
 
          ldcedrDockRight: Side:=alRight;
698
 
          ldcedrDockTop: Side:=alTop;
699
 
          ldcedrDockBottom: Side:=alBottom;
700
 
          ldcedrDockPage: Side:=alClient;
701
 
          else RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor ?');
702
 
          end;
703
 
          Manager.Manager.DockControl(Control,Side,TargetDocker.Control);
704
 
        end;
705
 
      ldcedrEnlargeLeft,ldcedrEnlargeTop,ldcedrEnlargeRight,ldcedrEnlargeBottom:
706
 
        begin
707
 
          // enlarge
708
 
          case Dlg.DlgResult of
709
 
          ldcedrEnlargeLeft: Anchor:=akLeft;
710
 
          ldcedrEnlargeRight: Anchor:=akRight;
711
 
          ldcedrEnlargeTop: Anchor:=akTop;
712
 
          ldcedrEnlargeBottom: Anchor:=akBottom;
713
 
          else RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor ?');
714
 
          end;
715
 
          Manager.Manager.EnlargeControl(Control,Anchor);
716
 
        end;
717
 
      end;
718
 
    end;
719
 
  finally
720
 
    Dlg.Free;
721
 
  end;
722
 
end;
723
 
 
724
 
function TCustomLazControlDocker.GetLocalizedName: string;
725
 
begin
726
 
  Result:=LocalizedName;
727
 
  if LocalizedName='' then begin
728
 
    Result:=DockerName;
729
 
    if (Result='') and (Control<>nil) then
730
 
      Result:=Control.Name;
731
 
    if Result='' then
732
 
      Result:=Name;
733
 
  end;
734
 
end;
735
 
 
736
 
procedure TCustomLazControlDocker.ControlVisibleChanging(Sender: TObject);
737
 
begin
738
 
  if Manager=nil then exit;
739
 
  if Control<>Sender then begin
740
 
    DebugLn('TCustomLazControlDocker.ControlVisibleChanging WARNING: ',
741
 
      DbgSName(Control),'<>',DbgSName(Sender));
742
 
    exit;
743
 
  end;
744
 
  {$IFDEF VerboseAnchorDocking}
745
 
  DebugLn(['TCustomLazControlDocker.ControlVisibleChanging Sender=',DbgSName(Sender),' Control.Visible=',Control.Visible]);
746
 
  DumpStack;
747
 
  {$ENDIF}
748
 
  if FLayoutLock>0 then begin
749
 
    DebugLn(['TCustomLazControlDocker.ControlVisibleChanging ',DbgSName(Control),' ignore because FLayoutLock=',FLayoutLock]);
750
 
    exit;
751
 
  end;
752
 
  
753
 
  if Control.Visible then begin
754
 
    // control will be hidden -> the layout will change
755
 
    // save the layout for later restore
756
 
    SaveLayout;
757
 
    {$IFDEF VerboseAnchorDocking}
758
 
    DebugLn(['TCustomLazControlDocker.ControlVisibleChanging Parent=',DbgSName(Control.Parent)]);
759
 
    {$ENDIF}
760
 
  end else if ([csDestroying,csDesigning,csLoading]*ComponentState=[]) then begin
761
 
    // the control will become visible -> dock it to restore the last layout
762
 
    RestoreLayout;
763
 
  end;
764
 
end;
765
 
 
766
 
procedure TCustomLazControlDocker.ControlVisibleChanged(Sender: TObject);
767
 
begin
768
 
  if Manager=nil then exit;
769
 
  {$IFDEF VerboseAnchorDocking}
770
 
  DebugLn(['TCustomLazControlDocker.ControlVisibleChanged Sender=',DbgSName(Sender),' Control.Visible=',Control.Visible]);
771
 
  //DumpStack;
772
 
  {$ENDIF}
773
 
  if FLayoutLock>0 then begin
774
 
    //DebugLn(['TCustomLazControlDocker.ControlVisibleChanged ',DbgSName(Control),' ignore because FLayoutLock=',FLayoutLock]);
775
 
    exit;
776
 
  end;
777
 
 
778
 
  if Control.Visible then begin
779
 
    // the control has become visible
780
 
  end else if ([csDesigning,csLoading]*ComponentState=[]) then begin
781
 
    // control was hidden (or destroyed)
782
 
    if ControlIsDocked
783
 
    and (Manager<>nil)
784
 
    and (Manager.Manager<>nil) then begin
785
 
      // auto undock
786
 
      DebugLn(['TCustomLazControlDocker.ControlVisibleChanged auto undock ',DbgSName(Control)]);
787
 
      Manager.Manager.UndockControl(Control,false);
788
 
    end;
789
 
  end;
790
 
end;
791
 
 
792
 
function TCustomLazControlDocker.CreateFormAndDockWithSplitter(
793
 
  Layout: TLazDockConfigNode; Side: TAnchorKind): boolean;
794
 
{ Add a splitter to Side and dock to it. For example:
795
 
 
796
 
  Side=akLeft
797
 
      --------+      -------------+
798
 
          ---+|      ---+#+------+|
799
 
           A ||       A |#|      ||
800
 
          ---+|      ---+#|      ||
801
 
          ====|  ->  ====#| Self ||
802
 
          ---+|      ---+#|      ||
803
 
           B ||       B |#|      ||
804
 
          ---+|      ---+#+------+|
805
 
      --------+      -------------+
806
 
  If A has no parent, a TLazDockForm is created.
807
 
 
808
 
  To get space for Self, either A,B are shrinked
809
 
  and/or the parent of A,B is enlarged (including the grand parents of A,B).
810
 
}
811
 
 
812
 
  function FindNextNeighbour(SplitterNode: TLazDockConfigNode;
813
 
    Neighbours: TFPList; Append: boolean): boolean;
814
 
  var
815
 
    Neighbour: TControl;
816
 
    i: Integer;
817
 
    Sibling: TControl;
818
 
    Search: TAnchorKind;
819
 
    Splitter, CurSplitter: TLazDockSplitter;
820
 
    OldAnchor, CurAnchor: TControl;
821
 
    NewNeighbour: TControl;
822
 
    NodeName: String;
823
 
    Node: TLazDockConfigNode;
824
 
  begin
825
 
    Result:=false;
826
 
    if Neighbours=nil then exit;
827
 
    if Append then
828
 
      Neighbour:=TControl(Neighbours[Neighbours.Count-1])
829
 
    else
830
 
      Neighbour:=TControl(Neighbours[0]);
831
 
    if Neighbour.Parent=nil then exit;
832
 
    if not GetLazDockSplitterOrParent(Neighbour,OppositeAnchor[Side],OldAnchor)
833
 
    then exit;
834
 
    // search direction
835
 
    if (Side in [akLeft,akRight]) then begin
836
 
      if Append then Search:=akBottom else Search:=akTop;
837
 
    end else begin
838
 
      if Append then Search:=akRight else Search:=akLeft;
839
 
    end;
840
 
    // find splitter
841
 
    if not GetLazDockSplitter(Neighbour,Search,Splitter) then exit;
842
 
    if (not GetLazDockSplitterOrParent(Splitter,OppositeAnchor[Side],CurAnchor))
843
 
    or (CurAnchor<>OldAnchor) then exit;
844
 
    // find neighbour (anchored to Splitter and OldAnchor)
845
 
    NewNeighbour:=nil;
846
 
    for i:=0 to Neighbour.Parent.ControlCount-1 do begin
847
 
      Sibling:=Neighbour.Parent.Controls[i];
848
 
      if Sibling=Neighbour then continue;
849
 
      if (not GetLazDockSplitter(Sibling,OppositeAnchor[Search],CurSplitter))
850
 
      or (CurSplitter<>Splitter) then continue;
851
 
      if (not GetLazDockSplitterOrParent(Splitter,OppositeAnchor[Side],CurAnchor))
852
 
      or (CurAnchor<>OldAnchor) then continue;
853
 
      // Neighbour control found
854
 
      NewNeighbour:=Sibling;
855
 
      break;
856
 
    end;
857
 
    if NewNeighbour=nil then exit;
858
 
    // check if this control is mentioned in Layout as Neighbour
859
 
    NodeName:=Manager.GetControlConfigName(NewNeighbour);
860
 
    if NodeName='' then exit;
861
 
    Node:=Layout.FindByName(NodeName,true);
862
 
    if Node=nil then exit;
863
 
    if CompareText(Node.Sides[OppositeAnchor[Side]],SplitterNode.Name)<>0 then
864
 
      exit;
865
 
    // success: NewNeighbour is a neighbour on the current form and in the Layout
866
 
    if Append then begin
867
 
      Neighbours.Add(Splitter);
868
 
      Neighbours.Add(NewNeighbour);
869
 
    end else begin
870
 
      Neighbours.Insert(0,Neighbour);
871
 
      Neighbours.Insert(0,Splitter);
872
 
    end;
873
 
    Result:=true;
874
 
  end;
875
 
 
876
 
var
877
 
  SelfNode: TLazDockConfigNode;
878
 
  SplitterNode: TLazDockConfigNode;
879
 
  NeighbourNode: TLazDockConfigNode;
880
 
  NeighbourControl: TControl;
881
 
  NewParent: TWinControl;
882
 
  Splitter: TLazDockSplitter;
883
 
  a: TAnchorKind;
884
 
  NewParentCreated: Boolean;
885
 
  SplitterSize: LongInt;
886
 
  i: Integer;
887
 
  Side2: TAnchorKind;
888
 
  Side3: TAnchorKind;
889
 
  Neighbours: TFPList;
890
 
  LeftTopNeighbour: TControl;
891
 
  RightBottomNeighbour: TControl;
892
 
begin
893
 
  Result:=false;
894
 
  DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter DockerName="',DockerName,'"']);
895
 
  SelfNode:=Layout.FindByName(DockerName,true);
896
 
  if SelfNode=nil then begin
897
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter SelfNode not found DockerName="',DockerName,'"']);
898
 
    exit;
899
 
  end;
900
 
  SplitterNode:=Layout.FindByName(SelfNode.Sides[Side]);
901
 
  if SplitterNode=nil then begin
902
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter SplitterNode not found "',SelfNode.Sides[Side],'"']);
903
 
    exit;
904
 
  end;
905
 
 
906
 
  // search one Neighbour
907
 
  NeighbourNode:=SplitterNode.FindNeighbour(OppositeAnchor[Side],false);
908
 
  if NeighbourNode=nil then begin
909
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourNode not found']);
910
 
    exit;
911
 
  end;
912
 
  NeighbourControl:=Manager.FindControlByDockerName(NeighbourNode.Name);
913
 
  if NeighbourControl=nil then begin
914
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourControl not found "',NeighbourNode.Name,'"']);
915
 
    exit;
916
 
  end;
917
 
  
918
 
  Neighbours:=nil;
919
 
  NewParent:=nil;
920
 
  try
921
 
    if NeighbourControl.Parent=nil then begin
922
 
      // NeighbourControl is a standalone control (e.g. an undocked form)
923
 
      // => create a new TLazDockForm and put both controls into it
924
 
      NewParent:=Manager.Manager.CreateForm;
925
 
      NewParentCreated:=true;
926
 
    end else begin
927
 
      // NeighbourControl is docked
928
 
      NewParent:=NeighbourControl.Parent;
929
 
      NewParentCreated:=false;
930
 
    end;
931
 
 
932
 
    NewParent.DisableAlign;
933
 
 
934
 
    // create a splitter
935
 
    Splitter:=TLazDockSplitter.Create(nil);
936
 
    Splitter.Align:=alNone;
937
 
    Splitter.Beveled:=true;
938
 
    Splitter.ResizeAnchor:=Side;
939
 
    Splitter.Parent:=NewParent;
940
 
    if Side in [akLeft,akRight] then
941
 
      SplitterSize:=Manager.Manager.GetSplitterWidth(Splitter)
942
 
    else
943
 
      SplitterSize:=Manager.Manager.GetSplitterHeight(Splitter);
944
 
    if Side in [akLeft,akRight] then
945
 
      Splitter.Width:=SplitterSize
946
 
    else
947
 
      Splitter.Height:=SplitterSize;
948
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter Splitter=',DbgSName(Splitter),' ',dbgs(Splitter.BoundsRect)]);
949
 
 
950
 
    if NewParentCreated then begin
951
 
      // resize NewParent to bounds of NeighbourControl
952
 
      if (NewParent is TCustomForm)
953
 
      and (NeighbourControl is TCustomForm) then;
954
 
        TCustomForm(NewParent).WindowState:=
955
 
                                      TCustomForm(NeighbourControl).WindowState;
956
 
      NewParent.BoundsRect:=NeighbourControl.BoundsRect;
957
 
      NeighbourControl.Parent:=NewParent;
958
 
      NeighbourControl.Align:=alNone;
959
 
    end;
960
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NewParent=',DbgSName(NewParent),' ',dbgs(NewParent.BoundsRect)]);
961
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourControl=',DbgSName(NeighbourControl),' ',dbgs(NeighbourControl.BoundsRect)]);
962
 
 
963
 
    // move Control to the new parent
964
 
    Control.Parent:=NewParent;
965
 
    Control.Align:=alNone;
966
 
    Control.BoundsRect:=SelfNode.Bounds;
967
 
    DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter Control=',DbgSName(Control),' ',dbgs(Control.BoundsRect)]);
968
 
 
969
 
    if NewParentCreated then begin
970
 
      // one Neighbour, one splitter and the Control
971
 
      for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
972
 
        // anchor Control
973
 
        if a=Side then
974
 
          Control.AnchorToNeighbour(a,0,Splitter)
975
 
        else
976
 
          Control.AnchorParallel(a,0,NewParent);
977
 
        // anchor Splitter
978
 
        if (Side in [akLeft,akRight]) <> (a in [akLeft,akRight]) then
979
 
          Splitter.AnchorParallel(a,0,NewParent);
980
 
        // anchor Neighbour
981
 
        if a=OppositeAnchor[Side] then
982
 
          NeighbourControl.AnchorToNeighbour(a,0,Splitter)
983
 
        else
984
 
          NeighbourControl.AnchorParallel(a,0,NewParent);
985
 
      end;
986
 
    end else begin
987
 
      // several Neighbours
988
 
 
989
 
      // find all Neighbours
990
 
      Neighbours:=TFPList.Create;
991
 
      Neighbours.Add(NeighbourControl);
992
 
      while FindNextNeighbour(SplitterNode,Neighbours,false) do ;
993
 
      while FindNextNeighbour(SplitterNode,Neighbours,true) do ;
994
 
      // Neighbours now contains all controls, that need to be reanchored
995
 
      // to the new Splitter
996
 
 
997
 
      if Side in [akLeft,akRight] then
998
 
        Side2:=akTop
999
 
      else
1000
 
        Side2:=akLeft;
1001
 
      Side3:=OppositeAnchor[Side2];
1002
 
      LeftTopNeighbour:=TControl(Neighbours[0]);
1003
 
      RightBottomNeighbour:=TControl(Neighbours[Neighbours.Count-1]);
1004
 
 
1005
 
      // anchor Control
1006
 
      Control.AnchorToNeighbour(Side,0,Splitter);
1007
 
      Control.AnchorSame(OppositeAnchor[Side],NeighbourControl);
1008
 
      Control.AnchorSame(Side2,LeftTopNeighbour);
1009
 
      Control.AnchorSame(Side3,RightBottomNeighbour);
1010
 
      
1011
 
      // anchor Splitter
1012
 
      Splitter.AnchorSame(Side2,LeftTopNeighbour);
1013
 
      Splitter.AnchorSame(Side3,RightBottomNeighbour);
1014
 
 
1015
 
      // anchor Neighbours
1016
 
      for i:=0 to Neighbours.Count-1 do begin
1017
 
        NeighbourControl:=TControl(Neighbours[i]);
1018
 
        DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourControl=',DbgSName(NeighbourControl),' i=',i]);
1019
 
        NeighbourControl.AnchorToNeighbour(OppositeAnchor[Side],0,Splitter);
1020
 
      end;
1021
 
    end;
1022
 
 
1023
 
    if Side in [akLeft,akRight] then
1024
 
      ShrinkNeighbourhood(Layout,Control,[akLeft,akRight])
1025
 
    else
1026
 
      ShrinkNeighbourhood(Layout,Control,[akTop,akBottom]);
1027
 
    FixControlBounds(Layout,Control);
1028
 
    Manager.Manager.UpdateTitlePosition(Control);
1029
 
 
1030
 
  finally
1031
 
    Neighbours.Free;
1032
 
    if NewParent<>nil then begin
1033
 
      NewParent.EnableAlign;
1034
 
      NewParent.Visible:=true;
1035
 
    end;
1036
 
  end;
1037
 
 
1038
 
  Result:=true;
1039
 
end;
1040
 
 
1041
 
function TCustomLazControlDocker.DockAsPage(Layout: TLazDockConfigNode
1042
 
  ): boolean;
1043
 
// dock as page like in Layout
1044
 
// Requirements: Parent in Layout is a ldcntPage and a parent control exists.
1045
 
var
1046
 
  SelfNode: TLazDockConfigNode;
1047
 
  PageNode: TLazDockConfigNode;
1048
 
  PageNodeIndex: LongInt;
1049
 
  PagesNode: TLazDockConfigNode;
1050
 
  NeighbourNode: TLazDockConfigNode;
1051
 
  NeighbourControl: TControl;
1052
 
  TopForm: TLazDockForm;
1053
 
  Pages: TLazDockPages;
1054
 
  NeighbourPage: TLazDockPage;
1055
 
  NeighbourControlPageIndex: LongInt;
1056
 
  Page: TLazDockPage;
1057
 
  PageIndex: LongInt;
1058
 
  NeighbourList: TFPList;
1059
 
  AnchorControls: TAnchorControlsRect;
1060
 
  TopFormBounds: TRect;
1061
 
  i: Integer;
1062
 
  a: TAnchorKind;
1063
 
begin
1064
 
  Result:=false;
1065
 
  DebugLn(['TCustomLazControlDocker.DockAsPage DockerName="',DockerName,'"']);
1066
 
  SelfNode:=Layout.FindByName(DockerName,true);
1067
 
  if SelfNode=nil then begin
1068
 
    DebugLn(['TCustomLazControlDocker.DockAsPage SelfNode not found DockerName="',DockerName,'"']);
1069
 
    exit;
1070
 
  end;
1071
 
  PageNode:=SelfNode.Parent;
1072
 
  if PageNode=nil then begin
1073
 
    DebugLn(['TCustomLazControlDocker.DockAsPage SelfNode.Parent=nil DockerName="',DockerName,'"']);
1074
 
    exit;
1075
 
  end;
1076
 
  if PageNode.TheType<>ldcntPage then begin
1077
 
    DebugLn(['TCustomLazControlDocker.DockAsPage PageNode.TheType<>ldcntPage DockerName="',DockerName,'"']);
1078
 
    exit;
1079
 
  end;
1080
 
  if PageNode.ChildCount<>1 then begin
1081
 
    DebugLn(['TCustomLazControlDocker.DockAsPage PageNode.ChildCount<>1 DockerName="',DockerName,'"']);
1082
 
    exit;
1083
 
  end;
1084
 
  
1085
 
  PagesNode:=PageNode.Parent;
1086
 
  PageNodeIndex:=PagesNode.IndexOf(PageNode.Name);
1087
 
  if PageNodeIndex>0 then
1088
 
    NeighbourNode:=PagesNode.Children[PageNodeIndex-1].Children[0]
1089
 
  else
1090
 
    NeighbourNode:=PagesNode.Children[PageNodeIndex+1].Children[0];
1091
 
  NeighbourControl:=Manager.FindControlByDockerName(NeighbourNode.Name);
1092
 
  if NeighbourControl=nil then begin
1093
 
    DebugLn(['TCustomLazControlDocker.DockAsPage NeighbourControl not found "',NeighbourNode.Name,'"']);
1094
 
    exit;
1095
 
  end;
1096
 
  
1097
 
  if NeighbourControl.Parent=nil then begin
1098
 
    // NeighbourControl is a top level control (no parents, no neighbours)
1099
 
    // => create a TLazDockForm with a TLazDockPages and two TLazDockPage
1100
 
    TopForm:=Manager.Manager.CreateForm;
1101
 
    TopFormBounds:=PagesNode.Bounds;
1102
 
    // TODO: shrink TopFormBounds
1103
 
    TopForm.BoundsRect:=TopFormBounds;
1104
 
    
1105
 
    Pages:=TLazDockPages.Create(nil);
1106
 
    Pages.DisableAlign;
1107
 
    try
1108
 
      Pages.Parent:=TopForm;
1109
 
      Pages.AnchorClient(0);
1110
 
      if PageNodeIndex>0 then begin
1111
 
        Pages.Pages.Add(NeighbourControl.Caption);
1112
 
        Pages.Pages.Add(Control.Caption);
1113
 
        NeighbourPage:=Pages.Page[0];
1114
 
        Page:=Pages.Page[1];
1115
 
      end else begin
1116
 
        Pages.Pages.Add(Control.Caption);
1117
 
        Pages.Pages.Add(NeighbourControl.Caption);
1118
 
        Page:=Pages.Page[0];
1119
 
        NeighbourPage:=Pages.Page[1];
1120
 
      end;
1121
 
      NeighbourControl.Parent:=NeighbourPage;
1122
 
      NeighbourControl.AnchorClient(0);
1123
 
      Control.Parent:=Page;
1124
 
      Control.AnchorClient(0);
1125
 
    finally
1126
 
      Pages.EnableAlign;
1127
 
    end;
1128
 
  end else if NeighbourControl.Parent is TLazDockPage then begin
1129
 
    // NeighbourControl is on a page
1130
 
    // => insert a new page
1131
 
    NeighbourPage:=TLazDockPage(NeighbourControl.Parent);
1132
 
    NeighbourControlPageIndex:=NeighbourPage.PageIndex;
1133
 
    if PageNodeIndex>0 then begin
1134
 
      // insert left
1135
 
      PageIndex:=NeighbourControlPageIndex;
1136
 
    end else begin
1137
 
      // insert right
1138
 
      PageIndex:=NeighbourControlPageIndex+1;
1139
 
    end;
1140
 
    Pages.Pages.Insert(PageIndex,Control.Caption);
1141
 
    Page:=Pages.Page[PageIndex];
1142
 
    Control.Parent:=Page;
1143
 
    Control.AnchorClient(0);
1144
 
    // TODO enlarge parents
1145
 
  end else begin
1146
 
    // NeighbourControl is a child control, but the parent is not yet a page
1147
 
    // => collect a rectangular area of neighbour controls to build a page
1148
 
    NeighbourList:=FindPageNeighbours(Layout,NeighbourControl,AnchorControls);
1149
 
    try
1150
 
      NeighbourControl.Parent.DisableAlign;
1151
 
      // TODO: create a PageControl and two pages. And move the neighbours onto
1152
 
      // one page and Control to the other page.
1153
 
      
1154
 
      // create a TLazDockPages
1155
 
      Pages:=TLazDockPages.Create(nil);
1156
 
      // add it to the place where the neighbours are
1157
 
      Pages.Parent:=NeighbourControl.Parent;
1158
 
      for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
1159
 
        Pages.AnchorSide[a].Control:=AnchorControls[a];
1160
 
        if (AnchorControls[a]=Pages.Parent)=(a in [akLeft,akTop]) then
1161
 
          Pages.AnchorSide[a].Side:=asrLeft
1162
 
        else
1163
 
          Pages.AnchorSide[a].Side:=asrRight;
1164
 
      end;
1165
 
      Pages.Anchors:=[akLeft,akTop,akRight,akBottom];
1166
 
      
1167
 
      // create the two pages
1168
 
      Pages.Pages.Insert(0,NeighbourControl.Caption);
1169
 
      NeighbourPage:=Pages.Page[0];
1170
 
 
1171
 
      // move the neighbours
1172
 
      for i:=0 to NeighbourList.Count-1 do begin
1173
 
        NeighbourControl:=TControl(NeighbourList[i]);
1174
 
        NeighbourControl.Parent:=NeighbourPage;
1175
 
        // fix anchors
1176
 
        for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
1177
 
          if NeighbourControl.AnchorSide[a].Control=AnchorControls[a] then begin
1178
 
            NeighbourControl.AnchorSide[a].Control:=NeighbourPage;
1179
 
            if a in [akLeft,akTop] then
1180
 
              NeighbourControl.AnchorSide[a].Side:=asrLeft;
1181
 
          end;
1182
 
        end;
1183
 
      end;
1184
 
      
1185
 
      // add a second page
1186
 
      PageIndex:=1;
1187
 
      Pages.Pages.Insert(PageIndex,Control.Caption);
1188
 
      Page:=Pages.Page[PageIndex];
1189
 
      
1190
 
      // add the control into the second page
1191
 
      Control.Parent:=Page;
1192
 
      Control.AnchorClient(0);
1193
 
 
1194
 
    finally
1195
 
      NeighbourList.Free;
1196
 
      NeighbourControl.Parent.EnableAlign;
1197
 
    end;
1198
 
  end;
1199
 
 
1200
 
  Result:=true;
1201
 
end;
1202
 
 
1203
 
procedure TCustomLazControlDocker.FixControlBounds(Layout: TLazDockConfigNode;
1204
 
  ResizedControl: TControl);
1205
 
{ Fix bounds after inserting AddedControl }
1206
 
type
1207
 
  TControlInfo = record
1208
 
    Control: TControl;
1209
 
    Docker: TLazDockerConfig;
1210
 
    Node: TLazDockConfigNode;
1211
 
    MinLeft: integer;
1212
 
    MinLeftValid: boolean;
1213
 
    MinLeftCalculating: boolean;
1214
 
    MinTop: integer;
1215
 
    MinTopValid: boolean;
1216
 
    MinTopCalculating: boolean;
1217
 
    MinClientSize: TPoint;
1218
 
    MinClientSizeValid: boolean;
1219
 
  end;
1220
 
  PControlInfo = ^TControlInfo;
1221
 
var
1222
 
  ControlToInfo: TPointerToPointerTree;
1223
 
  NodeToInfo: TPointerToPointerTree;
1224
 
 
1225
 
  procedure InitInfos;
1226
 
  begin
1227
 
    ControlToInfo:=TPointerToPointerTree.Create;
1228
 
    NodeToInfo:=TPointerToPointerTree.Create;
1229
 
  end;
1230
 
  
1231
 
  procedure FreeInfos;
1232
 
  var
1233
 
    AControlPtr: Pointer;
1234
 
    AnInfo: Pointer;
1235
 
    Info: PControlInfo;
1236
 
  begin
1237
 
    if ControlToInfo.GetFirst(AControlPtr,AnInfo) then begin
1238
 
      repeat
1239
 
        Info:=PControlInfo(AnInfo);
1240
 
        Dispose(Info);
1241
 
      until not ControlToInfo.GetNext(AControlPtr,AControlPtr,AnInfo);
1242
 
    end;
1243
 
    ControlToInfo.Free;
1244
 
    NodeToInfo.Free;
1245
 
  end;
1246
 
  
1247
 
  function GetInfo(AControl: TControl): PControlInfo;
1248
 
  begin
1249
 
    Result:=ControlToInfo[AControl];
1250
 
    if Result=nil then begin
1251
 
      New(Result);
1252
 
      FillChar(Result^,SizeOf(TControlInfo),0);
1253
 
      Result^.Control:=AControl;
1254
 
      Result^.Node:=
1255
 
                 Layout.FindByName(Manager.GetControlConfigName(AControl),true);
1256
 
      ControlToInfo[AControl]:=Result;
1257
 
      if ControlToInfo[AControl]<>Result then
1258
 
        RaiseGDBException('');
1259
 
    end;
1260
 
  end;
1261
 
  
1262
 
  function CalculateMinimumLeft(AControl: TControl): integer;
1263
 
  var
1264
 
    Info: PControlInfo;
1265
 
 
1266
 
    procedure Improve(Neighbour: TControl);
1267
 
    begin
1268
 
      if Neighbour=nil then exit;
1269
 
      if Neighbour.Parent<>AControl.Parent then exit;
1270
 
      //DebugLn(['Left Improve AControl=',DbgSName(AControl),' Neighbour=',DbgSName(Neighbour)]);
1271
 
      Info^.MinLeft:=Max(Info^.MinLeft,
1272
 
                         CalculateMinimumLeft(Neighbour)+Neighbour.Width);
1273
 
    end;
1274
 
 
1275
 
  var
1276
 
    i: Integer;
1277
 
    Sibling: TControl;
1278
 
  begin
1279
 
    Info:=GetInfo(AControl);
1280
 
    if not Info^.MinLeftValid then begin
1281
 
      //DebugLn(['CalculateMinimumLeft ',DbgSName(AControl)]);
1282
 
      if Info^.MinLeftCalculating then
1283
 
        raise Exception.Create('anchor circle (left)');
1284
 
      Info^.MinLeftCalculating:=true;
1285
 
      
1286
 
      Info^.MinLeft:=0;
1287
 
      if (akLeft in AControl.Anchors) then
1288
 
        Improve(AControl.AnchorSide[akLeft].Control);
1289
 
      if AControl.Parent<>nil then begin
1290
 
        for i:=0 to AControl.Parent.ControlCount-1 do begin
1291
 
          Sibling:=AControl.Parent.Controls[i];
1292
 
          if Sibling=AControl then continue;
1293
 
          if (akRight in Sibling.Anchors)
1294
 
          and (Sibling.AnchorSide[akRight].Control=AControl) then
1295
 
            Improve(Sibling);
1296
 
        end;
1297
 
      end;
1298
 
      
1299
 
      Info^.MinLeftCalculating:=false;
1300
 
      Info^.MinLeftValid:=true;
1301
 
      //DebugLn(['CalculateMinimumLeft END ',DbgSName(AControl),' ',GetInfo(AControl)^.MinLeftValid]);
1302
 
    end;
1303
 
    Result:=Info^.MinLeft;
1304
 
  end;
1305
 
 
1306
 
  function CalculateMinimumTop(AControl: TControl): integer;
1307
 
  var
1308
 
    Info: PControlInfo;
1309
 
 
1310
 
    procedure Improve(Neighbour: TControl);
1311
 
    begin
1312
 
      if Neighbour=nil then exit;
1313
 
      if Neighbour.Parent<>AControl.Parent then exit;
1314
 
      Info^.MinTop:=Max(Info^.MinTop,
1315
 
                        CalculateMinimumTop(Neighbour)+Neighbour.Height);
1316
 
    end;
1317
 
 
1318
 
  var
1319
 
    i: Integer;
1320
 
    Sibling: TControl;
1321
 
  begin
1322
 
    Info:=GetInfo(AControl);
1323
 
    if not Info^.MinTopValid then begin
1324
 
      if Info^.MinTopCalculating then
1325
 
        raise Exception.Create('anchor circle (top)');
1326
 
      Info^.MinTopCalculating:=true;
1327
 
      
1328
 
      Info^.MinTop:=0;
1329
 
      if (akTop in AControl.Anchors) then
1330
 
        Improve(AControl.AnchorSide[akTop].Control);
1331
 
      if AControl.Parent<>nil then begin
1332
 
        for i:=0 to AControl.Parent.ControlCount-1 do begin
1333
 
          Sibling:=AControl.Parent.Controls[i];
1334
 
          if Sibling=AControl then continue;
1335
 
          if (akBottom in Sibling.Anchors)
1336
 
          and (Sibling.AnchorSide[akBottom].Control=AControl) then
1337
 
            Improve(Sibling);
1338
 
        end;
1339
 
      end;
1340
 
      
1341
 
      Info^.MinTopCalculating:=false;
1342
 
      Info^.MinTopValid:=true;
1343
 
    end;
1344
 
    Result:=Info^.MinTop;
1345
 
  end;
1346
 
 
1347
 
  function CalculateClientSize(AControl: TControl): TPoint;
1348
 
  var
1349
 
    AWinControl: TWinControl;
1350
 
    i: Integer;
1351
 
    ChildControl: TControl;
1352
 
  begin
1353
 
    Result:=Point(0,0);
1354
 
    if AControl is TWinControl then begin
1355
 
      AWinControl:=TWinControl(AControl);
1356
 
      for i:=0 to AWinControl.ControlCount-1 do begin
1357
 
        ChildControl:=AWinControl.Controls[i];
1358
 
        Result.X:=Max(Result.X,CalculateMinimumLeft(ChildControl)
1359
 
                               +ChildControl.Width);
1360
 
        Result.Y:=Max(Result.Y,CalculateMinimumTop(ChildControl)
1361
 
                               +ChildControl.Height);
1362
 
      end;
1363
 
    end;
1364
 
  end;
1365
 
  
1366
 
  procedure ApplyBounds(ParentClientWidth, ParentClientHeight: Integer);
1367
 
  var
1368
 
    i: Integer;
1369
 
    Sibling: TControl;
1370
 
    Info: PControlInfo;
1371
 
    NewRect: TRect;
1372
 
    OldRect: TRect;
1373
 
    SideControl: TControl;
1374
 
  begin
1375
 
    for i:=0 to ResizedControl.Parent.ControlCount-1 do begin
1376
 
      Sibling:=ResizedControl.Parent.Controls[i];
1377
 
      Info:=GetInfo(Sibling);
1378
 
      NewRect.Left:=Info^.MinLeft;
1379
 
      NewRect.Right:=NewRect.Left+Sibling.Width;
1380
 
      SideControl:=Sibling.AnchorSide[akRight].Control;
1381
 
      if (akRight in Sibling.Anchors) and (SideControl<>nil) then begin
1382
 
        if SideControl=ResizedControl.Parent then
1383
 
          NewRect.Right:=ParentClientWidth
1384
 
        else if SideControl.Parent=ResizedControl.Parent then
1385
 
          NewRect.Right:=CalculateMinimumLeft(SideControl);
1386
 
      end;
1387
 
      NewRect.Top:=Info^.MinTop;
1388
 
      NewRect.Bottom:=NewRect.Top+Sibling.Height;
1389
 
      SideControl:=Sibling.AnchorSide[akBottom].Control;
1390
 
      if (akBottom in Sibling.Anchors) and (SideControl<>nil) then begin
1391
 
        if SideControl=ResizedControl.Parent then
1392
 
          NewRect.Bottom:=ParentClientHeight
1393
 
        else if SideControl.Parent=ResizedControl.Parent then
1394
 
          NewRect.Bottom:=CalculateMinimumTop(SideControl);
1395
 
      end;
1396
 
      OldRect:=Sibling.BoundsRect;
1397
 
      if not CompareRect(@OldRect,@NewRect) then begin
1398
 
        DebugLn(['ApplyBounds Sibling=',DbgSName(Sibling),' NewRect=',dbgs(NewRect)]);
1399
 
        Sibling.BoundsRect:=NewRect;
1400
 
      end;
1401
 
    end;
1402
 
  end;
1403
 
 
1404
 
var
1405
 
  ParentSize: TPoint;
1406
 
  CurParent: TWinControl;
1407
 
  DiffWidth: Integer;
1408
 
  DiffHeight: Integer;
1409
 
  AlignDisabledControl: TWinControl;
1410
 
begin
1411
 
  DebugLn(['TCustomLazControlDocker.FixControlBounds ',DbgSName(ResizedControl)]);
1412
 
  CurParent:=ResizedControl.Parent;
1413
 
  if CurParent=nil then begin
1414
 
    DebugLn(['TCustomLazControlDocker.FixControlBounds WARNING: no parent']);
1415
 
    exit;
1416
 
  end;
1417
 
  CurParent.DisableAlign;
1418
 
  try
1419
 
    InitInfos;
1420
 
    // calculate minimum left, top, right, bottom of all siblings
1421
 
    ParentSize:=CalculateClientSize(CurParent);
1422
 
    DiffWidth:=ParentSize.X-CurParent.ClientWidth;
1423
 
    DiffHeight:=ParentSize.Y-CurParent.ClientHeight;
1424
 
    if (DiffWidth<>0) or (DiffHeight<>0) then begin
1425
 
      // parent needs resizing
1426
 
      DebugLn(['TCustomLazControlDocker.FixControlBounds Parent=',DbgSName(ResizedControl.Parent),' needs resizing to ',dbgs(ParentSize)]);
1427
 
      AlignDisabledControl:=CurParent.Parent;
1428
 
      if AlignDisabledControl<>nil then
1429
 
        AlignDisabledControl.DisableAlign;
1430
 
      try
1431
 
        CurParent.ClientWidth:=ParentSize.X;
1432
 
        CurParent.ClientHeight:=ParentSize.Y;
1433
 
        if CurParent.Parent<>nil then begin
1434
 
          // parent is a child
1435
 
          // => resize parent and fix the position recursively
1436
 
          FixControlBounds(Layout,CurParent);
1437
 
        end else begin
1438
 
          // parent is a free form
1439
 
          // => decide where to move the form on the screen using the Layout
1440
 
          
1441
 
          // TODO
1442
 
          DebugLn(['TCustomLazControlDocker.FixControlBounds TODO move parent ',DbgSName(CurParent)]);
1443
 
        end;
1444
 
      finally
1445
 
        if AlignDisabledControl<>nil then
1446
 
          AlignDisabledControl.EnableAlign;
1447
 
      end;
1448
 
    end;
1449
 
    ApplyBounds(ParentSize.X,ParentSize.Y);
1450
 
  finally
1451
 
    FreeInfos;
1452
 
    CurParent.EnableAlign;
1453
 
  end;
1454
 
end;
1455
 
 
1456
 
procedure TCustomLazControlDocker.ShrinkNeighbourhood(
1457
 
  Layout: TLazDockConfigNode; AControl: TControl; Sides: TAnchors);
1458
 
{ shrink neighbour controls according to Layout
1459
 
  A neighbour is the first control left or top of AControl, that can be shrinked
1460
 
  and is only anchored to AControl.
1461
 
}
1462
 
  procedure ShrinkControl(CurControl: TControl; Side: TAnchorKind); forward;
1463
 
 
1464
 
  procedure ShrinkNeighboursOnSide(CurControl: TControl; Side: TAnchorKind);
1465
 
  // shrink all controls, that are anchored on Side of CurControl
1466
 
  var
1467
 
    Neighbour: TControl;
1468
 
    i: Integer;
1469
 
  begin
1470
 
    DebugLn(['ShrinkNeighboursOnSide START ',DbgSName(CurControl),' ',AnchorNames[Side]]);
1471
 
    if Side in CurControl.Anchors then begin
1472
 
      Neighbour:=CurControl.AnchorSide[Side].Control;
1473
 
      DebugLn(['ShrinkNeighboursOnSide Neighbour=',DbgSName(Neighbour)]);
1474
 
      ShrinkControl(Neighbour,Side);
1475
 
    end;
1476
 
    for i:=0 to CurControl.Parent.ControlCount-1 do begin
1477
 
      Neighbour:=CurControl.Parent.Controls[i];
1478
 
      if (OppositeAnchor[Side] in Neighbour.Anchors)
1479
 
      and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=CurControl)
1480
 
      then
1481
 
        ShrinkControl(Neighbour,Side);
1482
 
    end;
1483
 
  end;
1484
 
  
1485
 
  procedure ShrinkControl(CurControl: TControl; Side: TAnchorKind);
1486
 
  var
1487
 
    NodeName: String;
1488
 
    Node: TLazDockConfigNode;
1489
 
    CurBounds: TRect;
1490
 
  begin
1491
 
    DebugLn(['ShrinkControl START ',DbgSName(CurControl),' Side=',AnchorNames[Side]]);
1492
 
    if (CurControl=nil) or (CurControl=AControl)
1493
 
    or (CurControl.Parent<>AControl.Parent) then
1494
 
      exit;
1495
 
    if CurControl is TCustomSplitter then begin
1496
 
      // a splitter can not be shrinked
1497
 
      // => try to shrink the controls on the other side of the splitter
1498
 
      ShrinkNeighboursOnSide(CurControl,Side);
1499
 
      exit;
1500
 
    end;
1501
 
    // shrink according to Layout
1502
 
    NodeName:=Manager.GetControlConfigName(CurControl);
1503
 
    if NodeName='' then exit;
1504
 
    Node:=Layout.FindByName(NodeName,true);
1505
 
    if Node=nil then exit;
1506
 
    CurBounds:=Node.Bounds;
1507
 
    DebugLn(['ShrinkControl ',DbgSName(CurControl),' Side=',AnchorNames[Side],' LayoutBounds=',dbgs(CurBounds)]);
1508
 
    if Side in [akLeft,akRight] then
1509
 
      CurControl.Width:=Min(CurControl.Width,CurBounds.Right-CurBounds.Left)
1510
 
    else
1511
 
      CurControl.Height:=Min(CurControl.Height,CurBounds.Bottom-CurBounds.Top);
1512
 
  end;
1513
 
 
1514
 
var
1515
 
  a: TAnchorKind;
1516
 
begin
1517
 
  DebugLn(['TCustomLazControlDocker.ShrinkNeighbourhood AControl=',DbgSName(AControl)]);
1518
 
  AControl.Parent.DisableAlign;
1519
 
  try
1520
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do
1521
 
      if a in Sides then
1522
 
        ShrinkNeighboursOnSide(AControl,a);
1523
 
  finally
1524
 
    AControl.Parent.EnableAlign;
1525
 
  end;
1526
 
end;
1527
 
 
1528
 
function TCustomLazControlDocker.FindPageNeighbours(Layout: TLazDockConfigNode;
1529
 
  StartControl: TControl; out AnchorControls: TAnchorControlsRect): TFPList;
1530
 
{ Creates a list of TControl, containing StartControl and neighbours,
1531
 
  which are on the same page according to Layout and are a rectangular area.
1532
 
  AnchorControls are the four boundaries of the rectangular area and the list
1533
 
  contains all controls within these boundaries (and with the same Parent as
1534
 
  StartControl).
1535
 
}
1536
 
type
1537
 
  TPageCompatibility = (pcUnknown, pcNotOnSamePage, pcSamePage);
1538
 
var
1539
 
  ControlList: TFPList;
1540
 
  PageNode: TLazDockConfigNode;
1541
 
  Parent: TWinControl;
1542
 
  Compatibility: array of TPageCompatibility;
1543
 
 
1544
 
  procedure InitCompatibility;
1545
 
  var
1546
 
    i: Integer;
1547
 
    AControl: TControl;
1548
 
    NodeName: String;
1549
 
    Node: TLazDockConfigNode;
1550
 
  begin
1551
 
    // check all siblings if the Layout knows them
1552
 
    SetLength(Compatibility,Parent.ControlCount);
1553
 
    for i:=0 to Parent.ControlCount-1 do begin
1554
 
      Compatibility[i]:=pcUnknown;
1555
 
      AControl:=Parent.Controls[i];
1556
 
      if AControl is TLazDockSplitter then continue;
1557
 
      NodeName:=Manager.GetControlConfigName(AControl);
1558
 
      if NodeName='' then continue;
1559
 
      Node:=Layout.FindByName(NodeName,true);
1560
 
      if Node<>nil then begin
1561
 
        if Node.Parent=PageNode then
1562
 
          Compatibility[i]:=pcSamePage
1563
 
        else
1564
 
          Compatibility[i]:=pcNotOnSamePage;
1565
 
      end;
1566
 
    end;
1567
 
  end;
1568
 
  
1569
 
  function CheckSolution(Candidates: TFPList): boolean;
1570
 
  var
1571
 
    ARect: TAnchorControlsRect;
1572
 
    AllList: TFPList;
1573
 
    i: Integer;
1574
 
    Index: LongInt;
1575
 
  begin
1576
 
    Result:=false;
1577
 
    // find the minimum rectangle around the current selection
1578
 
    if not GetEnclosingControlRect(Candidates,ARect) then exit;
1579
 
    // get the controls in the rectangle
1580
 
    AllList:=GetEnclosedControls(ARect);
1581
 
    try
1582
 
      for i:=0 to AllList.Count-1 do begin
1583
 
        Index:=Parent.GetControlIndex(TControl(AllList[i]));
1584
 
        if Index<0 then exit(false);
1585
 
        if Compatibility[Index]=pcNotOnSamePage then exit(false);
1586
 
      end;
1587
 
      // AllList fits => use it as solution
1588
 
      ControlList.Assign(AllList);
1589
 
      AnchorControls:=ARect;
1590
 
      Result:=true;
1591
 
    finally
1592
 
      AllList.Free;
1593
 
    end;
1594
 
  end;
1595
 
  
1596
 
  function TryLayoutSolution: boolean;
1597
 
  // check if a 1:1 of the layout is possible
1598
 
  var
1599
 
    i: Integer;
1600
 
  begin
1601
 
    ControlList.Clear;
1602
 
    for i:=0 to Parent.ControlCount-1 do begin
1603
 
      if Compatibility[i]=pcSamePage then
1604
 
        ControlList.Add(Parent.Controls[i]);
1605
 
    end;
1606
 
    Result:=CheckSolution(ControlList);
1607
 
  end;
1608
 
  
1609
 
  procedure TrySubsets;
1610
 
  // add controls to the selection
1611
 
  var
1612
 
    List: TFPList;
1613
 
    i: Integer;
1614
 
  begin
1615
 
    List:=TFPList.Create;
1616
 
    List.Add(StartControl);
1617
 
    CheckSolution(List);
1618
 
    i:=0;
1619
 
    repeat
1620
 
      // add on more control to the selection
1621
 
      if Compatibility[i]=pcSamePage then begin
1622
 
        List.Add(Parent.Controls[i]);
1623
 
        if not CheckSolution(List) then
1624
 
          List.Remove(Parent.Controls[i]);
1625
 
      end;
1626
 
      inc(i);
1627
 
    until false;
1628
 
    List.Free;
1629
 
  end;
1630
 
  
1631
 
var
1632
 
  StartNodeName: String;
1633
 
  StartNode: TLazDockConfigNode;
1634
 
  a: TAnchorKind;
1635
 
begin
1636
 
  // set defaults
1637
 
  ControlList:=TFPList.Create;
1638
 
  ControlList.Add(StartControl);
1639
 
  for a:=Low(TAnchorKind) to High(TAnchorKind) do
1640
 
    AnchorControls[a]:=StartControl.AnchorSide[a].Control;
1641
 
 
1642
 
  // check input
1643
 
  StartNodeName:=Manager.GetControlConfigName(StartControl);
1644
 
  if StartNodeName='' then exit;
1645
 
  StartNode:=Layout.FindByName(StartNodeName,true);
1646
 
  if StartNode=nil then exit;
1647
 
  PageNode:=StartNode.Parent;
1648
 
  if PageNode=nil then exit;
1649
 
  
1650
 
  // init
1651
 
  Parent:=StartControl.Parent;
1652
 
  InitCompatibility;
1653
 
  
1654
 
  // try some possibilities
1655
 
  if (not TryLayoutSolution) then
1656
 
    TrySubsets;
1657
 
 
1658
 
  Result:=ControlList;
1659
 
end;
1660
 
 
1661
 
procedure TCustomLazControlDocker.Notification(AComponent: TComponent;
1662
 
  Operation: TOperation);
1663
 
var
1664
 
  Item: TLCDMenuItem;
1665
 
begin
1666
 
  inherited Notification(AComponent, Operation);
1667
 
  if Operation=opRemove then 
1668
 
  begin
1669
 
    Item := nil;
1670
 
    if AComponent=FControl then 
1671
 
    begin
1672
 
      if FControl.PopupMenu <> nil then
1673
 
        Item := FindLCDMenuItem(FControl.PopupMenu);
1674
 
      FControl.RemoveAllHandlersOfObject(Self);
1675
 
      FControl:=nil;
1676
 
    end;
1677
 
 
1678
 
    if (AComponent is TMenu) then
1679
 
      Item := FindLCDMenuItem(TMenu(AComponent));
1680
 
 
1681
 
    if (AComponent is TMenuItem) then
1682
 
      Item := FindLCDMenuItem(TMenu(AComponent));
1683
 
 
1684
 
    if Item <> nil then 
1685
 
    begin
1686
 
      FMenus.Remove(Item);
1687
 
      Item.Menu := nil;
1688
 
      if Item.Item <> AComponent then
1689
 
        FreeAndNil(Item.Item);
1690
 
      Item.Free;
1691
 
    end;
1692
 
  end;
1693
 
end;
1694
 
 
1695
 
function TCustomLazControlDocker.FindLCDMenuItem(AMenu: TMenu): TLCDMenuItem;
1696
 
var
1697
 
  i: Integer;
1698
 
begin
1699
 
  if (FMenus<>nil) and (AMenu<>nil) then
1700
 
    for i:=0 to FMenus.Count-1 do begin
1701
 
      Result:=TLCDMenuItem(FMenus[i]);
1702
 
      if Result.Menu=AMenu then exit;
1703
 
    end;
1704
 
  Result:=nil;
1705
 
end;
1706
 
 
1707
 
function TCustomLazControlDocker.FindLCDMenuItem(AMenuItem: TMenuItem
1708
 
  ): TLCDMenuItem;
1709
 
var
1710
 
  i: Integer;
1711
 
begin
1712
 
  if (FMenus<>nil) and (AMenuItem<>nil) then
1713
 
    for i:=0 to FMenus.Count-1 do begin
1714
 
      Result:=TLCDMenuItem(FMenus[i]);
1715
 
      if Result.Item=AMenuItem then exit;
1716
 
    end;
1717
 
  Result:=nil;
1718
 
end;
1719
 
 
1720
 
function TCustomLazControlDocker.GetControlName(AControl: TControl): string;
1721
 
var
1722
 
  i: Integer;
1723
 
begin
1724
 
  Result:=Manager.GetControlConfigName(AControl);
1725
 
  if Result='' then begin
1726
 
    if AControl=Control.Parent then
1727
 
      Result:=NonDockConfigNamePrefixes[ndcnParent]
1728
 
    else if AControl.Name<>'' then
1729
 
      Result:=NonDockConfigNamePrefixes[ndcnControlName]+AControl.Name
1730
 
    else if AControl.Parent<>nil then begin
1731
 
      i:=AControl.Parent.ControlCount-1;
1732
 
      while (i>=0) and (AControl.Parent.Controls[i]<>AControl) do dec(i);
1733
 
      Result:=NonDockConfigNamePrefixes[ndcnChildIndex]+IntToStr(i)+' '
1734
 
                   +AControl.ClassName;
1735
 
    end;
1736
 
  end;
1737
 
end;
1738
 
 
1739
 
procedure TCustomLazControlDocker.AddPopupMenu(Menu: TPopupMenu);
1740
 
var
1741
 
  LCDItem: TLCDMenuItem;
1742
 
begin
1743
 
  if FindLCDMenuItem(Menu)<>nil then exit;
1744
 
  if FMenus=nil then FMenus:=TFPList.Create;
1745
 
  LCDItem:=TLCDMenuItem.Create;
1746
 
  LCDItem.Menu:=Menu;
1747
 
  FMenus.Add(LCDItem);
1748
 
  Menu.FreeNotification(Self);
1749
 
  LCDItem.Item:=TMenuItem.Create(Self);
1750
 
  LCDItem.Item.Caption:=rsDocking;
1751
 
  LCDItem.Item.OnClick:=@PopupMenuItemClick;
1752
 
  Menu.Items.Add(LCDItem.Item);
1753
 
end;
1754
 
 
1755
 
procedure TCustomLazControlDocker.RemovePopupMenu(Menu: TPopupMenu);
1756
 
var
1757
 
  Item: TLCDMenuItem;
1758
 
begin
1759
 
  Item:=FindLCDMenuItem(Menu);
1760
 
  if Item=nil then exit;
1761
 
  FMenus.Remove(Item);
1762
 
  FreeAndNil(Item.Item);
1763
 
  Item.Menu:=nil;
1764
 
  Item.Free;
1765
 
end;
1766
 
 
1767
 
function TCustomLazControlDocker.GetLayoutFromControl: TLazDockConfigNode;
1768
 
 
1769
 
  procedure CopyChildsLayout(ParentNode: TLazDockConfigNode;
1770
 
    ParentNodeControl: TWinControl);
1771
 
  // saves for each child node the names of the anchor side controls
1772
 
  var
1773
 
    i: Integer;
1774
 
    ChildNode: TLazDockConfigNode;
1775
 
    ChildControl: TControl;
1776
 
    a: TAnchorKind;
1777
 
    ChildNames: TStringHashList;// name to control mapping
1778
 
    ChildName: String;
1779
 
    CurAnchorControl: TControl;
1780
 
    CurAnchorCtrlName: String;
1781
 
    CurAnchorNode: TLazDockConfigNode;
1782
 
  begin
1783
 
    ChildNames:=TStringHashList.Create(false);
1784
 
    try
1785
 
      // build mapping of name to control
1786
 
      ChildNames.Data[ParentNode.Name]:=ParentNodeControl;
1787
 
      for i:=0 to ParentNodeControl.ControlCount-1 do begin
1788
 
        ChildControl:=ParentNodeControl.Controls[i];
1789
 
        ChildName:=GetControlName(ChildControl);
1790
 
        if ChildName<>'' then
1791
 
          ChildNames.Data[ChildName]:=ChildControl;
1792
 
      end;
1793
 
      // build mapping control to node
1794
 
      
1795
 
      // set 'Sides'
1796
 
      for i:=0 to ParentNode.ChildCount-1 do begin
1797
 
        ChildNode:=ParentNode[i];
1798
 
        ChildControl:=TControl(ChildNames.Data[ChildNode.Name]);
1799
 
        if ChildControl=nil then continue;
1800
 
        for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
1801
 
          CurAnchorControl:=ChildControl.AnchorSide[a].Control;
1802
 
          if CurAnchorControl=nil then continue;
1803
 
          if CurAnchorControl=ParentNodeControl then
1804
 
            CurAnchorNode:=ParentNode
1805
 
          else begin
1806
 
            CurAnchorCtrlName:=GetControlName(CurAnchorControl);
1807
 
            CurAnchorNode:=ParentNode.FindByName(CurAnchorCtrlName);
1808
 
            if CurAnchorNode=nil then
1809
 
              RaiseGDBException('inconsistency');
1810
 
          end;
1811
 
          //DebugLn('CopyChildsLayout ',DbgSName(CurAnchorControl),' CurAnchorCtrlName="',CurAnchorCtrlName,'"');
1812
 
          ChildNode.Sides[a]:=CurAnchorNode.Name;
1813
 
        end;
1814
 
      end;
1815
 
    finally
1816
 
      ChildNames.Free;
1817
 
    end;
1818
 
  end;
1819
 
 
1820
 
  function AddNode(ParentNode: TLazDockConfigNode;
1821
 
    AControl: TControl): TLazDockConfigNode;
1822
 
  var
1823
 
    i: Integer;
1824
 
    CurChildControl: TControl;
1825
 
    NeedChildNodes: boolean;
1826
 
  begin
1827
 
    Result:=TLazDockConfigNode.Create(ParentNode,GetControlName(AControl));
1828
 
 
1829
 
    // The Type
1830
 
    if AControl is TLazDockSplitter then begin
1831
 
      if TLazDockSplitter(AControl).ResizeAnchor in [akLeft,akRight] then
1832
 
        Result.FTheType:=ldcntSplitterLeftRight
1833
 
      else
1834
 
        Result.FTheType:=ldcntSplitterUpDown;
1835
 
    end else if AControl is TLazDockForm then
1836
 
      Result.FTheType:=ldcntForm
1837
 
    else if AControl is TLazDockPages then
1838
 
      Result.FTheType:=ldcntPages
1839
 
    else if AControl is TLazDockPage then
1840
 
      Result.FTheType:=ldcntPage
1841
 
    else
1842
 
      Result.FTheType:=ldcntControl;
1843
 
 
1844
 
    // Bounds
1845
 
    Result.FBounds:=AControl.BoundsRect;
1846
 
    if AControl is TWinControl then
1847
 
      Result.FClientBounds:=TWinControl(AControl).GetChildsRect(false)
1848
 
    else
1849
 
      Result.FClientBounds:=Rect(0,0,Result.FBounds.Right-Result.FBounds.Left,
1850
 
                                 Result.FBounds.Bottom-Result.FBounds.Top);
1851
 
 
1852
 
    // windowstate
1853
 
    if AControl is TCustomForm then
1854
 
      Result.WindowState:=TCustomForm(AControl).WindowState;
1855
 
 
1856
 
    // Children
1857
 
    if (AControl is TWinControl) then begin
1858
 
      // check if children need nodes
1859
 
      NeedChildNodes:=(AControl is TLazDockPages)
1860
 
                   or (AControl is TLazDockPage);
1861
 
      if not NeedChildNodes then begin
1862
 
        for i:=0 to TWinControl(AControl).ControlCount-1 do begin
1863
 
          CurChildControl:=TWinControl(AControl).Controls[i];
1864
 
          if Manager.FindDockerByControl(CurChildControl,nil)<>nil then begin
1865
 
            NeedChildNodes:=true;
1866
 
            break;
1867
 
          end;
1868
 
        end;
1869
 
      end;
1870
 
      // add child nodes
1871
 
      if NeedChildNodes then begin
1872
 
        for i:=0 to TWinControl(AControl).ControlCount-1 do begin
1873
 
          CurChildControl:=TWinControl(AControl).Controls[i];
1874
 
          AddNode(Result,CurChildControl);
1875
 
        end;
1876
 
        for i:=0 to Result.ChildCount-1 do begin
1877
 
        end;
1878
 
      end;
1879
 
      CopyChildsLayout(Result,TWinControl(AControl));
1880
 
    end;
1881
 
  end;
1882
 
 
1883
 
var
1884
 
  RootControl: TControl;
1885
 
begin
1886
 
  if (Control=nil) or (Manager=nil) then exit(nil);
1887
 
  
1888
 
  RootControl:=Control;
1889
 
  while RootControl.Parent<>nil do
1890
 
    RootControl:=RootControl.Parent;
1891
 
  Result:=AddNode(nil,RootControl);
1892
 
end;
1893
 
 
1894
 
procedure TCustomLazControlDocker.SaveLayout;
1895
 
var
1896
 
  Layout: TLazDockConfigNode;
1897
 
begin
1898
 
  if Manager=nil then exit;
1899
 
  Layout:=GetLayoutFromControl;
1900
 
  if (Layout=nil) then exit;
1901
 
  Manager.AddOrReplaceConfig(DockerName,Layout);
1902
 
end;
1903
 
 
1904
 
procedure TCustomLazControlDocker.RestoreLayout;
1905
 
{ Goals of this algorithm:
1906
 
  - If a form is hidden and immediately shown again, the layout should be
1907
 
    restored 1:1.
1908
 
    That's why a TCustomLazControlDocker stores the complete layout on every
1909
 
    hide. And restores it on every show.
1910
 
  - If an application is closed and all dock forms are closed (in any order)
1911
 
    the layout should be restored on startup, when the forms
1912
 
    are created (in any order).
1913
 
    This is done by saving the layout before all forms are closed.
1914
 
 
1915
 
 
1916
 
  Example 1: Docking to a side.
1917
 
    
1918
 
    Current:
1919
 
    +---+
1920
 
    | A |
1921
 
    +---+
1922
 
    
1923
 
    Formerly:
1924
 
    +------------+
1925
 
    |+---+|+----+|
1926
 
    || A |||Self||
1927
 
    |+---+|+----+|
1928
 
    +------------+
1929
 
 
1930
 
    Then put A into a new TLazDockForm, add a splitter and Self.
1931
 
    
1932
 
 
1933
 
  Example 2: Docking in between
1934
 
  
1935
 
    Current:
1936
 
    +-----------+
1937
 
    |+---+|+---+|
1938
 
    || A ||| C ||
1939
 
    |+---+|+---+|
1940
 
    +-----------+
1941
 
 
1942
 
    Formerly:
1943
 
    +------------------+
1944
 
    |+---+|+----+|+---+|
1945
 
    || A |||Self||| C ||
1946
 
    |+---+|+----+|+---+|
1947
 
    +------------------+
1948
 
 
1949
 
    Then enlarge the parent of A and C, add a splitter and Self.
1950
 
    
1951
 
  Example:
1952
 
 
1953
 
    Formerly:
1954
 
    +-------------------------+
1955
 
    |+-----------------------+|
1956
 
    ||           A           ||
1957
 
    |+-----------------------+|
1958
 
    |=========================|
1959
 
    |+---+#+-----------+#+---+|
1960
 
    || D |#|           |#|   ||
1961
 
    |+---+#|           |#|   ||
1962
 
    |=====#|     B     |#| E ||
1963
 
    |+---+#|           |#|   ||
1964
 
    ||   |#|           |#|   ||
1965
 
    ||   |#+-----------+#+---+|
1966
 
    || F |#===================|
1967
 
    ||   |#+-----------------+|
1968
 
    ||   |#|        C        ||
1969
 
    |+---+#+-----------------+|
1970
 
    +-------------------------+
1971
 
 
1972
 
 
1973
 
    1. Showing A:
1974
 
    There is no other form yet, so just show it at the old position.
1975
 
    +-----------------------+
1976
 
    |           A           |
1977
 
    +-----------------------+
1978
 
 
1979
 
 
1980
 
    2. Showing B:
1981
 
    B is the bottom sibling of A. Put A into a new TLazDockForm, add a splitter,
1982
 
    enlarge B horizontally.
1983
 
 
1984
 
    +-------------------------+
1985
 
    |+-----------------------+|
1986
 
    ||           A           ||
1987
 
    |+-----------------------+|
1988
 
    |=========================|
1989
 
    |+-----------------------+|
1990
 
    ||                       ||
1991
 
    ||                       ||
1992
 
    ||           B           ||
1993
 
    ||                       ||
1994
 
    ||                       ||
1995
 
    |+-----------------------+|
1996
 
    +-------------------------+
1997
 
 
1998
 
 
1999
 
    3. Showing C:
2000
 
    C is the bottom sibling of B. Enlarge the parent vertically, add a splitter
2001
 
    and enlarge C horizontally.
2002
 
    
2003
 
    +-------------------------+
2004
 
    |+-----------------------+|
2005
 
    ||           A           ||
2006
 
    |+-----------------------+|
2007
 
    |=========================|
2008
 
    |+-----------------------+|
2009
 
    ||                       ||
2010
 
    ||                       ||
2011
 
    ||           B           ||
2012
 
    ||                       ||
2013
 
    ||                       ||
2014
 
    |+-----------------------+|
2015
 
    |=========================|
2016
 
    |+-----------------------+|
2017
 
    ||           C           ||
2018
 
    |+-----------------------+|
2019
 
    +-------------------------+
2020
 
 
2021
 
 
2022
 
    4. Showing D:
2023
 
    D is below of A, and left of B and C. Shrink B and C, add a splitter.
2024
 
    
2025
 
    +-------------------------+
2026
 
    |+-----------------------+|
2027
 
    ||           A           ||
2028
 
    |+-----------------------+|
2029
 
    |=========================|
2030
 
    |+---+#+-----------------+|
2031
 
    ||   |#|                 ||
2032
 
    ||   |#|                 ||
2033
 
    ||   |#|        B        ||
2034
 
    ||   |#|                 ||
2035
 
    || D |#|                 ||
2036
 
    ||   |#+-----------------+|
2037
 
    ||   |#===================|
2038
 
    ||   |#+-----------------+|
2039
 
    ||   |#|        C        ||
2040
 
    |+---+#+-----------------+|
2041
 
    +-------------------------+
2042
 
 
2043
 
 
2044
 
    5. Showing E:
2045
 
    Shrink B, add a splitter.
2046
 
    
2047
 
    +-------------------------+
2048
 
    |+-----------------------+|
2049
 
    ||           A           ||
2050
 
    |+-----------------------+|
2051
 
    |=========================|
2052
 
    |+---+#+-----------+#+---+|
2053
 
    ||   |#|           |#|   ||
2054
 
    ||   |#|           |#|   ||
2055
 
    ||   |#|     B     |#| E ||
2056
 
    ||   |#|           |#|   ||
2057
 
    || D |#|           |#|   ||
2058
 
    ||   |#+-----------+#+---+|
2059
 
    ||   |#===================|
2060
 
    ||   |#+-----------------+|
2061
 
    ||   |#|        C        ||
2062
 
    |+---+#+-----------------+|
2063
 
    +-------------------------+
2064
 
 
2065
 
 
2066
 
    6. Showing F:
2067
 
    Shrink D and add a splitter.
2068
 
 
2069
 
    +-------------------------+
2070
 
    |+-----------------------+|
2071
 
    ||           A           ||
2072
 
    |+-----------------------+|
2073
 
    |=========================|
2074
 
    |+---+#+-----------+#+---+|
2075
 
    || D |#|           |#|   ||
2076
 
    |+---+#|           |#|   ||
2077
 
    |=====#|     B     |#| E ||
2078
 
    |+---+#|           |#|   ||
2079
 
    ||   |#|           |#|   ||
2080
 
    ||   |#+-----------+#+---+|
2081
 
    || F |#===================|
2082
 
    ||   |#+-----------------+|
2083
 
    ||   |#|        C        ||
2084
 
    |+---+#+-----------------+|
2085
 
    +-------------------------+
2086
 
  }
2087
 
var
2088
 
  Layout: TLazDockConfigNode;
2089
 
  SelfNode: TLazDockConfigNode;
2090
 
  
2091
 
  function FindNode(const ANodeName: string): TLazDockConfigNode;
2092
 
  begin
2093
 
    if ANodeName='' then
2094
 
      Result:=nil
2095
 
    else
2096
 
      Result:=Layout.FindByName(ANodeName,true,true);
2097
 
  end;
2098
 
  
2099
 
  function FindControl(const ADockerName: string): TControl;
2100
 
  begin
2101
 
    Result:=Manager.FindControlByDockerName(ADockerName);
2102
 
  end;
2103
 
 
2104
 
  function DockWithSpiralSplitter: boolean;
2105
 
  begin
2106
 
    // TODO
2107
 
    Result:=false;
2108
 
  end;
2109
 
 
2110
 
  function SplitterDocking: boolean;
2111
 
  var
2112
 
    a: TAnchorKind;
2113
 
    SplitterCount: Integer;
2114
 
    SideNode: TLazDockConfigNode;
2115
 
  begin
2116
 
    Result:=false;
2117
 
    SplitterCount:=0;
2118
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
2119
 
      SideNode:=FindNode(SelfNode.Sides[a]);
2120
 
      if (SideNode<>nil)
2121
 
      and (SideNode.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown])
2122
 
      then begin
2123
 
        if SideNode.IsTheOnlyNeighbour(SelfNode,a)
2124
 
        and CreateFormAndDockWithSplitter(Layout,a) then
2125
 
          exit(true);
2126
 
        inc(SplitterCount);
2127
 
        if (SplitterCount=4) and DockWithSpiralSplitter then
2128
 
          exit(true);
2129
 
      end;
2130
 
    end;
2131
 
  end;
2132
 
  
2133
 
  function PageDocking: boolean;
2134
 
  begin
2135
 
    Result:=false;
2136
 
    if (SelfNode.TheType<>ldcntPage) then exit;
2137
 
    if (SelfNode.Parent.ChildCount<>1) then exit;
2138
 
    Result:=DockAsPage(Layout);
2139
 
  end;
2140
 
  
2141
 
var
2142
 
  NewBounds: TRect;
2143
 
begin
2144
 
  {$IFDEF VerboseAnchorDocking}
2145
 
  DebugLn(['TCustomLazControlDocker.RestoreLayout A ',DockerName,' Control=',DbgSName(Control)]);
2146
 
  {$ENDIF}
2147
 
  if (Manager=nil) or (Control=nil) then exit;
2148
 
  Layout:=nil;
2149
 
  try
2150
 
    Layout:=Manager.CreateLayout(DockerName,Control,false);
2151
 
    if (Layout=nil) then exit;
2152
 
    SelfNode:=Layout.FindByName(DockerName,true);
2153
 
    DebugLn(['TCustomLazControlDocker.RestoreLayout ',SelfNode<>nil,' DockerName=',DockerName]);
2154
 
    if (SelfNode=nil) or (SelfNode.TheType<>ldcntControl) then exit;
2155
 
 
2156
 
    if SelfNode.Parent<>nil then begin
2157
 
      // this control was docked
2158
 
      if SplitterDocking then exit;
2159
 
      if PageDocking then exit;
2160
 
    end;
2161
 
 
2162
 
    // default: do not dock, just move
2163
 
    DebugLn(['TCustomLazControlDocker.RestoreLayout ',DockerName,' not docking, just moving ...']);
2164
 
    NewBounds:=SelfNode.GetScreenBounds;
2165
 
    Control.SetBoundsKeepBase(NewBounds.Left,NewBounds.Top,
2166
 
                              NewBounds.Right-NewBounds.Left,
2167
 
                              NewBounds.Bottom-NewBounds.Top);
2168
 
    DebugLn(['TCustomLazControlDocker.RestoreLayout ',WindowStateToStr(Layout.WindowState),' Layout.Name=',Layout.Name]);
2169
 
    if (Control is TCustomForm) and (Control.Parent=nil) then
2170
 
      TCustomForm(Control).WindowState:=Layout.WindowState;
2171
 
  finally
2172
 
    DebugLn(['TCustomLazControlDocker.RestoreLayout END Control=',DbgSName(Control),' Control.BoundsRect=',dbgs(Control.BoundsRect)]);
2173
 
    Layout.Free;
2174
 
  end;
2175
 
end;
2176
 
 
2177
 
procedure TCustomLazControlDocker.DisableLayout;
2178
 
begin
2179
 
  inc(fLayoutLock);
2180
 
end;
2181
 
 
2182
 
procedure TCustomLazControlDocker.EnableLayout;
2183
 
begin
2184
 
  dec(fLayoutLock);
2185
 
end;
2186
 
 
2187
 
function TCustomLazControlDocker.ControlIsDocked: boolean;
2188
 
begin
2189
 
  Result:=(Control<>nil)
2190
 
      and (Control.Parent<>nil)
2191
 
      and ((Control.Parent is TLazDockForm) or (Control.Parent is TLazDockPage));
2192
 
end;
2193
 
 
2194
 
constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
2195
 
begin
2196
 
  inherited Create(TheOwner);
2197
 
  if (not (csLoading in ComponentState))
2198
 
  and (TheOwner is TControl) then
2199
 
    // use as default
2200
 
    Control:=TControl(TheOwner);
2201
 
  ExtendPopupMenu:=true;
2202
 
end;
2203
 
 
2204
 
destructor TCustomLazControlDocker.Destroy;
2205
 
var
2206
 
  i: integer;
2207
 
  Item: TLCDMenuItem;
2208
 
  OldMenus: TFPList;
2209
 
begin
2210
 
  Control:=nil;
2211
 
  Manager:=nil;
2212
 
  inherited Destroy;
2213
 
  if FMenus <> nil then begin
2214
 
    OldMenus:=FMenus;
2215
 
    FMenus:=nil;
2216
 
    for i := OldMenus.Count - 1 downto 0 do
2217
 
    begin
2218
 
      Item:=TLCDMenuItem(OldMenus[i]);
2219
 
      FreeAndNil(Item.Item);
2220
 
      Item.Free;
2221
 
    end;
2222
 
    OldMenus.Free;
2223
 
  end;
2224
 
end;
2225
 
 
2226
 
procedure TCustomLazControlDocker.PopupMenuItemClick(Sender: TObject);
2227
 
begin
2228
 
  ShowDockingEditor;
2229
 
end;
2230
 
 
2231
 
procedure TCustomLazControlDocker.SetControl(const AValue: TControl);
2232
 
var
2233
 
  WinControl: TWinControl;
2234
 
begin
2235
 
  if FControl=AValue then exit;
2236
 
  if FControl<>nil then begin
2237
 
    FControl.RemoveAllHandlersOfObject(Self);
2238
 
    FControl.RemoveFreeNotification(Self);
2239
 
    if (Manager<>nil) and (FControl is TWinControl) then
2240
 
    begin
2241
 
      WinControl:=TWinControl(FControl);
2242
 
      WinControl.UseDockManager:=false;
2243
 
      WinControl.DockManager:=nil;
2244
 
    end;
2245
 
  end;
2246
 
  FControl:=AValue;
2247
 
  if Control<>nil then begin
2248
 
    Control.AddHandlerOnVisibleChanging(@ControlVisibleChanging);
2249
 
    Control.AddHandlerOnVisibleChanged(@ControlVisibleChanged);
2250
 
    Control.FreeNotification(Self);
2251
 
    if (Manager<>nil) and (FControl is TWinControl) then
2252
 
    begin
2253
 
      WinControl:=TWinControl(FControl);
2254
 
      WinControl.DockManager:=Manager.Manager;
2255
 
      WinControl.UseDockManager:=true;
2256
 
    end;
2257
 
  end;
2258
 
  if (DockerName='') and (FControl<>nil) then
2259
 
    DockerName:=FControl.Name;
2260
 
  UpdatePopupMenu;
2261
 
end;
2262
 
 
2263
 
procedure TCustomLazControlDocker.SetDockerName(const AValue: string);
2264
 
var
2265
 
  NewDockerName: String;
2266
 
begin
2267
 
  if FDockerName=AValue then exit;
2268
 
  NewDockerName:=AValue;
2269
 
  if Manager<>nil then
2270
 
    NewDockerName:=Manager.CreateUniqueName(NewDockerName,Self);
2271
 
  FDockerName:=NewDockerName;
2272
 
end;
2273
 
 
2274
 
procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean);
2275
 
begin
2276
 
  if FExtendPopupMenu=AValue then exit;
2277
 
  FExtendPopupMenu:=AValue;
2278
 
  UpdatePopupMenu;
2279
 
end;
2280
 
 
2281
 
procedure TCustomLazControlDocker.SetLocalizedName(const AValue: string);
2282
 
begin
2283
 
  if FLocalizedName=AValue then exit;
2284
 
  FLocalizedName:=AValue;
2285
 
end;
2286
 
 
2287
 
{ TCustomLazDockingManager }
2288
 
 
2289
 
procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker);
2290
 
var
2291
 
  WinControl: TWinControl;
2292
 
begin
2293
 
  if Docker.Control is TWinControl then
2294
 
  begin
2295
 
    WinControl:=TWinControl(Docker.Control);
2296
 
    WinControl.UseDockManager:=false;
2297
 
    WinControl.DockManager:=nil;
2298
 
  end;
2299
 
  FDockers.Remove(Docker);
2300
 
end;
2301
 
 
2302
 
function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer;
2303
 
var
2304
 
  WinControl: TWinControl;
2305
 
begin
2306
 
  Docker.DockerName:=CreateUniqueName(Docker.DockerName,nil);
2307
 
  Result:=FDockers.Add(Docker);
2308
 
  if Docker.Control is TWinControl then
2309
 
  begin
2310
 
    WinControl:=TWinControl(Docker.Control);
2311
 
    WinControl.DockManager:=Manager;
2312
 
    WinControl.UseDockManager:=true;
2313
 
  end;
2314
 
end;
2315
 
 
2316
 
function TCustomLazDockingManager.GetDockers(Index: Integer
2317
 
  ): TCustomLazControlDocker;
2318
 
begin
2319
 
  Result:=TCustomLazControlDocker(FDockers[Index]);
2320
 
end;
2321
 
 
2322
 
function TCustomLazDockingManager.GetDockerCount: Integer;
2323
 
begin
2324
 
  Result:=FDockers.Count;
2325
 
end;
2326
 
 
2327
 
function TCustomLazDockingManager.GetConfigCount: Integer;
2328
 
begin
2329
 
  if FConfigs<>nil then
2330
 
    Result:=FConfigs.Count
2331
 
  else
2332
 
    Result:=0;
2333
 
end;
2334
 
 
2335
 
function TCustomLazDockingManager.GetConfigs(Index: Integer
2336
 
  ): TLazDockerConfig;
2337
 
begin
2338
 
  Result:=TLazDockerConfig(FConfigs[Index]);
2339
 
end;
2340
 
 
2341
 
constructor TCustomLazDockingManager.Create(TheOwner: TComponent);
2342
 
begin
2343
 
  inherited Create(TheOwner);
2344
 
  FDockers:=TFPList.Create;
2345
 
  FManager:=TAnchoredDockManager.Create(nil);
2346
 
  FManager.FConfigs:=Self;
2347
 
end;
2348
 
 
2349
 
destructor TCustomLazDockingManager.Destroy;
2350
 
var
2351
 
  i: Integer;
2352
 
begin
2353
 
  for i:=FDockers.Count-1 downto 0 do
2354
 
    Dockers[i].Manager:=nil;
2355
 
  FreeAndNil(FDockers);
2356
 
  FreeAndNil(FManager);
2357
 
  ClearConfigs;
2358
 
  FreeAndNil(FConfigs);
2359
 
  inherited Destroy;
2360
 
end;
2361
 
 
2362
 
function TCustomLazDockingManager.FindDockerByName(const ADockerName: string;
2363
 
  Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
2364
 
var
2365
 
  i: Integer;
2366
 
begin
2367
 
  i:=DockerCount-1;
2368
 
  while (i>=0) do begin
2369
 
    Result:=Dockers[i];
2370
 
    if (CompareText(Result.DockerName,ADockerName)=0) and (Ignore<>Result) then
2371
 
      exit;
2372
 
    dec(i);
2373
 
  end;
2374
 
  Result:=nil;
2375
 
end;
2376
 
 
2377
 
function TCustomLazDockingManager.FindControlByDockerName(
2378
 
  const ADockerName: string; Ignore: TCustomLazControlDocker): TControl;
2379
 
var
2380
 
  Docker: TCustomLazControlDocker;
2381
 
begin
2382
 
  Docker:=FindDockerByName(ADockerName);
2383
 
  if Docker=nil then
2384
 
    Result:=nil
2385
 
  else
2386
 
    Result:=Docker.Control;
2387
 
end;
2388
 
 
2389
 
function TCustomLazDockingManager.FindDockerByControl(AControl: TControl;
2390
 
  Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
2391
 
var
2392
 
  i: Integer;
2393
 
begin
2394
 
  i:=DockerCount-1;
2395
 
  while (i>=0) do begin
2396
 
    Result:=Dockers[i];
2397
 
    if (Result.Control=AControl) and (Ignore<>Result) then
2398
 
      exit;
2399
 
    dec(i);
2400
 
  end;
2401
 
  Result:=nil;
2402
 
end;
2403
 
 
2404
 
function TCustomLazDockingManager.CreateUniqueName(const AName: string;
2405
 
  Ignore: TCustomLazControlDocker): string;
2406
 
begin
2407
 
  Result:=AName;
2408
 
  if FindDockerByName(Result,Ignore)=nil then exit;
2409
 
  Result:=CreateFirstIdentifier(Result);
2410
 
  while FindDockerByName(Result,Ignore)<>nil do
2411
 
    Result:=CreateNextIdentifier(Result);
2412
 
end;
2413
 
 
2414
 
function TCustomLazDockingManager.GetControlConfigName(AControl: TControl
2415
 
  ): string;
2416
 
var
2417
 
  Docker: TCustomLazControlDocker;
2418
 
begin
2419
 
  Docker:=FindDockerByControl(AControl,nil);
2420
 
  if Docker<>nil then
2421
 
    Result:=Docker.DockerName
2422
 
  else
2423
 
    Result:='';
2424
 
end;
2425
 
 
2426
 
procedure TCustomLazDockingManager.DisableLayout(Control: TControl);
2427
 
var
2428
 
  Docker: TCustomLazControlDocker;
2429
 
begin
2430
 
  Docker:=FindDockerByControl(Control);
2431
 
  if Docker<>nil then
2432
 
    Docker.DisableLayout;
2433
 
end;
2434
 
 
2435
 
procedure TCustomLazDockingManager.EnableLayout(Control: TControl);
2436
 
var
2437
 
  Docker: TCustomLazControlDocker;
2438
 
begin
2439
 
  Docker:=FindDockerByControl(Control);
2440
 
  if Docker<>nil then
2441
 
    Docker.EnableLayout;
2442
 
end;
2443
 
 
2444
 
procedure TCustomLazDockingManager.SaveToConfig(Config: TConfigStorage;
2445
 
  const Path: string);
2446
 
var
2447
 
  i: Integer;
2448
 
  ADocker: TCustomLazControlDocker;
2449
 
  CurDockConfig: TLazDockerConfig;
2450
 
  SubPath: String;
2451
 
begin
2452
 
  // collect configs
2453
 
  for i:=0 to DockerCount-1 do begin
2454
 
    ADocker:=Dockers[i];
2455
 
    if ((ADocker.Control<>nil) and ADocker.Control.Visible) then begin
2456
 
      ADocker.SaveLayout;
2457
 
    end;
2458
 
  end;
2459
 
 
2460
 
  // save configs
2461
 
  Config.SetDeleteValue(Path+'Configs/Count',ConfigCount,0);
2462
 
  for i:=0 to ConfigCount-1 do begin
2463
 
    SubPath:=Path+'Config'+IntToStr(i)+'/';
2464
 
    CurDockConfig:=Configs[i];
2465
 
    Config.SetDeleteValue(SubPath+'DockerName/Value',CurDockConfig.DockerName,'');
2466
 
    CurDockConfig.Root.SaveToConfig(Config,SubPath);
2467
 
  end;
2468
 
end;
2469
 
 
2470
 
procedure TCustomLazDockingManager.LoadFromConfig(Config: TConfigStorage;
2471
 
  const Path: string);
2472
 
var
2473
 
  i: Integer;
2474
 
  NewConfigCount: LongInt;
2475
 
  SubPath: String;
2476
 
  NewRoot: TLazDockConfigNode;
2477
 
  NewDockerName: String;
2478
 
  NewRootName: String;
2479
 
begin
2480
 
  // merge the configs
2481
 
  NewConfigCount:=Config.GetValue(Path+'Configs/Count',0);
2482
 
  //DebugLn(['TCustomLazDockingManager.LoadFromConfig NewConfigCount=',NewConfigCount]);
2483
 
  for i:=0 to NewConfigCount-1 do begin
2484
 
    SubPath:=Path+'Config'+IntToStr(i)+'/';
2485
 
    NewDockerName:=Config.GetValue(SubPath+'DockerName/Value','');
2486
 
    if NewDockerName='' then continue;
2487
 
    NewRootName:=Config.GetValue(SubPath+'Name/Value','');
2488
 
    if NewRootName='' then continue;
2489
 
    //DebugLn(['TCustomLazDockingManager.LoadFromConfig NewDockerName=',NewDockerName,' NewRootName=',NewRootName]);
2490
 
    NewRoot:=TLazDockConfigNode.Create(nil,NewRootName);
2491
 
    NewRoot.LoadFromConfig(Config,SubPath);
2492
 
    AddOrReplaceConfig(NewDockerName,NewRoot);
2493
 
    //NewRoot.WriteDebugReport;
2494
 
  end;
2495
 
end;
2496
 
 
2497
 
procedure TCustomLazDockingManager.AddOrReplaceConfig(
2498
 
  const DockerName: string; Config: TLazDockConfigNode);
2499
 
var
2500
 
  i: Integer;
2501
 
  CurConfig: TLazDockerConfig;
2502
 
begin
2503
 
  if FConfigs=nil then
2504
 
    FConfigs:=TFPList.Create;
2505
 
  for i:=FConfigs.Count-1 downto 0 do begin
2506
 
    CurConfig:=Configs[i];
2507
 
    if CompareText(CurConfig.DockerName,DockerName)=0 then begin
2508
 
      CurConfig.FRoot.Free;
2509
 
      CurConfig.FRoot:=Config;
2510
 
      exit;
2511
 
    end;
2512
 
  end;
2513
 
  FConfigs.Add(TLazDockerConfig.Create(DockerName,Config));
2514
 
end;
2515
 
 
2516
 
procedure TCustomLazDockingManager.WriteDebugReport;
2517
 
var
2518
 
  i: Integer;
2519
 
  ADocker: TCustomLazControlDocker;
2520
 
begin
2521
 
  DebugLn('TCustomLazDockingManager.WriteDebugReport DockerCount=',dbgs(DockerCount));
2522
 
  for i:=0 to DockerCount-1 do begin
2523
 
    ADocker:=Dockers[i];
2524
 
    DebugLn('  ',dbgs(i),' Name="',ADocker.Name,'" DockerName="',ADocker.DockerName,'"');
2525
 
  end;
2526
 
end;
2527
 
 
2528
 
procedure TCustomLazDockingManager.ClearConfigs;
2529
 
var
2530
 
  i: Integer;
2531
 
begin
2532
 
  if FConfigs=nil then exit;
2533
 
  for i:=0 to FConfigs.Count-1 do TObject(FConfigs[i]).Free;
2534
 
  FConfigs.Clear;
2535
 
end;
2536
 
 
2537
 
function TCustomLazDockingManager.GetConfigWithDockerName(
2538
 
  const DockerName: string): TLazDockerConfig;
2539
 
var
2540
 
  i: Integer;
2541
 
begin
2542
 
  i:=ConfigCount-1;
2543
 
  while (i>=0) do begin
2544
 
    Result:=Configs[i];
2545
 
    if CompareText(Result.DockerName,DockerName)=0 then exit;
2546
 
    dec(i);
2547
 
  end;
2548
 
  Result:=nil;
2549
 
end;
2550
 
 
2551
 
function TCustomLazDockingManager.CreateLayout(const DockerName: string;
2552
 
  VisibleControl: TControl; ExceptionOnError: boolean): TLazDockConfigNode;
2553
 
// create a usable config
2554
 
// This means: search a config, create a copy
2555
 
// and remove all nodes without visible controls.
2556
 
{$DEFINE VerboseAnchorDockCreateLayout}
2557
 
var
2558
 
  Root: TLazDockConfigNode;
2559
 
  CurDockControl: TControl;
2560
 
 
2561
 
  function ControlIsVisible(AControl: TControl): boolean;
2562
 
  begin
2563
 
    Result:=false;
2564
 
    if (AControl=nil) then exit;
2565
 
    if (not AControl.IsVisible) and (AControl<>VisibleControl) then exit;
2566
 
    if (CurDockControl<>nil) and (CurDockControl<>AControl.GetTopParent) then
2567
 
      exit;
2568
 
    Result:=true;
2569
 
  end;
2570
 
  
2571
 
  function FindNode(const AName: string): TLazDockConfigNode;
2572
 
  begin
2573
 
    if AName='' then
2574
 
      Result:=nil
2575
 
    else
2576
 
      Result:=Root.FindByName(AName,true,true);
2577
 
  end;
2578
 
  
2579
 
  procedure DeleteNode(var DeletingNode: TLazDockConfigNode);
2580
 
  
2581
 
    function DeleteOwnSideSplitter(Side: TAnchorKind;
2582
 
      var SplitterNode: TLazDockConfigNode): boolean;
2583
 
    { check if DeletingNode has a splitter to Side, and this node is the only
2584
 
      node anchored to the splitter at this side.
2585
 
      If yes, it removes the splitter and the DeletingNode and reconnects the
2586
 
      nodes using the splitter with the opposite side
2587
 
      For example:
2588
 
        ---------+      --------+
2589
 
        --+#+---+|          ---+|
2590
 
        B |#|   ||           B ||
2591
 
        --+#|   ||          ---+|
2592
 
        ====| A ||  ->      ====|
2593
 
        --+#|   ||          ---+|
2594
 
        C |#|   ||           C ||
2595
 
        --+#+---+|          ---+|
2596
 
        ---------+      --------+
2597
 
    }
2598
 
    var
2599
 
      i: Integer;
2600
 
      Sibling: TLazDockConfigNode;
2601
 
      OppositeSide: TAnchorKind;
2602
 
    begin
2603
 
      Result:=false;
2604
 
      // check if this is the only node using this Side of the splitter
2605
 
      if not SplitterNode.IsTheOnlyNeighbour(DeletingNode,Side) then
2606
 
        exit;
2607
 
 
2608
 
      // All nodes, that uses the splitter from the other side will now be
2609
 
      // anchored to the other side of DeletingNode
2610
 
      OppositeSide:=OppositeAnchor[Side];
2611
 
      for i:=0 to DeletingNode.Parent.ChildCount-1 do begin
2612
 
        Sibling:=DeletingNode.Parent.Children[i];
2613
 
        if CompareText(Sibling.Sides[OppositeSide],SplitterNode.Name)=0 then
2614
 
          Sibling.Sides[OppositeSide]:=DeletingNode.Sides[OppositeSide];
2615
 
      end;
2616
 
      
2617
 
      // delete splitter
2618
 
      FreeAndNil(SplitterNode);
2619
 
 
2620
 
      Result:=true;
2621
 
    end;
2622
 
    
2623
 
    function UnbindSpiralNode: boolean;
2624
 
    { DeletingNode has 4 splitters like a spiral.
2625
 
      In this case merge the two vertical splitters.
2626
 
      For example:
2627
 
             |             |
2628
 
      -------|        -----|
2629
 
       |+---+|             |
2630
 
       || A ||   ->        |
2631
 
       |+---+|             |
2632
 
       |--------           |------
2633
 
       |                   |
2634
 
    }
2635
 
    var
2636
 
      LeftSplitter: TLazDockConfigNode;
2637
 
      RightSplitter: TLazDockConfigNode;
2638
 
      i: Integer;
2639
 
      Sibling: TLazDockConfigNode;
2640
 
    begin
2641
 
      LeftSplitter:=FindNode(DeletingNode.Sides[akLeft]);
2642
 
      RightSplitter:=FindNode(DeletingNode.Sides[akRight]);
2643
 
      // remove LeftSplitter
2644
 
      
2645
 
      // 1. enlarge RightSplitter
2646
 
      if CompareText(RightSplitter.Sides[akTop],DeletingNode.Sides[akTop])=0 then
2647
 
        RightSplitter.Sides[akTop]:=LeftSplitter.Sides[akTop];
2648
 
      if CompareText(RightSplitter.Sides[akBottom],DeletingNode.Sides[akBottom])=0 then
2649
 
        RightSplitter.Sides[akBottom]:=LeftSplitter.Sides[akBottom];
2650
 
        
2651
 
      // 2. anchor all siblings using LeftSplitter to now use RightSplitter
2652
 
      for i:=0 to DeletingNode.Parent.ChildCount-1 do begin
2653
 
        Sibling:=DeletingNode.Parent.Children[i];
2654
 
        if Sibling=DeletingNode then continue;
2655
 
        if CompareText(Sibling.Sides[akLeft],LeftSplitter.Name)=0 then
2656
 
          Sibling.Sides[akLeft]:=RightSplitter.Name;
2657
 
        if CompareText(Sibling.Sides[akRight],LeftSplitter.Name)=0 then
2658
 
          Sibling.Sides[akRight]:=RightSplitter.Name;
2659
 
      end;
2660
 
      
2661
 
      // 3. delete LeftSplitter
2662
 
      FreeAndNil(LeftSplitter);
2663
 
      
2664
 
      Result:=true;
2665
 
    end;
2666
 
 
2667
 
  var
2668
 
    a: TAnchorKind;
2669
 
    SiblingNode: TLazDockConfigNode;
2670
 
    SplitterCount: Integer;// number of shared splitters
2671
 
  begin
2672
 
    DebugLn(['DeleteNode ',DeletingNode.Name]);
2673
 
    SplitterCount:=0;
2674
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
2675
 
      SiblingNode:=FindNode(DeletingNode.Sides[a]);
2676
 
      if (SiblingNode<>nil)
2677
 
      and (SiblingNode.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown])
2678
 
      then begin
2679
 
        // there is a splitter
2680
 
        if DeleteOwnSideSplitter(a,SiblingNode) then begin
2681
 
          // splitter deleted
2682
 
          break;
2683
 
        end else begin
2684
 
          inc(SplitterCount);// not own => shared
2685
 
          if SplitterCount=4 then begin
2686
 
            // this is a spiral splitter node -> merge two splitters
2687
 
            UnbindSpiralNode;
2688
 
            break;
2689
 
          end;
2690
 
        end;
2691
 
      end;
2692
 
    end;
2693
 
    FreeAndNil(DeletingNode);
2694
 
  end;
2695
 
  
2696
 
  procedure SimplifyOnePageNode(var PagesNode: TLazDockConfigNode);
2697
 
  { PagesNode has only one page left.
2698
 
    Remove Page and Pages node and move the content to the parent
2699
 
  }
2700
 
  var
2701
 
    ParentNode: TLazDockConfigNode;
2702
 
    PageNode: TLazDockConfigNode;
2703
 
    i: Integer;
2704
 
    Child: TLazDockConfigNode;
2705
 
    ChildBounds: TRect;
2706
 
    PagesBounds: TRect;
2707
 
    OffsetX: Integer;
2708
 
    OffsetY: Integer;
2709
 
    a: TAnchorKind;
2710
 
  begin
2711
 
    DebugLn(['SimplifyOnePageNode ',dbgs(PagesNode)]);
2712
 
    ParentNode:=PagesNode.Parent;
2713
 
    if ParentNode=nil then RaiseGDBException('');
2714
 
    if (PagesNode.TheType<>ldcntPages) then RaiseGDBException('');
2715
 
    if PagesNode.ChildCount<>1 then RaiseGDBException('');
2716
 
    PageNode:=PagesNode.Children[0];
2717
 
    PagesBounds:=PagesNode.Bounds;
2718
 
    OffsetX:=PagesBounds.Left;
2719
 
    OffsetY:=PagesBounds.Top;
2720
 
    for i:=0 to PageNode.ChildCount-1 do begin
2721
 
      Child:=PageNode.Children[i];
2722
 
      // changes parent of child
2723
 
      Child.Parent:=ParentNode;
2724
 
      // move children to place where PagesNode was
2725
 
      ChildBounds:=Child.Bounds;
2726
 
      OffsetRect(ChildBounds,OffsetX,OffsetY);
2727
 
      Child.Bounds:=ChildBounds;
2728
 
      // change anchors of child
2729
 
      for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
2730
 
        if CompareText(Child.Sides[a],PageNode.Name)=0 then
2731
 
          Child.Sides[a]:=PagesNode.Sides[a];
2732
 
      end;
2733
 
    end;
2734
 
    FreeAndNil(PagesNode);
2735
 
    //debugln(Root.DebugLayoutAsString);
2736
 
  end;
2737
 
  
2738
 
  procedure SimplifyOneChildForm(var FormNode: TLazDockConfigNode);
2739
 
  { FormNode has only one child left.
2740
 
    Remove Form node and replace root with child
2741
 
  }
2742
 
  var
2743
 
    FormBounds: TRect;
2744
 
    OffsetX: LongInt;
2745
 
    OffsetY: LongInt;
2746
 
    Child: TLazDockConfigNode;
2747
 
    ChildBounds: TRect;
2748
 
    a: TAnchorKind;
2749
 
    OldFormNode: TLazDockConfigNode;
2750
 
  begin
2751
 
    //DebugLn(['SimplifyOneChildForm ',dbgs(FormNode)]);
2752
 
    if FormNode<>Root then RaiseGDBException('');
2753
 
    if FormNode.ChildCount<>1 then RaiseGDBException('');
2754
 
    FormBounds:=FormNode.Bounds;
2755
 
    OffsetX:=FormBounds.Left;
2756
 
    OffsetY:=FormBounds.Top;
2757
 
    Child:=FormNode.Children[0];
2758
 
    // changes parent of child
2759
 
    Child.Parent:=FormNode.Parent;
2760
 
    Child.WindowState:=FormNode.WindowState;
2761
 
    // move child to place where FormNode was
2762
 
    ChildBounds:=Child.Bounds;
2763
 
    OffsetRect(ChildBounds,OffsetX,OffsetY);
2764
 
    Child.Bounds:=ChildBounds;
2765
 
    // change anchors of child
2766
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
2767
 
      if CompareText(Child.Sides[a],FormNode.Name)=0 then
2768
 
        Child.Sides[a]:=FormNode.Sides[a];
2769
 
    end;
2770
 
    OldFormNode:=FormNode;
2771
 
    FormNode:=Child;
2772
 
    OldFormNode.Free;
2773
 
    //Root.WriteDebugReport;
2774
 
  end;
2775
 
 
2776
 
  procedure RemoveEmptyNodes(var Node: TLazDockConfigNode);
2777
 
  // remove unneeded child nodes
2778
 
  // if no children left and Node itself is unneeded, it s freed and set to nil
2779
 
  var
2780
 
    i: Integer;
2781
 
    Docker: TCustomLazControlDocker;
2782
 
    Child: TLazDockConfigNode;
2783
 
  begin
2784
 
    if Node=nil then exit;
2785
 
    {$IFDEF VerboseAnchorDockCreateLayout}
2786
 
    DebugLn(['RemoveEmptyNodes ',Node.Name,' Node.ChildCount=',Node.ChildCount]);
2787
 
    {$ENDIF}
2788
 
    
2789
 
    // remove unneeded children
2790
 
    i:=Node.ChildCount-1;
2791
 
    while i>=0 do begin
2792
 
      Child:=Node.Children[i];
2793
 
      RemoveEmptyNodes(Child);// beware: this can delete more than one child
2794
 
      dec(i);
2795
 
      if i>=Node.ChildCount then i:=Node.ChildCount-1;
2796
 
    end;
2797
 
      
2798
 
    case Node.TheType of
2799
 
    ldcntControl:
2800
 
      begin
2801
 
        Docker:=FindDockerByName(Node.Name);
2802
 
        // if the associated control does not exist or is not visible,
2803
 
        // then delete the node
2804
 
        if (Docker=nil) then begin
2805
 
          {$IFDEF VerboseAnchorDockCreateLayout}
2806
 
          DebugLn(['RemoveEmptyNodes delete unknown node: ',dbgs(Node)]);
2807
 
          {$ENDIF}
2808
 
          DeleteNode(Node);
2809
 
        end
2810
 
        else if not ControlIsVisible(Docker.Control) then begin
2811
 
          {$IFDEF VerboseAnchorDockCreateLayout}
2812
 
          DebugLn(['RemoveEmptyNodes delete invisible node: ',dbgs(Node)]);
2813
 
          {$ENDIF}
2814
 
          DeleteNode(Node);
2815
 
        end;
2816
 
      end;
2817
 
    ldcntPage:
2818
 
      // these are auto created parent node. If they have no children: delete
2819
 
      if Node.ChildCount=0 then begin
2820
 
        {$IFDEF VerboseAnchorDockCreateLayout}
2821
 
        DebugLn(['RemoveEmptyNodes delete node without children: ',dbgs(Node)]);
2822
 
        {$ENDIF}
2823
 
        DeleteNode(Node);
2824
 
      end;
2825
 
    ldcntForm:
2826
 
      // these are auto created parent node. If they have no children: delete
2827
 
      // if they have only one child: delete node and move children up
2828
 
      if Node.ChildCount=0 then begin
2829
 
        {$IFDEF VerboseAnchorDockCreateLayout}
2830
 
        DebugLn(['RemoveEmptyNodes delete node without children: ',dbgs(Node)]);
2831
 
        {$ENDIF}
2832
 
        DeleteNode(Node);
2833
 
      end else if Node.ChildCount=1 then begin
2834
 
        // Only one child left
2835
 
        SimplifyOneChildForm(Node);
2836
 
      end;
2837
 
    ldcntPages:
2838
 
      // these are auto created parent node. If they have no children: delete
2839
 
      // if they have only one child: delete node and move child up
2840
 
      if Node.ChildCount=0 then begin
2841
 
        {$IFDEF VerboseAnchorDockCreateLayout}
2842
 
        DebugLn(['RemoveEmptyNodes delete node without children: ',dbgs(Node)]);
2843
 
        {$ENDIF}
2844
 
        DeleteNode(Node);
2845
 
      end else if Node.ChildCount=1 then begin
2846
 
        // Only one child left
2847
 
        SimplifyOnePageNode(Node);
2848
 
      end;
2849
 
    end;
2850
 
  end;
2851
 
 
2852
 
  function AllControlsAreOnSameForm: boolean;
2853
 
  var
2854
 
    RootForm: TControl;
2855
 
  
2856
 
    function Check(Node: TLazDockConfigNode): boolean;
2857
 
    var
2858
 
      i: Integer;
2859
 
      CurForm: TControl;
2860
 
    begin
2861
 
      if Node.TheType=ldcntControl then begin
2862
 
        CurForm:=FindControlByDockerName(Node.Name);
2863
 
        if (CurForm<>nil) then begin
2864
 
          while CurForm.Parent<>nil do
2865
 
            CurForm:=CurForm.Parent;
2866
 
          if CurForm<>VisibleControl then begin
2867
 
            if RootForm=nil then
2868
 
              RootForm:=CurForm
2869
 
            else if RootForm<>CurForm then
2870
 
              exit(false);
2871
 
          end;
2872
 
        end;
2873
 
      end;
2874
 
      // check children
2875
 
      for i:=0 to Node.ChildCount-1 do
2876
 
        if not Check(Node.Children[i]) then exit(false);
2877
 
      Result:=true;
2878
 
    end;
2879
 
  
2880
 
  begin
2881
 
    RootForm:=nil;
2882
 
    Result:=Check(Root);
2883
 
  end;
2884
 
  
2885
 
  // FPC bug: when this function is internal of FindNearestControlNode then get win32 linker error
2886
 
  function FindOwnSplitterSiblingWithControl(Node: TLazDockConfigNode
2887
 
    ): TLazDockConfigNode;
2888
 
  { find a sibling, that is a direct neighbour behind a splitter, and the
2889
 
    splitter is only used by the node and the sibling
2890
 
    For example:
2891
 
      ---------+
2892
 
      --+#+---+|
2893
 
      B |#| A ||
2894
 
      --+#+---+|
2895
 
      ---------+
2896
 
  }
2897
 
  var
2898
 
    a: TAnchorKind;
2899
 
    SplitterNode: TLazDockConfigNode;
2900
 
  begin
2901
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
2902
 
      if Node.Sides[a]='' then continue;
2903
 
      SplitterNode:=FindNode(Node.Sides[a]);
2904
 
      if (SplitterNode.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown])
2905
 
      and SplitterNode.IsTheOnlyNeighbour(Node,a) then begin
2906
 
        Result:=SplitterNode.FindNeighbour(OppositeAnchor[a],true);
2907
 
        if Result<>nil then exit;
2908
 
      end;
2909
 
    end;
2910
 
    Result:=nil;
2911
 
  end;
2912
 
 
2913
 
  function FindNearestControlNode: TLazDockConfigNode;
2914
 
  
2915
 
    function FindSiblingWithControl(Node: TLazDockConfigNode
2916
 
      ): TLazDockConfigNode;
2917
 
    var
2918
 
      ParentNode: TLazDockConfigNode;
2919
 
      i: Integer;
2920
 
    begin
2921
 
      ParentNode:=Node.Parent;
2922
 
      for i:=0 to ParentNode.ChildCount-1 do begin
2923
 
        Result:=ParentNode.Children[i];
2924
 
        if CompareText(Result.Name,DockerName)=0 then continue;
2925
 
        if Result.TheType=ldcntControl then
2926
 
          exit;
2927
 
      end;
2928
 
      Result:=nil;
2929
 
    end;
2930
 
 
2931
 
    function FindPageSiblingWithControl(Node: TLazDockConfigNode
2932
 
      ): TLazDockConfigNode;
2933
 
    { find direct page sibling
2934
 
      This means:
2935
 
        Node is the only child of a page
2936
 
        A sibling page has a single child with a control
2937
 
    }
2938
 
    var
2939
 
      PagesNode: TLazDockConfigNode;
2940
 
      PageNode: TLazDockConfigNode;
2941
 
      PageIndex: LongInt;
2942
 
    begin
2943
 
      // check if node is on a page without siblings
2944
 
      PageNode:=Node.Parent;
2945
 
      if (PageNode=nil) or (PageNode.TheType<>ldcntPage)
2946
 
      or (PageNode.ChildCount>1) then exit;
2947
 
      // check if left page has only one control
2948
 
      PagesNode:=PageNode.Parent;
2949
 
      PageIndex:=PagesNode.IndexOf(PageNode.Name);
2950
 
      if (PageIndex>0)
2951
 
      and (PagesNode[PageIndex-1].ChildCount=1) then begin
2952
 
        Result:=PagesNode[PageIndex-1].Children[0];
2953
 
        if Result.TheType=ldcntControl then exit;
2954
 
      end;
2955
 
      // check if right page has only one control
2956
 
      if (PageIndex<PagesNode.ChildCount-1)
2957
 
      and (PagesNode[PageIndex+1].ChildCount=1) then begin
2958
 
        Result:=PagesNode[PageIndex+1].Children[0];
2959
 
        if Result.TheType=ldcntControl then exit;
2960
 
      end;
2961
 
      Result:=nil;
2962
 
    end;
2963
 
 
2964
 
    function FindOtherNodeWithControl(Node: TLazDockConfigNode
2965
 
      ): TLazDockConfigNode;
2966
 
    var
2967
 
      i: Integer;
2968
 
    begin
2969
 
      Result:=nil;
2970
 
      if (Node.TheType=ldcntControl)
2971
 
      and (CompareText(Node.Name,DockerName)<>0) then
2972
 
        exit(Node);
2973
 
      for i:=0 to Node.ChildCount-1 do begin
2974
 
        Result:=FindOtherNodeWithControl(Node.Children[i]);
2975
 
        if Result<>nil then exit;
2976
 
      end;
2977
 
    end;
2978
 
  
2979
 
  var
2980
 
    Node: TLazDockConfigNode;
2981
 
  begin
2982
 
    Node:=FindNode(DockerName);
2983
 
    Result:=FindOwnSplitterSiblingWithControl(Node);
2984
 
    if Result<>nil then exit;
2985
 
    Result:=FindSiblingWithControl(Node);
2986
 
    Node:=Root.FindByName(DockerName);
2987
 
    Result:=FindPageSiblingWithControl(Node);
2988
 
    if Result<>nil then exit;
2989
 
    Result:=FindOtherNodeWithControl(Root);
2990
 
  end;
2991
 
 
2992
 
var
2993
 
  Config: TLazDockerConfig;
2994
 
  CurControl: TControl;
2995
 
  NearestControlNode: TLazDockConfigNode;
2996
 
begin
2997
 
  Result:=nil;
2998
 
  CurDockControl:=nil;
2999
 
  Root:=nil;
3000
 
  
3001
 
  Config:=GetConfigWithDockerName(DockerName);
3002
 
  
3003
 
  DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'"']);
3004
 
  if Config<>nil then
3005
 
    Config.WriteDebugReport;
3006
 
  
3007
 
  if (Config=nil) or (Config.Root=nil) then begin
3008
 
    DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'" No control']);
3009
 
    exit;
3010
 
  end;
3011
 
  CurControl:=FindControlByDockerName(DockerName);
3012
 
  if not ControlIsVisible(CurControl) then begin
3013
 
    DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'" CurControl=',DbgSName(CurControl),' control not visible']);
3014
 
    exit;
3015
 
  end;
3016
 
  if (not ConfigIsCompatible(Config.Root,ExceptionOnError)) then begin
3017
 
    DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'" CurControl=',DbgSName(CurControl),' config is not compatible']);
3018
 
    exit;
3019
 
  end;
3020
 
 
3021
 
  // create a copy of the config
3022
 
  Root:=TLazDockConfigNode.Create(nil);
3023
 
  try
3024
 
    Root.Assign(Config.Root);
3025
 
 
3026
 
    // clean up by removing all invisible, unknown and empty nodes
3027
 
    RemoveEmptyNodes(Root);
3028
 
 
3029
 
    // check if all used controls are on the same dock form
3030
 
    if not AllControlsAreOnSameForm then begin
3031
 
      DebugLn(['TCustomLazDockingManager.CreateLayout Not all Controls are on the same Form. Using only one form...']);
3032
 
      // the used controls are distributed on different dock forms
3033
 
      // => choose one dock form and remove the nodes of the others
3034
 
      NearestControlNode:=FindNearestControlNode;
3035
 
      if NearestControlNode=nil then RaiseGDBException('');
3036
 
      CurDockControl:=FindControlByDockerName(NearestControlNode.Name);
3037
 
      if CurDockControl=nil then RaiseGDBException('');
3038
 
      CurDockControl:=CurDockControl.GetTopParent;
3039
 
      // remove nodes of other dock forms
3040
 
      RemoveEmptyNodes(Root);
3041
 
      //DebugLn(['TCustomLazDockingManager.CreateLayout After removing nodes of other dock forms:']);
3042
 
    end;
3043
 
 
3044
 
    DebugLn(['TCustomLazDockingManager.CreateLayout After removing unneeded nodes:']);
3045
 
    Root.WriteDebugReport;
3046
 
 
3047
 
    Result:=Root;
3048
 
    Root:=nil;
3049
 
  finally
3050
 
    Root.Free;
3051
 
  end;
3052
 
end;
3053
 
 
3054
 
function TCustomLazDockingManager.ConfigIsCompatible(
3055
 
  RootNode: TLazDockConfigNode; ExceptionOnError: boolean): boolean;
3056
 
  
3057
 
  function CheckNode(Node: TLazDockConfigNode): boolean;
3058
 
  
3059
 
    procedure Error(const Msg: string);
3060
 
    var
3061
 
      s: String;
3062
 
    begin
3063
 
      s:='Error: Node="'+Node.GetPath+'"';
3064
 
      s:=s+' NodeType='+LDConfigNodeTypeNames[Node.TheType];
3065
 
      s:=s+Msg;
3066
 
      DebugLn(s);
3067
 
      if ExceptionOnError then raise Exception.Create(s);
3068
 
    end;
3069
 
    
3070
 
    function CheckSideAnchored(a: TAnchorKind): boolean;
3071
 
    var
3072
 
      SiblingName: string;
3073
 
      Sibling: TLazDockConfigNode;
3074
 
      
3075
 
      procedure ErrorWrongSplitter;
3076
 
      begin
3077
 
        Error('invalid Node.Sides[a] Node="'+Node.Name+'"'
3078
 
          +' Node.Sides['+AnchorNames[a]+']="'+Node.Sides[a]+'"');
3079
 
      end;
3080
 
      
3081
 
    begin
3082
 
      SiblingName:=Node.Sides[a];
3083
 
      if SiblingName='' then begin
3084
 
        Error('Node.Sides[a]=''''');
3085
 
        exit(false);
3086
 
      end;
3087
 
      Sibling:=RootNode.FindByName(SiblingName,true);
3088
 
      if Sibling=nil then begin
3089
 
        Error('Node.Sides[a] not found');
3090
 
        exit(false);
3091
 
      end;
3092
 
      if Sibling=Node.Parent then
3093
 
        exit(true); // anchored to parent: ok
3094
 
      if (a in [akLeft,akRight]) and (Sibling.TheType=ldcntSplitterLeftRight)
3095
 
      then
3096
 
        exit(true); // left/right side anchored to a left/right splitter: ok
3097
 
      if (a in [akTop,akBottom]) and (Sibling.TheType=ldcntSplitterUpDown)
3098
 
      then
3099
 
        exit(true); // top/bottom side anchored to a up/down splitter: ok
3100
 
      // otherwise: not ok
3101
 
      ErrorWrongSplitter;
3102
 
      Result:=false;
3103
 
    end;
3104
 
    
3105
 
    function CheckAllSidesAnchored: boolean;
3106
 
    var
3107
 
      a: TAnchorKind;
3108
 
    begin
3109
 
      for a:=Low(TAnchorKind) to High(TAnchorKind) do
3110
 
        if not CheckSideAnchored(a) then exit(false);
3111
 
      Result:=true;
3112
 
    end;
3113
 
    
3114
 
    function CheckSideNotAnchored(a: TAnchorKind): boolean;
3115
 
    begin
3116
 
      if Node.Sides[a]<>'' then begin
3117
 
        Error('Sides[a]<>''''');
3118
 
        Result:=false;
3119
 
      end else
3120
 
        Result:=true;
3121
 
    end;
3122
 
    
3123
 
    function CheckNoSideAnchored: boolean;
3124
 
    var
3125
 
      a: TAnchorKind;
3126
 
    begin
3127
 
      for a:=Low(TAnchorKind) to High(TAnchorKind) do
3128
 
        if not CheckSideNotAnchored(a) then exit(false);
3129
 
      Result:=true;
3130
 
    end;
3131
 
    
3132
 
    function CheckHasChilds: boolean;
3133
 
    begin
3134
 
      if Node.ChildCount=0 then begin
3135
 
        Error('ChildCount=0');
3136
 
        Result:=false;
3137
 
      end else
3138
 
        Result:=true;
3139
 
    end;
3140
 
 
3141
 
    function CheckHasNoChilds: boolean;
3142
 
    begin
3143
 
      if Node.ChildCount>0 then begin
3144
 
        Error('ChildCount>0');
3145
 
        Result:=false;
3146
 
      end else
3147
 
        Result:=true;
3148
 
    end;
3149
 
    
3150
 
    function CheckHasParent: boolean;
3151
 
    begin
3152
 
      if Node.Parent=nil then begin
3153
 
        Error('Parent=nil');
3154
 
        Result:=false;
3155
 
      end else
3156
 
        Result:=true;
3157
 
    end;
3158
 
    
3159
 
    function CheckUniqueCorner(Side1, Side2: TAnchorKind): boolean;
3160
 
    var
3161
 
      i: Integer;
3162
 
      Child: TLazDockConfigNode;
3163
 
    begin
3164
 
      Result:=true;
3165
 
      if Node.Parent=nil then exit;
3166
 
      if Node.Sides[Side1]='' then exit;
3167
 
      if Node.Sides[Side2]='' then exit;
3168
 
      for i:=0 to Node.Parent.ChildCount-1 do begin
3169
 
        Child:=Node.Parent.Children[i];
3170
 
        if Child=Node then continue;
3171
 
        if (CompareText(Node.Sides[Side1],Child.Sides[Side1])=0)
3172
 
        and (CompareText(Node.Sides[Side2],Child.Sides[Side2])=0) then begin
3173
 
          Error('overlapping nodes');
3174
 
          exit(false);
3175
 
        end;
3176
 
      end;
3177
 
    end;
3178
 
 
3179
 
  var
3180
 
    a: TAnchorKind;
3181
 
    i: Integer;
3182
 
  begin
3183
 
    Result:=false;
3184
 
    
3185
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
3186
 
      if Node.Sides[a]<>'' then begin
3187
 
        if CompareText(Node.Sides[a],Node.Name)=0 then begin
3188
 
          Error('Node.Sides[a]=Node');
3189
 
          exit;
3190
 
        end;
3191
 
        if RootNode.FindByName(Node.Sides[a],true)=nil then begin
3192
 
          Error('unknown Node.Sides[a]');
3193
 
          exit;
3194
 
        end;
3195
 
      end;
3196
 
    end;
3197
 
 
3198
 
    case Node.TheType of
3199
 
    ldcntControl:
3200
 
      begin
3201
 
        // a control node contains a TControl
3202
 
        if not CheckAllSidesAnchored then exit;
3203
 
      end;
3204
 
    ldcntForm:
3205
 
      begin
3206
 
        // a dock form is a dummy control, used as top level container
3207
 
        if Node.Parent<>nil then begin
3208
 
          Error('Parent<>nil');
3209
 
          exit;
3210
 
        end;
3211
 
        if not CheckHasChilds then exit;
3212
 
        if not CheckNoSideAnchored then exit;
3213
 
      end;
3214
 
    ldcntPages:
3215
 
      begin
3216
 
        // a pages node has only page nodes as children
3217
 
        if not CheckHasParent then exit;
3218
 
        if not CheckHasChilds then exit;
3219
 
        for i:=0 to Node.ChildCount-1 do
3220
 
          if Node.Children[i].TheType<>ldcntPage then begin
3221
 
            Error('Children[i].TheType<>ldcntPage');
3222
 
            exit;
3223
 
          end;
3224
 
        if not CheckAllSidesAnchored then exit;
3225
 
      end;
3226
 
    ldcntPage:
3227
 
      begin
3228
 
        // a page is the child of a pages node, and a container
3229
 
        if not CheckHasParent then exit;
3230
 
        if not CheckHasChilds then exit;
3231
 
        if Node.Parent.TheType<>ldcntPages then begin
3232
 
          Error('Parent.TheType<>ldcntPages');
3233
 
          exit;
3234
 
        end;
3235
 
        if not CheckNoSideAnchored then exit;
3236
 
      end;
3237
 
    ldcntSplitterLeftRight:
3238
 
      begin
3239
 
        // a vertical splitter can be moved left/right
3240
 
        if not CheckHasParent then exit;
3241
 
        if not CheckHasNoChilds then exit;
3242
 
        if not CheckSideNotAnchored(akLeft) then exit;
3243
 
        if not CheckSideNotAnchored(akRight) then exit;
3244
 
        if not CheckSideAnchored(akTop) then exit;
3245
 
        if not CheckSideAnchored(akBottom) then exit;
3246
 
      end;
3247
 
    ldcntSplitterUpDown:
3248
 
      begin
3249
 
        // a horizontal splitter can be moved up/down
3250
 
        // it is anchored left and right, and not top/bottom
3251
 
        // it is not a root node
3252
 
        // it has no children
3253
 
        if not CheckHasParent then exit;
3254
 
        if not CheckHasNoChilds then exit;
3255
 
        if not CheckSideNotAnchored(akTop) then exit;
3256
 
        if not CheckSideNotAnchored(akBottom) then exit;
3257
 
        if not CheckSideAnchored(akLeft) then exit;
3258
 
        if not CheckSideAnchored(akRight) then exit;
3259
 
      end;
3260
 
    else
3261
 
      Error('unknown type');
3262
 
      exit;
3263
 
    end;
3264
 
 
3265
 
    if not CheckUniqueCorner(akLeft,akTop) then exit;
3266
 
    if not CheckUniqueCorner(akLeft,akBottom) then exit;
3267
 
    if not CheckUniqueCorner(akRight,akTop) then exit;
3268
 
    if not CheckUniqueCorner(akRight,akBottom) then exit;
3269
 
 
3270
 
    // check children
3271
 
    for i:=0 to Node.ChildCount-1 do
3272
 
      if not CheckNode(Node.Children[i]) then exit;
3273
 
 
3274
 
    Result:=true;
3275
 
  end;
3276
 
  
3277
 
begin
3278
 
  if RootNode=nil then exit(false);
3279
 
  Result:=CheckNode(RootNode);
3280
 
end;
3281
 
 
3282
 
{ TLazDockConfigNode }
3283
 
 
3284
 
function TLazDockConfigNode.GetSides(Side: TAnchorKind): string;
3285
 
begin
3286
 
  Result:=FSides[Side];
3287
 
end;
3288
 
 
3289
 
function TLazDockConfigNode.GetChildCount: Integer;
3290
 
begin
3291
 
  if FChilds<>nil then
3292
 
    Result:=FChilds.Count
3293
 
  else
3294
 
    Result:=0;
3295
 
end;
3296
 
 
3297
 
function TLazDockConfigNode.GetChilds(Index: integer): TLazDockConfigNode;
3298
 
begin
3299
 
  Result:=TLazDockConfigNode(FChilds[Index]);
3300
 
end;
3301
 
 
3302
 
procedure TLazDockConfigNode.SetBounds(const AValue: TRect);
3303
 
begin
3304
 
  if CompareRect(@FBounds,@AValue) then exit;
3305
 
  FBounds:=AValue;
3306
 
end;
3307
 
 
3308
 
procedure TLazDockConfigNode.SetClientBounds(const AValue: TRect);
3309
 
begin
3310
 
  if CompareRect(@FClientBounds,@AValue) then exit;
3311
 
  FClientBounds:=AValue;
3312
 
end;
3313
 
 
3314
 
procedure TLazDockConfigNode.SetName(const AValue: string);
3315
 
begin
3316
 
  if FName=AValue then exit;
3317
 
  FName:=AValue;
3318
 
end;
3319
 
 
3320
 
procedure TLazDockConfigNode.SetParent(const AValue: TLazDockConfigNode);
3321
 
begin
3322
 
  if FParent=AValue then exit;
3323
 
  if FParent<>nil then
3324
 
    FParent.DoRemove(Self);
3325
 
  FParent:=AValue;
3326
 
  if FParent<>nil then
3327
 
    FParent.DoAdd(Self);
3328
 
end;
3329
 
 
3330
 
procedure TLazDockConfigNode.SetSides(Side: TAnchorKind;
3331
 
  const AValue: string);
3332
 
begin
3333
 
  FSides[Side]:=AValue;
3334
 
end;
3335
 
 
3336
 
procedure TLazDockConfigNode.SetTheType(const AValue: TLDConfigNodeType);
3337
 
begin
3338
 
  if FTheType=AValue then exit;
3339
 
  FTheType:=AValue;
3340
 
end;
3341
 
 
3342
 
procedure TLazDockConfigNode.DoAdd(ChildNode: TLazDockConfigNode);
3343
 
begin
3344
 
  if FChilds=nil then FChilds:=TFPList.Create;
3345
 
  FChilds.Add(ChildNode);
3346
 
end;
3347
 
 
3348
 
procedure TLazDockConfigNode.DoRemove(ChildNode: TLazDockConfigNode);
3349
 
begin
3350
 
  if TObject(FChilds[FChilds.Count-1])=ChildNode then
3351
 
    FChilds.Delete(FChilds.Count-1)
3352
 
  else
3353
 
    FChilds.Remove(ChildNode);
3354
 
end;
3355
 
 
3356
 
constructor TLazDockConfigNode.Create(ParentNode: TLazDockConfigNode);
3357
 
begin
3358
 
  FTheType:=ldcntControl;
3359
 
  Parent:=ParentNode;
3360
 
end;
3361
 
 
3362
 
constructor TLazDockConfigNode.Create(ParentNode: TLazDockConfigNode;
3363
 
  const AName: string);
3364
 
begin
3365
 
  FName:=AName;
3366
 
  Create(ParentNode);
3367
 
end;
3368
 
 
3369
 
destructor TLazDockConfigNode.Destroy;
3370
 
begin
3371
 
  Clear;
3372
 
  Parent:=nil;
3373
 
  FChilds.Free;
3374
 
  FChilds:=nil;
3375
 
  inherited Destroy;
3376
 
end;
3377
 
 
3378
 
procedure TLazDockConfigNode.Clear;
3379
 
var
3380
 
  i: Integer;
3381
 
begin
3382
 
  if FChilds=nil then exit;
3383
 
  for i:=ChildCount-1 downto 0 do Children[i].Free;
3384
 
  FChilds.Clear;
3385
 
end;
3386
 
 
3387
 
procedure TLazDockConfigNode.Assign(Source: TPersistent);
3388
 
var
3389
 
  Src: TLazDockConfigNode;
3390
 
  i: Integer;
3391
 
  SrcChild: TLazDockConfigNode;
3392
 
  NewChild: TLazDockConfigNode;
3393
 
  a: TAnchorKind;
3394
 
begin
3395
 
  if Source is TLazDockConfigNode then begin
3396
 
    Clear;
3397
 
    Src:=TLazDockConfigNode(Source);
3398
 
    FBounds:=Src.FBounds;
3399
 
    FClientBounds:=Src.FClientBounds;
3400
 
    FName:=Src.FName;
3401
 
    FWindowState:=Src.FWindowState;
3402
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do
3403
 
      FSides[a]:=Src.FSides[a];
3404
 
    FTheType:=Src.FTheType;
3405
 
    for i:=0 to Src.ChildCount-1 do begin
3406
 
      SrcChild:=Src.Children[i];
3407
 
      NewChild:=TLazDockConfigNode.Create(Self);
3408
 
      NewChild.Assign(SrcChild);
3409
 
    end;
3410
 
  end else
3411
 
    inherited Assign(Source);
3412
 
end;
3413
 
 
3414
 
function TLazDockConfigNode.FindByName(const AName: string;
3415
 
  Recursive: boolean; WithRoot: boolean): TLazDockConfigNode;
3416
 
var
3417
 
  i: Integer;
3418
 
begin
3419
 
  if WithRoot and (CompareText(Name,AName)=0) then exit(Self);
3420
 
  if FChilds<>nil then
3421
 
    for i:=0 to FChilds.Count-1 do begin
3422
 
      Result:=Children[i];
3423
 
      if CompareText(Result.Name,AName)=0 then exit;
3424
 
      if Recursive then begin
3425
 
        Result:=Result.FindByName(AName,true,false);
3426
 
        if Result<>nil then exit;
3427
 
      end;
3428
 
    end;
3429
 
  Result:=nil;
3430
 
end;
3431
 
 
3432
 
function TLazDockConfigNode.IndexOf(const AName: string): Integer;
3433
 
begin
3434
 
  if FChilds<>nil then begin
3435
 
    Result:=FChilds.Count-1;
3436
 
    while (Result>=0) and (CompareText(Children[Result].Name,AName)<>0) do
3437
 
      dec(Result);
3438
 
  end else begin
3439
 
    Result:=-1;
3440
 
  end;
3441
 
end;
3442
 
 
3443
 
function TLazDockConfigNode.GetScreenBounds: TRect;
3444
 
var
3445
 
  NewWidth: Integer;
3446
 
  NewHeight: Integer;
3447
 
  NewLeft: LongInt;
3448
 
  NewTop: LongInt;
3449
 
  Node: TLazDockConfigNode;
3450
 
begin
3451
 
  NewWidth:=FBounds.Right-FBounds.Left;
3452
 
  NewHeight:=FBounds.Bottom-FBounds.Top;
3453
 
  NewLeft:=FBounds.Left;
3454
 
  NewTop:=FBounds.Top;
3455
 
  Node:=Parent;
3456
 
  while Node<>nil do begin
3457
 
    inc(NewLeft,Node.FBounds.Left+Node.FClientBounds.Left);
3458
 
    inc(NewTop,Node.FBounds.Top+Node.FClientBounds.Top);
3459
 
    Node:=Node.Parent;
3460
 
  end;
3461
 
  Result:=Classes.Bounds(NewLeft,NewTop,NewWidth,NewHeight);
3462
 
end;
3463
 
 
3464
 
function TLazDockConfigNode.FindNeighbour(SiblingSide: TAnchorKind;
3465
 
  NilIfAmbiguous: boolean; IgnoreSplitters: boolean): TLazDockConfigNode;
3466
 
var
3467
 
  i: Integer;
3468
 
  ParentNode: TLazDockConfigNode;
3469
 
  Child: TLazDockConfigNode;
3470
 
begin
3471
 
  Result:=nil;
3472
 
  ParentNode:=Parent;
3473
 
  for i:=0 to ParentNode.ChildCount-1 do begin
3474
 
    Child:=ParentNode.Children[i];
3475
 
    if Child=Self then continue;
3476
 
    if IgnoreSplitters
3477
 
    and (Child.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown]) then
3478
 
      continue;
3479
 
    if CompareText(Child.Sides[SiblingSide],Name)=0 then begin
3480
 
      if Result=nil then
3481
 
        Result:=Child
3482
 
      else if NilIfAmbiguous then
3483
 
        exit(nil);
3484
 
    end;
3485
 
  end;
3486
 
end;
3487
 
 
3488
 
function TLazDockConfigNode.IsTheOnlyNeighbour(Node: TLazDockConfigNode;
3489
 
  SiblingSide: TAnchorKind): boolean;
3490
 
{ check if one side is only used by Node.
3491
 
  For example: If only Node.Sides[SiblingSide]=Name
3492
 
      ---------+
3493
 
      --+#+---+|
3494
 
      B |#| A ||
3495
 
      --+#+---+|
3496
 
      ---------+}
3497
 
begin
3498
 
  Result:=FindNeighbour(SiblingSide,true)<>nil;
3499
 
end;
3500
 
 
3501
 
procedure TLazDockConfigNode.SaveToConfig(Config: TConfigStorage;
3502
 
  const Path: string);
3503
 
var
3504
 
  a: TAnchorKind;
3505
 
  i: Integer;
3506
 
  Child: TLazDockConfigNode;
3507
 
  SubPath: String;
3508
 
begin
3509
 
  Config.SetDeleteValue(Path+'Name/Value',Name,'');
3510
 
  Config.SetDeleteValue(Path+'Type/Value',LDConfigNodeTypeNames[TheType],
3511
 
                        LDConfigNodeTypeNames[ldcntControl]);
3512
 
  Config.SetDeleteValue(Path+'Bounds/',FBounds,Rect(0,0,0,0));
3513
 
  Config.SetDeleteValue(Path+'ClientBounds/',FClientBounds,
3514
 
                Rect(0,0,FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top));
3515
 
  Config.SetDeleteValue(Path+'WindowState/Value',WindowStateToStr(WindowState),
3516
 
                        WindowStateToStr(wsNormal));
3517
 
 
3518
 
  // Sides
3519
 
  for a:=Low(TAnchorKind) to High(TAnchorKind) do
3520
 
    Config.SetDeleteValue(Path+'Sides/'+AnchorNames[a]+'/Name',Sides[a],'');
3521
 
 
3522
 
  // children
3523
 
  Config.SetDeleteValue(Path+'Children/Count',ChildCount,0);
3524
 
  for i:=0 to ChildCount-1 do begin
3525
 
    Child:=Children[i];
3526
 
    SubPath:=Path+'Child'+IntToStr(i+1)+'/';
3527
 
    Child.SaveToConfig(Config,SubPath);
3528
 
  end;
3529
 
end;
3530
 
 
3531
 
procedure TLazDockConfigNode.LoadFromConfig(Config: TConfigStorage;
3532
 
  const Path: string);
3533
 
var
3534
 
  a: TAnchorKind;
3535
 
  i: Integer;
3536
 
  NewChildCount: LongInt;
3537
 
  NewChildName: String;
3538
 
  NewChild: TLazDockConfigNode;
3539
 
  SubPath: String;
3540
 
begin
3541
 
  Clear;
3542
 
  // Note: 'Name' is stored only for information, but not restored on load
3543
 
  TheType:=LDConfigNodeTypeNameToType(Config.GetValue(Path+'Type/Value',
3544
 
                                      LDConfigNodeTypeNames[ldcntControl]));
3545
 
  Config.GetValue(Path+'Bounds/',FBounds,Rect(0,0,0,0));
3546
 
  Config.GetValue(Path+'ClientBounds/',FClientBounds,
3547
 
               Rect(0,0,FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top));
3548
 
  WindowState:=StrToWindowState(config.GetValue(Path+'WindowState/Value',''));
3549
 
 
3550
 
  // Sides
3551
 
  for a:=Low(TAnchorKind) to High(TAnchorKind) do
3552
 
    Sides[a]:=Config.GetValue(Path+'Sides/'+AnchorNames[a]+'/Name','');
3553
 
 
3554
 
  // children
3555
 
  NewChildCount:=Config.GetValue(Path+'Children/Count',0);
3556
 
  for i:=0 to NewChildCount-1 do begin
3557
 
    SubPath:=Path+'Child'+IntToStr(i+1)+'/';
3558
 
    NewChildName:=Config.GetValue(SubPath+'Name/Value','');
3559
 
    NewChild:=TLazDockConfigNode.Create(Self,NewChildName);
3560
 
    NewChild.Parent:=Self;
3561
 
    NewChild.LoadFromConfig(Config,SubPath);
3562
 
  end;
3563
 
end;
3564
 
 
3565
 
procedure TLazDockConfigNode.WriteDebugReport;
3566
 
 
3567
 
  procedure WriteNode(const Prefix: string; ANode: TLazDockConfigNode);
3568
 
  var
3569
 
    a: TAnchorKind;
3570
 
    i: Integer;
3571
 
    s: string;
3572
 
  begin
3573
 
    if ANode=nil then exit;
3574
 
    DbgOut(Prefix,'Name="'+ANode.Name+'"');
3575
 
    DbgOut(' Type=',GetEnumName(TypeInfo(TLDConfigNodeType),ord(ANode.TheType)));
3576
 
    DbgOut(' Bounds='+dbgs(ANode.Bounds));
3577
 
    DbgOut(' ClientBounds='+dbgs(ANode.ClientBounds));
3578
 
    DbgOut(' Children='+dbgs(ANode.ChildCount));
3579
 
    DbgOut(' WindowState='+WindowStateToStr(ANode.WindowState));
3580
 
    for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
3581
 
      s:=ANode.Sides[a];
3582
 
      if s='' then
3583
 
        s:='?';
3584
 
      DbgOut(' '+AnchorNames[a]+'="'+s+'"');
3585
 
    end;
3586
 
    debugln;
3587
 
    for i:=0 to ANode.ChildCount-1 do begin
3588
 
      WriteNode(Prefix+'  ',ANode[i]);
3589
 
    end;
3590
 
  end;
3591
 
 
3592
 
begin
3593
 
  DebugLn('TLazDockConfigNode.WriteDebugReport Root=',dbgs(Self));
3594
 
  WriteNode('  ',Self);
3595
 
  DebugLn(DebugLayoutAsString);
3596
 
  DumpStack;
3597
 
end;
3598
 
 
3599
 
function TLazDockConfigNode.DebugLayoutAsString: string;
3600
 
type
3601
 
  TArrayOfRect = array of TRect;
3602
 
  TNodeInfo = record
3603
 
    MinSize: TPoint;
3604
 
    MinSizeValid, MinSizeCalculating: boolean;
3605
 
    MinLeft: integer;
3606
 
    MinLeftValid, MinLeftCalculating: boolean;
3607
 
    MinTop: Integer;
3608
 
    MinTopValid, MinTopCalculating: boolean;
3609
 
  end;
3610
 
  PNodeInfo = ^TNodeInfo;
3611
 
var
3612
 
  Cols: LongInt;
3613
 
  Rows: LongInt;
3614
 
  LogCols: Integer;
3615
 
  NodeInfos: TPointerToPointerTree;// TLazDockConfigNode to PNodeInfo
3616
 
  
3617
 
  procedure InitNodeInfos;
3618
 
  begin
3619
 
    NodeInfos:=TPointerToPointerTree.Create;
3620
 
  end;
3621
 
 
3622
 
  procedure FreeNodeInfos;
3623
 
  var
3624
 
    Item: PNodeInfo;
3625
 
    NodePtr, InfoPtr: Pointer;
3626
 
  begin
3627
 
    NodeInfos.GetFirst(NodePtr,InfoPtr);
3628
 
    repeat
3629
 
      Item:=PNodeInfo(InfoPtr);
3630
 
      if Item=nil then break;
3631
 
      Dispose(Item);
3632
 
    until not  NodeInfos.GetNext(NodePtr,NodePtr,InfoPtr);
3633
 
    NodeInfos.Free;
3634
 
  end;
3635
 
  
3636
 
  function GetNodeInfo(Node: TLazDockConfigNode): PNodeInfo;
3637
 
  begin
3638
 
    Result:=PNodeInfo(NodeInfos[Node]);
3639
 
    if Result=nil then begin
3640
 
      New(Result);
3641
 
      FillChar(Result^,SizeOf(TNodeInfo),0);
3642
 
      NodeInfos[Node]:=Result;
3643
 
    end;
3644
 
  end;
3645
 
 
3646
 
  procedure w(x,y: Integer; const s: string; MaxX: Integer = 0);
3647
 
  var
3648
 
    i: Integer;
3649
 
  begin
3650
 
    for i:=1 to length(s) do begin
3651
 
      if (MaxX>0) and (x+i>MaxX) then exit;
3652
 
      Result[LogCols*(y-1) + x + i-1]:=s[i];
3653
 
    end;
3654
 
  end;
3655
 
 
3656
 
  procedure wfillrect(const ARect: TRect; c: char);
3657
 
  var
3658
 
    x: LongInt;
3659
 
    y: LongInt;
3660
 
  begin
3661
 
    for x:=ARect.Left to ARect.Right do
3662
 
      for y:=ARect.Top to ARect.Bottom do
3663
 
        w(x,y,c);
3664
 
  end;
3665
 
  
3666
 
  procedure wrectangle(const ARect: TRect);
3667
 
  begin
3668
 
    w(ARect.Left,ARect.Top,'+');
3669
 
    w(ARect.Right,ARect.Top,'+');
3670
 
    w(ARect.Left,ARect.Bottom,'+');
3671
 
    w(ARect.Right,ARect.Bottom,'+');
3672
 
    if ARect.Left<ARect.Right then begin
3673
 
      if ARect.Top<ARect.Bottom then begin
3674
 
        wfillrect(Rect(ARect.Left+1,ARect.Top,ARect.Right-1,ARect.Top),'-');// top line
3675
 
        wfillrect(Rect(ARect.Left+1,ARect.Bottom,ARect.Right-1,ARect.Bottom),'-');// bottom line
3676
 
        wfillrect(Rect(ARect.Left,ARect.Top+1,ARect.Left,ARect.Bottom-1),'|');// left line
3677
 
        wfillrect(Rect(ARect.Right,ARect.Top+1,ARect.Right,ARect.Bottom-1),'|');// right line
3678
 
      end else begin
3679
 
        wfillrect(Rect(ARect.Left+1,ARect.Top,ARect.Right-1,ARect.Top),'=');// horizontal line
3680
 
      end;
3681
 
    end else begin
3682
 
      wfillrect(Rect(ARect.Left,ARect.Top+1,ARect.Left,ARect.Bottom-1),'#');// vertical line
3683
 
    end;
3684
 
  end;
3685
 
  
3686
 
  function MapRect(const OriginalRect, OldBounds, NewBounds: TRect): TRect;
3687
 
  
3688
 
    function MapX(i: Integer): Integer;
3689
 
    begin
3690
 
      Result:=NewBounds.Left+
3691
 
        (((i-OldBounds.Left)*(NewBounds.Right-NewBounds.Left))
3692
 
         div (OldBounds.Right-OldBounds.Left));
3693
 
    end;
3694
 
  
3695
 
    function MapY(i: Integer): Integer;
3696
 
    begin
3697
 
      Result:=NewBounds.Top+
3698
 
        (((i-OldBounds.Top)*(NewBounds.Bottom-NewBounds.Top))
3699
 
         div (OldBounds.Bottom-OldBounds.Top));
3700
 
    end;
3701
 
 
3702
 
  begin
3703
 
    Result.Left:=MapX(OriginalRect.Left);
3704
 
    Result.Top:=MapY(OriginalRect.Left);
3705
 
    Result.Right:=MapX(OriginalRect.Left);
3706
 
    Result.Bottom:=MapY(OriginalRect.Left);
3707
 
  end;
3708
 
  
3709
 
  function GetMinSize(Node: TLazDockConfigNode): TPoint; forward;
3710
 
  
3711
 
  function GetMinPos(Node: TLazDockConfigNode; Side: TAnchorKind): Integer;
3712
 
  // calculates left or top position of Node
3713
 
  
3714
 
    function Compute(var MinPosValid, MinPosCalculating: boolean;
3715
 
      var MinPos: Integer): Integer;
3716
 
      
3717
 
      procedure Improve(Neighbour: TLazDockConfigNode);
3718
 
      var
3719
 
        NeighbourPos: LongInt;
3720
 
        NeighbourSize: TPoint;
3721
 
        NeighbourLength: LongInt;
3722
 
      begin
3723
 
        if Neighbour=nil then exit;
3724
 
        if Neighbour.Parent<>Node.Parent then exit;
3725
 
        NeighbourPos:=GetMinPos(Neighbour,Side);
3726
 
        NeighbourSize:=GetMinSize(Neighbour);
3727
 
        if Side=akLeft then
3728
 
          NeighbourLength:=NeighbourSize.X
3729
 
        else
3730
 
          NeighbourLength:=NeighbourSize.Y;
3731
 
        MinPos:=Max(MinPos,NeighbourPos+NeighbourLength);
3732
 
      end;
3733
 
      
3734
 
    var
3735
 
      Sibling: TLazDockConfigNode;
3736
 
      i: Integer;
3737
 
    begin
3738
 
      if MinPosCalculating then begin
3739
 
        DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected']);
3740
 
        DumpStack;
3741
 
        exit(1);
3742
 
      end;
3743
 
      if (not MinPosValid) then begin
3744
 
        MinPosValid:=true;
3745
 
        MinPosCalculating:=true;
3746
 
        if Node.Sides[Side]<>'' then begin
3747
 
          Sibling:=FindByName(Node.Sides[Side],true,true);
3748
 
          Improve(Sibling);
3749
 
        end;
3750
 
        if Node.Parent<>nil then begin
3751
 
          for i:=0 to Node.Parent.ChildCount-1 do begin
3752
 
            Sibling:=Node.Parent.Children[i];
3753
 
            if CompareText(Sibling.Sides[OppositeAnchor[Side]],Node.Name)=0 then
3754
 
              Improve(Sibling);
3755
 
          end;
3756
 
        end;
3757
 
        MinPosCalculating:=false;
3758
 
      end;
3759
 
      Result:=MinPos;
3760
 
    end;
3761
 
  
3762
 
  var
3763
 
    Info: PNodeInfo;
3764
 
  begin
3765
 
    Info:=GetNodeInfo(Node);
3766
 
    //DebugLn(['GetMinPos ',Node.Name,' ',AnchorNames[Side],' ',Info^.MinLeftCalculating]);
3767
 
    if Side=akLeft then
3768
 
      Result:=Compute(Info^.MinLeftValid,Info^.MinLeftCalculating,Info^.MinLeft)
3769
 
    else
3770
 
      Result:=Compute(Info^.MinTopValid,Info^.MinTopCalculating,Info^.MinTop);
3771
 
  end;
3772
 
 
3773
 
  function GetChildsMinSize(Node: TLazDockConfigNode): TPoint;
3774
 
  // calculate the minimum size needed to draw the content of the node
3775
 
  var
3776
 
    i: Integer;
3777
 
    ChildMinSize: TPoint;
3778
 
    Child: TLazDockConfigNode;
3779
 
    ChildSize: TPoint;
3780
 
  begin
3781
 
    //DebugLn(['GetChildsMinSize ',Node.name]);
3782
 
    Result:=Point(0,0);
3783
 
    if Node.TheType=ldcntPages then begin
3784
 
      // maximum size of all pages
3785
 
      for i:=0 to Node.ChildCount-1 do begin
3786
 
        ChildMinSize:=GetMinSize(Node.Children[i]);
3787
 
        Result.X:=Max(Result.X,ChildMinSize.X);
3788
 
        Result.Y:=Max(Result.Y,ChildMinSize.Y);
3789
 
      end;
3790
 
    end else begin
3791
 
      for i:=0 to Node.ChildCount-1 do begin
3792
 
        Child:=Node.Children[i];
3793
 
        ChildSize:=GetMinSize(Child);
3794
 
        Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildSize.X);
3795
 
        Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildSize.Y);
3796
 
      end;
3797
 
    end;
3798
 
  end;
3799
 
  
3800
 
  function GetMinSize(Node: TLazDockConfigNode): TPoint;
3801
 
  // calculate the minimum size needed to draw the node
3802
 
  var
3803
 
    ChildMinSize: TPoint;
3804
 
    Info: PNodeInfo;
3805
 
  begin
3806
 
    //DebugLn(['GetMinSize ',Node.name]);
3807
 
    Info:=GetNodeInfo(Node);
3808
 
    if Info^.MinSizeValid then begin
3809
 
      Result:=Info^.MinSize;
3810
 
      exit;
3811
 
    end;
3812
 
    if Info^.MinSizeCalculating then begin
3813
 
      DebugLn(['DebugLayoutAsString.GetMinSize WARNING: anchor circle detected']);
3814
 
      DumpStack;
3815
 
      Result:=Point(1,1);
3816
 
      exit;
3817
 
    end;
3818
 
    Info^.MinSizeCalculating:=true;
3819
 
    Result.X:=2+length(Node.Name);// border plus caption
3820
 
    Result.Y:=2;  // border
3821
 
    if (Node.ChildCount=0) then begin
3822
 
      case Node.TheType of
3823
 
      ldcntSplitterLeftRight,ldcntSplitterUpDown:
3824
 
        Result:=Point(1,1); // splitters don't need captions
3825
 
      end;
3826
 
    end else begin
3827
 
      ChildMinSize:=GetChildsMinSize(Node);
3828
 
      Result.X:=Max(Result.X,ChildMinSize.X+2);
3829
 
      Result.Y:=Max(Result.Y,ChildMinSize.Y+2);
3830
 
    end;
3831
 
    Info^.MinSize:=Result;
3832
 
    Info^.MinSizeValid:=true;
3833
 
    Info^.MinSizeCalculating:=false;
3834
 
  end;
3835
 
  
3836
 
  procedure DrawNode(Node: TLazDockConfigNode; ARect: TRect);
3837
 
  var
3838
 
    i: Integer;
3839
 
    Child: TLazDockConfigNode;
3840
 
    ChildSize: TPoint;
3841
 
    ChildRect: TRect;
3842
 
    AnchorNode: TLazDockConfigNode;
3843
 
  begin
3844
 
    //DebugLn(['DrawNode Node=',Node.Name,' ARect=',dbgs(ARect)]);
3845
 
    wrectangle(ARect);
3846
 
    w(ARect.Left+1,ARect.Top,Node.Name,ARect.Right);
3847
 
    
3848
 
    for i := 0 to Node.ChildCount-1 do begin
3849
 
      Child:=Node.Children[i];
3850
 
      ChildRect.Left:=ARect.Left+1+GetMinPos(Child,akLeft);
3851
 
      ChildRect.Top:=ARect.Top+1+GetMinPos(Child,akTop);
3852
 
      ChildSize:=GetMinSize(Child);
3853
 
      ChildRect.Right:=ChildRect.Left+ChildSize.X-1;
3854
 
      ChildRect.Bottom:=ChildRect.Top+ChildSize.Y-1;
3855
 
      if Child.Sides[akRight]<>'' then begin
3856
 
        AnchorNode:=FindByName(Child.Sides[akRight]);
3857
 
        if AnchorNode=Node then
3858
 
          ChildRect.Right:=ARect.Right-1
3859
 
        else if AnchorNode.Parent=Node then
3860
 
          ChildRect.Right:=ARect.Left+1+GetMinPos(AnchorNode,akLeft)-1;
3861
 
      end;
3862
 
      if Child.Sides[akBottom]<>'' then begin
3863
 
        AnchorNode:=FindByName(Child.Sides[akBottom]);
3864
 
        if AnchorNode=Node then
3865
 
          ChildRect.Bottom:=ARect.Bottom-1
3866
 
        else if AnchorNode.Parent=Node then
3867
 
          ChildRect.Bottom:=ARect.Top+1+GetMinPos(AnchorNode,akTop)-1;
3868
 
      end;
3869
 
      DrawNode(Child,ChildRect);
3870
 
      if Node.TheType=ldcntPages then begin
3871
 
        // paint only one page
3872
 
        break;
3873
 
      end;
3874
 
    end;
3875
 
  end;
3876
 
 
3877
 
var
3878
 
  e: string;
3879
 
  y: Integer;
3880
 
begin
3881
 
  Cols:=StrToIntDef(Application.GetOptionValue('ldcn-colunms'),79);
3882
 
  Rows:=StrToIntDef(Application.GetOptionValue('ldcn-rows'),20);
3883
 
 
3884
 
  InitNodeInfos;
3885
 
  try
3886
 
    e:=LineEnding;
3887
 
    LogCols:=Cols+length(e);
3888
 
    SetLength(Result,LogCols*Rows);
3889
 
    // fill space
3890
 
    FillChar(Result[1],length(Result),' ');
3891
 
    // add line endings
3892
 
    for y:=1 to Rows do
3893
 
      w(Cols+1,y,e);
3894
 
    // draw node
3895
 
    DrawNode(Self,Rect(1,1,Cols,Rows));
3896
 
  finally
3897
 
    FreeNodeInfos;
3898
 
  end;
3899
 
end;
3900
 
 
3901
 
function TLazDockConfigNode.GetPath: string;
3902
 
var
3903
 
  Node: TLazDockConfigNode;
3904
 
begin
3905
 
  Result:='';
3906
 
  Node:=Self;
3907
 
  while Node<>nil do begin
3908
 
    if Result<>'' then
3909
 
      Result:=Node.Name+'/'+Result
3910
 
    else
3911
 
      Result:=Node.Name;
3912
 
    Node:=Node.Parent;
3913
 
  end;
3914
 
end;
3915
 
 
3916
 
{ TLazDockerConfig }
3917
 
 
3918
 
constructor TLazDockerConfig.Create(const ADockerName: string;
3919
 
  ANode: TLazDockConfigNode);
3920
 
begin
3921
 
  FDockerName:=ADockerName;
3922
 
  FRoot:=ANode;
3923
 
end;
3924
 
 
3925
 
destructor TLazDockerConfig.Destroy;
3926
 
begin
3927
 
  FRoot.Free; // who will clear it else?
3928
 
  inherited Destroy;
3929
 
end;
3930
 
 
3931
 
procedure TLazDockerConfig.WriteDebugReport;
3932
 
begin
3933
 
  DebugLn(['TLazDockerConfig.WriteDebugReport DockerName="',DockerName,'"']);
3934
 
  if Root<>nil then begin
3935
 
    Root.WriteDebugReport;
3936
 
  end else begin
3937
 
    DebugLn(['  Root=nil']);
3938
 
  end;
3939
 
end;
3940
 
 
3941
 
{ TAnchoredDockManager }
3942
 
 
3943
 
procedure TAnchoredDockManager.DisableLayout(Control: TControl);
3944
 
begin
3945
 
  FConfigs.DisableLayout(Control);
3946
 
  inherited DisableLayout(Control);
3947
 
end;
3948
 
 
3949
 
procedure TAnchoredDockManager.EnableLayout(Control: TControl);
3950
 
begin
3951
 
  inherited EnableLayout(Control);
3952
 
  FConfigs.EnableLayout(Control);
3953
 
end;
3954
 
 
3955
 
end.