1 {
2  /***************************************************************************
3                                LDockTree.pas
4                              -----------------
5 
6  ***************************************************************************/
7 
8  *****************************************************************************
9   This file is part of the Lazarus Component Library (LCL)
10 
11   See the file COPYING.modifiedLGPL.txt, included in this distribution,
12   for details about the license.
13  *****************************************************************************
14 
15   Author: Mattias Gaertner
16 
17   Abstract:
18     This unit contains TLazDockTree, the default TDockTree for the LCL.
19 }
20 unit LDockTree;
21 
22 {$mode objfpc}{$H+}
23 
24 interface
25 
26 uses
27   Math, Types, Classes, SysUtils, typinfo,
28   // LazUtils
29   LazLoggerBase,
30   // LCL
31   LCLProc, LCLType, LCLIntf, LCLStrConsts, Graphics, Controls, ExtCtrls, Forms,
32   Menus, Themes, ComCtrls, LMessages, LResources;
33 
34 type
35   TLazDockPages = class;
36   TLazDockPage = class;
37   TLazDockSplitter = class;
38 
39 
40   { TLazDockZone }
41 
42   TLazDockZone = class(TDockZone)
43   private
44     FPage: TLazDockPage;
45     FPages: TLazDockPages;
46     FSplitter: TLazDockSplitter;
47   public
48     destructor Destroy; override;
49     procedure FreeSubComponents;
GetCaptionnull50     function GetCaption: string;
GetParentControlnull51     function GetParentControl: TWinControl;
52     property Splitter: TLazDockSplitter read FSplitter write FSplitter;
53     property Pages: TLazDockPages read FPages write FPages;
54     property Page: TLazDockPage read FPage write FPage;
55   end;
56 
57   TDockHeaderMouseState = record
58     Rect: TRect;
59     IsMouseDown: Boolean;
60   end;
61 
62   TDockHeaderImageKind =
63   (
64     dhiRestore,
65     dhiClose
66   );
67 
68   TDockHeaderImages = array[TDockHeaderImageKind] of TCustomBitmap;
69 
70   { TLazDockTree }
71 
72   TLazDockTree = class(TDockTree)
73   private
74     FAutoFreeDockSite: boolean;
75     FMouseState: TDockHeaderMouseState;
76     FDockHeaderImages: TDockHeaderImages;
77   protected
78     procedure AnchorDockLayout(Zone: TLazDockZone);
79     procedure CreateDockLayoutHelperControls(Zone: TLazDockZone);
80     procedure ResetSizes(Zone: TLazDockZone);
81     procedure BreakAnchors(Zone: TDockZone);
82     procedure PaintDockFrame(ACanvas: TCanvas; AControl: TControl;
83                              const ARect: TRect); override;
84     procedure UndockControlForDocking(AControl: TControl);
DefaultDockGrabberSizenull85     function DefaultDockGrabberSize: Integer;
86   public
87     constructor Create(TheDockSite: TWinControl); override;
88     destructor Destroy; override;
89     procedure AdjustDockRect(AControl: TControl; var ARect: TRect); override;
90     procedure InsertControl(AControl: TControl; InsertAt: TAlign;
91                             DropControl: TControl); override;
92     procedure RemoveControl(AControl: TControl); override;
93     procedure BuildDockLayout(Zone: TLazDockZone);
94     procedure FindBorderControls(Zone: TLazDockZone; Side: TAnchorKind;
95                                  var List: TFPList);
FindBorderControlnull96     function FindBorderControl(Zone: TLazDockZone; Side: TAnchorKind): TControl;
GetAnchorControlnull97     function GetAnchorControl(Zone: TLazDockZone; Side: TAnchorKind;
98                               OutSide: boolean): TControl;
99     procedure PaintSite(DC: HDC); override;
100     procedure MessageHandler(Sender: TControl; var Message: TLMessage); override;
101     procedure DumpLayout(FileName: String); override;
102   public
103     property AutoFreeDockSite: boolean read FAutoFreeDockSite write FAutoFreeDockSite;
104   end;
105 
106   TLazDockHeaderPart =
107   (
108     ldhpAll,           // total header rect
109     ldhpCaption,       // header caption
110     ldhpRestoreButton, // header restore button
111     ldhpCloseButton    // header close button
112   );
113 
114   { TLazDockForm
115     The default DockSite for a TLazDockTree.
116  }
117 
118   TLazDockForm = class(TCustomForm)
119   private
120     FMainControl: TControl;
121     FMouseState: TDockHeaderMouseState;
122     FDockHeaderImages: TDockHeaderImages;
123     procedure SetMainControl(const AValue: TControl);
124   protected
125     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
126     procedure UpdateMainControl;
127     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
128     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
129     procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
130     procedure MouseLeave; override;
131     procedure PaintWindow(DC: HDC); override;
132     procedure TrackMouse(X, Y: Integer);
133   public
134     constructor Create(AOwner: TComponent); override;
135     destructor Destroy; override;
CloseQuerynull136     function CloseQuery: boolean; override;
137     procedure UpdateCaption; virtual;
138     class procedure UpdateMainControlInParents(StartControl: TControl);
FindMainControlCandidatenull139     function FindMainControlCandidate: TControl;
FindHeadernull140     function FindHeader(x, y: integer; out Part: TLazDockHeaderPart): TControl;
141     procedure InsertControl(AControl: TControl; Index: integer); override;
IsDockedControlnull142     function IsDockedControl(Control: TControl): boolean;
ControlHasTitlenull143     function ControlHasTitle(Control: TControl): boolean;
GetTitleRectnull144     function GetTitleRect(Control: TControl): TRect;
GetTitleOrientationnull145     function GetTitleOrientation(Control: TControl): TDockOrientation;
146     property MainControl: TControl read FMainControl write SetMainControl;// used for the default caption
147   end;
148 
149 
150   { TLazDockPage
151     Pretty the same as a TLazDockForm but as page of a TLazDockPages }
152 
153   TLazDockPage = class(TCustomPage)
154   private
155     FDockZone: TDockZone;
GetPageControlnull156     function GetPageControl: TLazDockPages;
157   public
158     procedure InsertControl(AControl: TControl; Index: integer); override;
159     property DockZone: TDockZone read FDockZone;
160     property PageControl: TLazDockPages read GetPageControl;
161   end;
162 
163 
164   { TLazDockPages }
165 
166   TLazDockPages = class(TCustomTabControl)
167   private
GetActiveNotebookPageComponentnull168     function GetActiveNotebookPageComponent: TLazDockPage;
GetNoteBookPagenull169     function GetNoteBookPage(Index: Integer): TLazDockPage;
170     procedure SetActiveNotebookPageComponent(const AValue: TLazDockPage);
171   protected
GetFloatingDockSiteClassnull172     function GetFloatingDockSiteClass: TWinControlClass; override;
GetPageClassnull173     function GetPageClass: TCustomPageClass; override;
174     procedure Change; override;
175   public
176     property Page[Index: Integer]: TLazDockPage read GetNoteBookPage;
177     property ActivePageComponent: TLazDockPage read GetActiveNotebookPageComponent
178                                            write SetActiveNotebookPageComponent;
179     property Pages;
180   end;
181 
182 
183   { TLazDockSplitter }
184 
185   TLazDockSplitter = class(TCustomSplitter)
186   public
187     constructor Create(AOwner: TComponent); override;
188   end;
189 
190 
191 const
192   DockAlignOrientations: array[TAlign] of TDockOrientation =
193   (
194  { alNone   } doPages,
195  { alTop    } doHorizontal,
196  { alBottom } doHorizontal,
197  { alLeft   } doVertical,
198  { alRight  } doVertical,
199  { alClient } doPages,
200  { alCustom } doPages
201   );
202 
203 type
204   TAnchorControlsRect = array[TAnchorKind] of TControl;
205 
GetLazDockSplitternull206 function GetLazDockSplitter(Control: TControl; Side: TAnchorKind;
207                             out Splitter: TLazDockSplitter): boolean;
GetLazDockSplitterOrParentnull208 function GetLazDockSplitterOrParent(Control: TControl; Side: TAnchorKind;
209                                     out AnchorControl: TControl): boolean;
CountAnchoredControlsnull210 function CountAnchoredControls(Control: TControl; Side: TAnchorKind
211                                ): Integer;
NeighbourCanBeShrinkednull212 function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl;
213                                 Side: TAnchorKind): boolean;
ControlIsAnchoredIndirectlynull214 function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind;
215                                      DestControl: TControl): boolean;
216 procedure GetAnchorControlsRect(Control: TControl;
217                                 out ARect: TAnchorControlsRect);
GetEnclosingControlRectnull218 function GetEnclosingControlRect(ControlList: TFPlist;
219                                  out ARect: TAnchorControlsRect): boolean;
GetEnclosedControlsnull220 function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList;
221 
222 
223 implementation
224 
225 {$R lcl_dock_images.res}
226 
227 const
228   DockHeaderImageNames: array[TDockHeaderImageKind] of String =
229   (
230 { dhiRestore } 'lcl_dock_restore',
231 { dhiClose   } 'lcl_dock_close'
232   );
233 
234 type
235 
236   { TDockHeader }
237 
238   // maybe once it will be control, so now better to move all related to header things to class
239   TDockHeader = class
240     class procedure CreateDockHeaderImages(out Images: TDockHeaderImages);
241     class procedure DestroyDockHeaderImages(var Images: TDockHeaderImages);
242 
GetRectOfPartnull243     class function GetRectOfPart(AHeaderRect: TRect; AOrientation: TDockOrientation; APart: TLazDockHeaderPart): TRect;
FindPartnull244     class function FindPart(AHeaderRect: TRect; APoint: TPoint; AOrientation: TDockOrientation): TLazDockHeaderPart;
245     class procedure Draw(ACanvas: TCanvas; ACaption: String; DockBtnImages: TDockHeaderImages; AOrientation: TDockOrientation; const ARect: TRect; const MousePos: TPoint);
246     class procedure PerformMouseUp(AControl: TControl; APart: TLazDockHeaderPart);
247     class procedure PerformMouseDown(AControl: TControl; APart: TLazDockHeaderPart);
248   end;
249 
250 class procedure TDockHeader.CreateDockHeaderImages(out Images: TDockHeaderImages);
251 var
252   ImageKind: TDockHeaderImageKind;
253 begin
254   for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
255   begin
256     Images[ImageKind] := TPortableNetworkGraphic.Create;
257     Images[ImageKind].LoadFromResourceName(hInstance, DockHeaderImageNames[ImageKind]);
258   end;
259 end;
260 
261 class procedure TDockHeader.DestroyDockHeaderImages(
262   var Images: TDockHeaderImages);
263 var
264   ImageKind: TDockHeaderImageKind;
265 begin
266   for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
267     FreeAndNil(Images[ImageKind]);
268 end;
269 
TDockHeader.GetRectOfPartnull270 class function TDockHeader.GetRectOfPart(AHeaderRect: TRect; AOrientation: TDockOrientation;
271   APart: TLazDockHeaderPart): TRect;
272 var
273   d: Integer;
274 begin
275   Result := AHeaderRect;
276   if APart = ldhpAll then
277     Exit;
278   InflateRect(Result, -2, -2);
279   case AOrientation of
280     doHorizontal:
281     begin
282       d := Result.Bottom - Result.Top;
283       if APart = ldhpCloseButton then
284       begin
285         Result.Left := Max(Result.Left, Result.Right - d);
286         Exit;
287       end;
288       Result.Right := Max(Result.Left, Result.Right - d - 1);
289       if APart = ldhpRestoreButton then
290       begin
291         Result.Left := Max(Result.Left, Result.Right - d);
292         Exit;
293       end;
294       Result.Right := Max(Result.Left, Result.Right - d - 1);
295       InflateRect(Result, -4, 0);
296     end;
297     doVertical:
298     begin
299       d := Result.Right - Result.Left;
300       if APart = ldhpCloseButton then
301       begin
302         Result.Bottom := Min(Result.Bottom, Result.Top + d);
303         Exit;
304       end;
305       Result.Top := Min(Result.Bottom, Result.Top + d + 1);
306       if APart = ldhpRestoreButton then
307       begin
308         Result.Bottom := Min(Result.Bottom, Result.Top + d);
309         Exit;
310       end;
311       Result.Top := Min(Result.Bottom, Result.Top + d + 1);
312       InflateRect(Result, 0, -4);
313     end;
314   end;
315 end;
316 
TDockHeader.FindPartnull317 class function TDockHeader.FindPart(AHeaderRect: TRect; APoint: TPoint;
318   AOrientation: TDockOrientation): TLazDockHeaderPart;
319 var
320   SubRect: TRect;
321 begin
322   for Result := Low(TLazDockHeaderPart) to High(TLazDockHeaderPart) do
323   begin
324     if Result = ldhpAll then
325       Continue;
326     SubRect := GetRectOfPart(AHeaderRect, AOrientation, Result);
327     if PtInRect(SubRect, APoint) then
328       Exit;
329   end;
330   Result := ldhpAll;
331 end;
332 
333 class procedure TDockHeader.Draw(ACanvas: TCanvas; ACaption: String; DockBtnImages: TDockHeaderImages; AOrientation: TDockOrientation; const ARect: TRect; const MousePos: TPoint);
334 
335   procedure DrawButton(ARect: TRect; IsMouseDown, IsMouseOver: Boolean; ABitmap: TCustomBitmap); inline;
336   const
337     // ------------- Pressed, Hot -----------------------
338     BtnDetail: array[Boolean, Boolean] of TThemedToolBar =
339     (
340      (ttbButtonNormal, ttbButtonHot),
341      (ttbButtonNormal, ttbButtonPressed)
342     );
343   var
344     Details: TThemedElementDetails;
345     dx, dy: integer;
346   begin
347     Details := ThemeServices.GetElementDetails(BtnDetail[IsMouseDown, IsMouseOver]);
348     ThemeServices.DrawElement(ACanvas.Handle, Details, ARect);
349     ARect := ThemeServices.ContentRect(ACanvas.Handle, Details, ARect);
350     dx := (ARect.Right - ARect.Left - ABitmap.Width) div 2;
351     dy := (ARect.Bottom - ARect.Top - ABitmap.Height) div 2;
352     ACanvas.Draw(ARect.Left + dx, ARect.Top + dy, ABitmap);
353   end;
354 
355   procedure DrawTitle(ARect: TRect); inline;
356   begin
357     ACanvas.Pen.Color := clBtnShadow;
358     ACanvas.Brush.Color := clBtnFace;
359     ACanvas.Rectangle(ARect);
360   end;
361 
362 var
363   BtnRect: TRect;
364   DrawRect: TRect;
365   // LCL do not handle orientation in TFont
366   OldFont, RotatedFont: HFONT;
367   OldMode: Integer;
368   ALogFont: TLogFont;
369   IsMouseDown: Boolean;
370 begin
371   DrawRect := ARect;
372   InflateRect(DrawRect, -1, -1);
373   DrawTitle(DrawRect);
374   InflateRect(DrawRect, -1, -1);
375 
376   IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
377 
378   // draw close button
379   BtnRect := GetRectOfPart(ARect, AOrientation, ldhpCloseButton);
380 
381   DrawButton(BtnRect, IsMouseDown, PtInRect(BtnRect, MousePos), DockBtnImages[dhiClose]);
382 
383   // draw restore button
384   BtnRect := GetRectOfPart(ARect, AOrientation, ldhpRestoreButton);
385   DrawButton(BtnRect, IsMouseDown, PtInRect(BtnRect, MousePos), DockBtnImages[dhiRestore]);
386 
387   // draw caption
388   DrawRect := GetRectOfPart(ARect, AOrientation, ldhpCaption);
389 
390   OldMode := SetBkMode(ACanvas.Handle, TRANSPARENT);
391 
392   case AOrientation of
393     doHorizontal:
394       begin
395         DrawText(ACanvas.Handle, PChar(ACaption), -1, DrawRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
396       end;
397     doVertical:
398       begin
399         OldFont := 0;
400         if GetObject(ACanvas.Font.Reference.Handle, SizeOf(ALogFont), @ALogFont) <> 0 then
401         begin
402           ALogFont.lfEscapement := 900;
403           RotatedFont := CreateFontIndirect(ALogFont);
404           if RotatedFont <> 0 then
405             OldFont := SelectObject(ACanvas.Handle, RotatedFont);
406         end;
407         // from msdn: DrawText doesnot support font with orientation and escapement <> 0
408         TextOut(ACanvas.Handle, DrawRect.Left, DrawRect.Bottom, PChar(ACaption), Length(ACaption));
409         if OldFont <> 0 then
410           DeleteObject(SelectObject(ACanvas.Handle, OldFont));
411       end;
412   end;
413   SetBkMode(ACanvas.Handle, OldMode);
414 end;
415 
416 class procedure TDockHeader.PerformMouseUp(AControl: TControl;
417   APart: TLazDockHeaderPart);
418 begin
419   case APart of
420     ldhpRestoreButton:
421       AControl.ManualDock(nil, nil, alNone);
422     ldhpCloseButton:
423       if AControl is TCustomForm then
424         TCustomForm(AControl).Close
425       else
426         // not a form => doesnot have close => just hide
427         AControl.Visible := False;
428   end;
429 end;
430 
431 class procedure TDockHeader.PerformMouseDown(AControl: TControl;
432   APart: TLazDockHeaderPart);
433 begin
434   case APart of
435     ldhpAll, ldhpCaption:
436       // mouse down on not buttons => start drag
437       AControl.BeginDrag(False);
438   end;
439 end;
440 
441 
GetLazDockSplitternull442 function GetLazDockSplitter(Control: TControl; Side: TAnchorKind; out
443   Splitter: TLazDockSplitter): boolean;
444 begin
445   Result:=false;
446   Splitter:=nil;
447   if not (Side in Control.Anchors) then exit;
448   Splitter:=TLazDockSplitter(Control.AnchorSide[Side].Control);
449   if not (Splitter is TLazDockSplitter) then begin
450     Splitter:=nil;
451     exit;
452   end;
453   if Splitter.Parent<>Control.Parent then exit;
454   Result:=true;
455 end;
456 
GetLazDockSplitterOrParentnull457 function GetLazDockSplitterOrParent(Control: TControl; Side: TAnchorKind; out
458   AnchorControl: TControl): boolean;
459 begin
460   Result:=false;
461   AnchorControl:=nil;
462   if not (Side in Control.Anchors) then exit;
463   AnchorControl:=Control.AnchorSide[Side].Control;
464   if (AnchorControl is TLazDockSplitter)
465   and (AnchorControl.Parent=Control.Parent)
466   then
467     Result:=true
468   else if AnchorControl=Control.Parent then
469     Result:=true;
470 end;
471 
CountAnchoredControlsnull472 function CountAnchoredControls(Control: TControl; Side: TAnchorKind): Integer;
473 { return the number of siblings, that are anchored on Side of Control
474   For example: if Side=akLeft it will return the number of controls, which
475   right side is anchored to the left of Control }
476 var
477   i: Integer;
478   Neighbour: TControl;
479 begin
480   Result:=0;
481   for i:=0 to Control.Parent.ControlCount-1 do begin
482     Neighbour:=Control.Parent.Controls[i];
483     if Neighbour=Control then continue;
484     if (OppositeAnchor[Side] in Neighbour.Anchors)
485     and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then
486       inc(Result);
487   end;
488 end;
489 
NeighbourCanBeShrinkednull490 function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl;
491   Side: TAnchorKind): boolean;
492 const
493   MinControlSize = 20;
494 var
495   Splitter: TLazDockSplitter;
496 begin
497   Result:=false;
498   if not GetLazDockSplitter(EnlargeControl,OppositeAnchor[Side],Splitter) then
499     exit;
500   case Side of
501   akLeft: // check if left side of Neighbour can be moved
502     Result:=Neighbour.Left+Neighbour.Width
503         >EnlargeControl.Left+EnlargeControl.Width+Splitter.Width+MinControlSize;
504   akRight: // check if right side of Neighbour can be moved
505     Result:=Neighbour.Left+MinControlSize+Splitter.Width<EnlargeControl.Left;
506   akTop: // check if top side of Neighbour can be moved
507     Result:=Neighbour.Top+Neighbour.Height
508        >EnlargeControl.Top+EnlargeControl.Height+Splitter.Height+MinControlSize;
509   akBottom: // check if bottom side of Neighbour can be moved
510     Result:=Neighbour.Top+MinControlSize+Splitter.Height<EnlargeControl.Top;
511   end;
512 end;
513 
ControlIsAnchoredIndirectlynull514 function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind;
515   DestControl: TControl): boolean;
516 { true if there is an Anchor way from StartControl to DestControl over Side.
517   For example:
518 
519     +-+|+-+
520     |A|||B|
521     +-+|+-+
522 
523   A is akLeft to B.
524   B is akRight to A.
525   The splitter is akLeft to B.
526   The splitter is akRight to A.
527   All other are false.
528 }
529 var
530   Checked: array of Boolean;
531   Parent: TWinControl;
532 
Checknull533   function Check(ControlIndex: integer): boolean;
534   var
535     AControl: TControl;
536     SideControl: TControl;
537     i: Integer;
538   begin
539     if Checked[ControlIndex] then
540       exit(false);
541     Checked[ControlIndex]:=true;
542     AControl:=Parent.Controls[ControlIndex];
543     if AControl=DestControl then exit(true);
544 
545     if (Side in AControl.Anchors) then begin
546       SideControl:=AControl.AnchorSide[Side].Control;
547       if (SideControl<>nil) and Check(Parent.GetControlIndex(SideControl)) then
548         exit(true);
549     end;
550     for i:=0 to Parent.ControlCount-1 do begin
551       if Checked[i] then continue;
552       SideControl:=Parent.Controls[i];
553       if OppositeAnchor[Side] in SideControl.Anchors then begin
554         if (SideControl.AnchorSide[OppositeAnchor[Side]].Control=AControl)
555         and Check(i) then
556           exit(true);
557       end;
558     end;
559     Result:=false;
560   end;
561 
562 var
563   i: Integer;
564 begin
565   if (StartControl=nil) or (DestControl=nil)
566   or (StartControl.Parent=nil)
567   or (StartControl.Parent<>DestControl.Parent)
568   or (StartControl=DestControl) then
569     exit(false);
570   Parent:=StartControl.Parent;
571   SetLength(Checked,Parent.ControlCount);
572   for i:=0 to length(Checked)-1 do Checked[i]:=false;
573   Result:=Check(Parent.GetControlIndex(StartControl));
574 end;
575 
576 procedure GetAnchorControlsRect(Control: TControl;
577   out ARect: TAnchorControlsRect);
578 var
579   a: TAnchorKind;
580 begin
581   for a:=Low(TAnchorKind) to High(TAnchorKind) do
582     ARect[a]:=Control.AnchorSide[a].Control;
583 end;
584 
GetEnclosingControlRectnull585 function GetEnclosingControlRect(ControlList: TFPlist; out
586   ARect: TAnchorControlsRect): boolean;
587 { ARect will be the minimum TAnchorControlsRect around the controls in the list
588   returns true, if there is such a TAnchorControlsRect.
589 
590   The controls in ARect will either be the Parent or a TLazDockSplitter
591 }
592 var
593   Parent: TWinControl;
594 
ControlIsValidAnchornull595   function ControlIsValidAnchor(Control: TControl; Side: TAnchorKind): boolean;
596   var
597     i: Integer;
598   begin
599     Result:=false;
600     if (Control=ARect[Side]) then exit(true);// this allows Parent at the beginning
601 
602     if not (Control is TLazDockSplitter) then
603       exit;// not a splitter
604     if (TLazDockSplitter(Control).ResizeAnchor in [akLeft,akRight])
605       <>(Side in [akLeft,akRight]) then
606         exit;// wrong alignment
607     if ControlList.IndexOf(Control)>=0 then
608       exit;// is an inner control
609     if ControlIsAnchoredIndirectly(Control,Side,ARect[Side]) then
610       exit; // this anchor would be worse than the current maximum
611     for i:=0 to ControlList.Count-1 do begin
612       if not ControlIsAnchoredIndirectly(Control,Side,TControl(ControlList[i]))
613       then begin
614         // this anchor is not above (below, ...) the inner controls
615         exit;
616       end;
617     end;
618     Result:=true;
619   end;
620 
621 var
622   TopIndex: Integer;
623   TopControl: TControl;
624   RightIndex: Integer;
625   RightControl: TControl;
626   BottomIndex: Integer;
627   BottomControl: TControl;
628   LeftIndex: Integer;
629   LeftControl: TControl;
630   Candidates: TFPList;
631   i: Integer;
632   a: TAnchorKind;
633 begin
634   Result:=false;
635   if (ControlList=nil) or (ControlList.Count=0) then exit;
636 
637   // get Parent
638   Parent:=TControl(ControlList[0]).Parent;
639   if Parent=nil then exit;
640   for i:=0 to ControlList.Count-1 do
641     if TControl(ControlList[i]).Parent<>Parent then exit;
642 
643   // set the default rect: the Parent
644   Result:=true;
645   for a:=Low(TAnchorKind) to High(TAnchorKind) do
646     ARect[a]:=Parent;
647 
648   // find all possible Candidates
649   Candidates:=TFPList.Create;
650   Candidates.Add(Parent);
651   for i:=0 to Parent.ControlCount-1 do
652     if Parent.Controls[i] is TLazDockSplitter then
653       Candidates.Add(Parent.Controls[i]);
654 
655   // now check every possible rectangle
656   // Note: four loops seems to be dog slow, but the checks
657   //       avoid most possibilities early
658   for TopIndex:=0 to Candidates.Count-1 do begin
659     TopControl:=TControl(Candidates[TopIndex]);
660     if not ControlIsValidAnchor(TopControl,akTop) then continue;
661 
662     for RightIndex:=0 to Candidates.Count-1 do begin
663       RightControl:=TControl(Candidates[RightIndex]);
664       if (TopControl.AnchorSide[akRight].Control<>RightControl)
665       and (RightControl.AnchorSide[akTop].Control<>TopControl) then
666         continue; // not touching / not a corner
667       if not ControlIsValidAnchor(RightControl,akRight) then continue;
668 
669       for BottomIndex:=0 to Candidates.Count-1 do begin
670         BottomControl:=TControl(Candidates[BottomIndex]);
671         if (RightControl.AnchorSide[akBottom].Control<>BottomControl)
672         and (BottomControl.AnchorSide[akRight].Control<>RightControl) then
673           continue; // not touching / not a corner
674         if not ControlIsValidAnchor(BottomControl,akBottom) then continue;
675 
676         for LeftIndex:=0 to Candidates.Count-1 do begin
677           LeftControl:=TControl(Candidates[LeftIndex]);
678           if (BottomControl.AnchorSide[akLeft].Control<>LeftControl)
679           and (LeftControl.AnchorSide[akBottom].Control<>BottomControl) then
680             continue; // not touching / not a corner
681           if (TopControl.AnchorSide[akLeft].Control<>LeftControl)
682           and (LeftControl.AnchorSide[akTop].Control<>LeftControl) then
683             continue; // not touching / not a corner
684           if not ControlIsValidAnchor(LeftControl,akLeft) then continue;
685 
686           // found a better rectangle
687           ARect[akLeft]  :=LeftControl;
688           ARect[akRight] :=RightControl;
689           ARect[akTop]   :=TopControl;
690           ARect[akBottom]:=BottomControl;
691         end;
692       end;
693     end;
694   end;
695 
696   Candidates.Free;
697 end;
698 
GetEnclosedControlsnull699 function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList;
700 { return a list of all controls bounded by the anchors in ARect }
701 var
702   Parent: TWinControl;
703 
704   procedure Fill(AControl: TControl);
705   var
706     a: TAnchorKind;
707     SideControl: TControl;
708     i: Integer;
709   begin
710     if AControl=nil then exit;
711     if AControl=Parent then exit;// do not add Parent
712     for a:=Low(TAnchorKind) to High(TAnchorKind) do
713       if ARect[a]=AControl then exit;// do not add boundary
714 
715     if Result.IndexOf(AControl)>=0 then exit;// already added
716     Result.Add(AControl);
717 
718     for a:=Low(TAnchorKind) to High(TAnchorKind) do
719       Fill(AControl.AnchorSide[a].Control);
720     for i:=0 to Parent.ControlCount-1 do begin
721       SideControl:=Parent.Controls[i];
722       for a:=Low(TAnchorKind) to High(TAnchorKind) do
723         if SideControl.AnchorSide[a].Control=AControl then
724           Fill(SideControl);
725     end;
726   end;
727 
728 var
729   i: Integer;
730   AControl: TControl;
731   LeftTopControl: TControl;
732 begin
733   Result:=TFPList.Create;
734   LeftTopControl:=nil;
735 
736   // find the Parent
737   if (ARect[akLeft]=ARect[akRight]) and (ARect[akLeft] is TWinControl) then
738     Parent:=TWinControl(ARect[akLeft])
739   else
740     Parent:=ARect[akLeft].Parent;
741 
742   // find the left, top most control
743   for i:=0 to Parent.ControlCount-1 do begin
744     AControl:=Parent.Controls[i];
745     if (AControl.AnchorSide[akLeft].Control=ARect[akLeft])
746     and (AControl.AnchorSide[akTop].Control=ARect[akTop]) then begin
747       LeftTopControl:=AControl;
748       break;
749     end;
750   end;
751   if Result.Count=0 then exit;
752 
753   // use flood fill to find the rest
754   Fill(LeftTopControl);
755 end;
756 
757 { TLazDockPages }
758 
GetActiveNotebookPageComponentnull759 function TLazDockPages.GetActiveNotebookPageComponent: TLazDockPage;
760 begin
761   Result:=TLazDockPage(inherited ActivePageComponent);
762 end;
763 
TLazDockPages.GetNoteBookPagenull764 function TLazDockPages.GetNoteBookPage(Index: Integer): TLazDockPage;
765 begin
766   Result:=TLazDockPage(inherited Page[Index]);
767 end;
768 
769 procedure TLazDockPages.SetActiveNotebookPageComponent(const AValue: TLazDockPage);
770 begin
771   ActivePageComponent:=AValue;
772 end;
773 
TLazDockPages.GetFloatingDockSiteClassnull774 function TLazDockPages.GetFloatingDockSiteClass: TWinControlClass;
775 begin
776   Result:=TLazDockForm;
777 end;
778 
TLazDockPages.GetPageClassnull779 function TLazDockPages.GetPageClass: TCustomPageClass;
780 begin
781   Result:=TLazDockPage;
782 end;
783 
784 procedure TLazDockPages.Change;
785 begin
786   inherited Change;
787   TLazDockForm.UpdateMainControlInParents(Self);
788 end;
789 
790 { TLazDockTree }
791 
792 procedure TLazDockTree.UndockControlForDocking(AControl: TControl);
793 var
794   AWinControl: TWinControl;
795   Sibling: TControl;
796   a: TAnchorKind;
797   i: Integer;
798 begin
799   DebugLn(['TLazDockTree.UndockControlForDocking AControl=',DbgSName(AControl),' AControl.Parent=',DbgSName(AControl.Parent)]);
800   // undock AControl
801   if AControl is TWinControl then
802   begin
803     AWinControl := TWinControl(AControl);
804     if (AWinControl.DockManager<>nil) and (AWinControl.DockManager<>Self) then
805     begin
806       raise Exception.Create('TLazDockTree.UndockControlForDocking mixing docking managers is not supported');
807     end;
808   end;
809   if AControl.Parent <> nil then
810   begin
811     AControl.Parent := nil;
812   end;
813   for i:=AControl.AnchoredControlCount - 1 downto 0 do
814   begin
815     Sibling := AControl.AnchoredControls[i];
816     if (Sibling <> AControl.Parent) and (Sibling.Parent <> AControl) then
817     begin
818       for a := Low(TAnchorKind) to High(TAnchorKind) do
819         if Sibling.AnchorSide[a].Control = AControl then
820           Sibling.AnchorSide[a].Control := nil;
821     end;
822   end;
823 end;
824 
DefaultDockGrabberSizenull825 function TLazDockTree.DefaultDockGrabberSize: Integer;
826 begin
827   Result := {Abs(DockSite.Font.Height) + 4} 20;
828 end;
829 
830 procedure TLazDockTree.BreakAnchors(Zone: TDockZone);
831 begin
832   if Zone = nil then Exit;
833   if (Zone.ChildControl <> nil) and (Zone.ChildControl <> DockSite) then
834   begin
835     Zone.ChildControl.AnchorSide[akLeft].Control := nil;
836     Zone.ChildControl.AnchorSide[akTop].Control := nil;
837     Zone.ChildControl.Anchors := [akLeft, akTop];
838     Zone.ChildControl.BorderSpacing.Left := 0;
839     Zone.ChildControl.BorderSpacing.Top := 0;
840   end;
841   BreakAnchors(Zone.FirstChild);
842   BreakAnchors(Zone.NextSibling);
843 end;
844 
845 procedure TLazDockTree.PaintDockFrame(ACanvas: TCanvas; AControl: TControl; const ARect: TRect);
846 var
847   Pt: TPoint;
848 begin
849   GetCursorPos(Pt);
850   Pt := DockSite.ScreenToClient(Pt);
851   TDockHeader.Draw(ACanvas, DockSite.GetDockCaption(AControl), FDockHeaderImages,
852     AControl.DockOrientation, ARect, Pt);
853 end;
854 
855 procedure TLazDockTree.CreateDockLayoutHelperControls(Zone: TLazDockZone);
856 var
857   ParentPages: TLazDockPages;
858   ZoneIndex: LongInt;
859 begin
860   if Zone = nil then
861     Exit;
862 
863   // create needed TLazDockSplitter
864   if (Zone.Parent <> nil) and
865      (Zone.Parent.Orientation in [doVertical,doHorizontal]) and
866      (Zone.PrevSibling <> nil) then
867   begin
868     // a zone with a side sibling -> needs a TLazDockSplitter
869     if Zone.Splitter = nil then
870     begin
871       Zone.Splitter := TLazDockSplitter.Create(nil);
872       Zone.Splitter.Align := alNone;
873     end;
874   end
875   else
876   if Zone.Splitter <> nil then
877   begin
878     // zone no longer needs the splitter
879     Zone.Splitter.Free;
880     Zone.Splitter := nil;
881   end;
882 
883   // create needed TLazDockPages
884   if (Zone.Orientation = doPages) then
885   begin
886     // a zone of pages -> needs a TLazDockPages
887     if Zone.FirstChild = nil then
888       RaiseGDBException('TLazDockTree.CreateDockLayoutHelperControls Inconsistency: doPages without children');
889     if (Zone.Pages = nil) then
890       Zone.Pages:=TLazDockPages.Create(nil);
891   end
892   else
893   if Zone.Pages<>nil then
894   begin
895     // zone no longer needs the pages
896     Zone.Pages.Free;
897     Zone.Pages := nil;
898   end;
899 
900   // create needed TLazDockPage
901   if (Zone.Parent<>nil) and
902      (Zone.Parent.Orientation = doPages) then
903   begin
904     // a zone as page -> needs a TLazDockPage
905     if (Zone.Page = nil) then
906     begin
907       ParentPages := TLazDockZone(Zone.Parent).Pages;
908       ZoneIndex := Zone.GetIndex;
909       ParentPages.Pages.Insert(ZoneIndex,Zone.GetCaption);
910       Zone.Page := ParentPages.Page[ZoneIndex];
911     end;
912   end
913   else
914   if Zone.Page <> nil then
915   begin
916     // zone no longer needs the page
917     Zone.Page.Free;
918     Zone.Page := nil;
919   end;
920 
921   // create controls for children and siblings
922   CreateDockLayoutHelperControls(Zone.FirstChild as TLazDockZone);
923   CreateDockLayoutHelperControls(Zone.NextSibling as TLazDockZone);
924 end;
925 
926 procedure TLazDockTree.ResetSizes(Zone: TLazDockZone);
927 var
928   NewSize, NewPos: Integer;
929   Child: TLazDockZone;
930 begin
931   if Zone = nil then
932     Exit;
933 
934   // split available size between children
935   if (Zone.Orientation in [doHorizontal, doVertical]) and
936      (Zone.VisibleChildCount > 0) then
937   begin
938     NewSize := Zone.LimitSize div Zone.VisibleChildCount;
939     NewPos := Zone.LimitBegin;
940     Child := Zone.FirstChild as TLazDockZone;
941     while Child <> nil do
942     begin
943       if Child.Visible then
944       begin
945         case Zone.Orientation of
946           doHorizontal:
947             begin
948               Child.Top := NewPos;
949               Child.Height := NewSize;
950             end;
951           doVertical:
952             begin
953               Child.Left := NewPos;
954               Child.Width := NewSize;
955             end;
956         end;
957         ResetSizes(Child);
958         inc(NewPos, NewSize);
959       end;
960       Child := Child.NextSibling as TLazDockZone;
961     end;
962   end;
963 end;
964 
965 procedure TLazDockTree.AdjustDockRect(AControl: TControl; var ARect: TRect);
966 begin
967   // offset one of the borders of control rect in order to get space for frame
968   case AControl.DockOrientation of
969     doHorizontal:
970       Inc(ARect.Top, DefaultDockGrabberSize);
971     doVertical:
972       Inc(ARect.Left, DefaultDockGrabberSize);
973   end;
974 end;
975 
976 procedure TLazDockTree.AnchorDockLayout(Zone: TLazDockZone);
977 // setup all anchors between all docked controls and helper controls
978 const
979   SplitterWidth = 5;
980   SplitterHeight = 5;
981 var
982   AnchorControls: array[TAnchorKind] of TControl;
983   a: TAnchorKind;
984   SplitterSide: TAnchorKind;
985   CurControl: TControl;
986   NewSplitterAnchors: TAnchors;
987   NewAnchors: TAnchors;
988 begin
989   if Zone = nil then
990     Exit;
991 
992   if Zone.Pages <> nil then
993     CurControl := Zone.Pages
994   else
995     CurControl := Zone.ChildControl;
996   //DebugLn(['TLazDockTree.AnchorDockLayout CurControl=',DbgSName(CurControl),' DockSite=',DbgSName(DockSite)]);
997   if ((CurControl <> nil) and (CurControl <> DockSite)) or (Zone.Splitter <> nil) then
998   begin
999     // get outside anchor controls
1000     NewAnchors := [akLeft, akRight, akTop, akBottom];
1001     for a := Low(TAnchorKind) to High(TAnchorKind) do
1002       AnchorControls[a] := GetAnchorControl(Zone, a, true);
1003 
1004     // anchor splitter
1005     if (Zone.Splitter <> nil) then
1006     begin
1007       if Zone.Parent.Orientation = doHorizontal then
1008       begin
1009         SplitterSide := akTop;
1010         NewSplitterAnchors := [akLeft, akRight];
1011         Zone.Splitter.AnchorSide[akLeft].Side := asrTop;
1012         Zone.Splitter.AnchorSide[akRight].Side := asrBottom;
1013         Zone.Splitter.Height := SplitterHeight;
1014         if Zone.PrevSibling <> nil then
1015           Zone.Splitter.Top := (Zone.PrevSibling.Top + Zone.PrevSibling.Height) - DefaultDockGrabberSize;
1016         Zone.Splitter.ResizeAnchor := akBottom;
1017       end
1018       else
1019       begin
1020         SplitterSide := akLeft;
1021         NewSplitterAnchors := [akTop, akBottom];
1022         Zone.Splitter.AnchorSide[akTop].Side := asrTop;
1023         Zone.Splitter.AnchorSide[akBottom].Side := asrBottom;
1024         Zone.Splitter.Width := SplitterWidth;
1025         if Zone.PrevSibling <> nil then
1026           Zone.Splitter.Left := (Zone.PrevSibling.Left + Zone.PrevSibling.Width) - DefaultDockGrabberSize;
1027         Zone.Splitter.ResizeAnchor := akRight;
1028       end;
1029       // IMPORTANT: first set the AnchorSide, then set the Anchors
1030       for a := Low(TAnchorKind) to High(TAnchorKind) do
1031       begin
1032         if a in NewSplitterAnchors then
1033           Zone.Splitter.AnchorSide[a].Control := AnchorControls[a]
1034         else
1035           Zone.Splitter.AnchorSide[a].Control := nil;
1036       end;
1037       Zone.Splitter.Anchors := NewSplitterAnchors;
1038       Zone.Splitter.Parent := Zone.GetParentControl;
1039       AnchorControls[SplitterSide] := Zone.Splitter;
1040     end;
1041 
1042     if (CurControl <> nil) then
1043     begin
1044       // anchor pages
1045       // IMPORTANT: first set the AnchorSide, then set the Anchors
1046       //DebugLn(['TLazDockTree.AnchorDockLayout CurControl.Parent=',DbgSName(CurControl.Parent),' ',CurControl.Visible]);
1047       for a := Low(TAnchorKind) to High(TAnchorKind) do
1048       begin
1049         if AnchorControls[a] <> CurControl then
1050           CurControl.AnchorSide[a].Control := AnchorControls[a];
1051         if (AnchorControls[a] <> nil) and (AnchorControls[a].Parent = CurControl.Parent) then
1052           CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[a]
1053         else
1054           CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[OppositeAnchor[a]];
1055       end;
1056       CurControl.Anchors := NewAnchors;
1057       // set space for header
1058       case CurControl.DockOrientation of
1059         doHorizontal: CurControl.BorderSpacing.Top := DefaultDockGrabberSize;
1060         doVertical: CurControl.BorderSpacing.Left := DefaultDockGrabberSize;
1061       end;
1062     end;
1063   end;
1064 
1065   // anchor controls for children and siblings
1066   AnchorDockLayout(Zone.FirstChild as TLazDockZone);
1067   AnchorDockLayout(Zone.NextSibling as TLazDockZone);
1068 end;
1069 
1070 constructor TLazDockTree.Create(TheDockSite: TWinControl);
1071 begin
1072   FillChar(FMouseState, SizeOf(FMouseState), 0);
1073   TDockHeader.CreateDockHeaderImages(FDockHeaderImages);
1074   SetDockZoneClass(TLazDockZone);
1075   if TheDockSite = nil then
1076   begin
1077     TheDockSite := TLazDockForm.Create(nil);
1078     TheDockSite.DockManager := Self;
1079     FAutoFreeDockSite := True;
1080   end;
1081   inherited Create(TheDockSite);
1082 end;
1083 
1084 destructor TLazDockTree.Destroy;
1085 begin
1086   if FAutoFreeDockSite then
1087   begin
1088     if DockSite.DockManager = Self then
1089       DockSite.DockManager := nil;
1090     DockSite.Free;
1091     DockSite := nil;
1092   end;
1093   TDockHeader.DestroyDockHeaderImages(FDockHeaderImages);
1094   inherited Destroy;
1095 end;
1096 
1097 procedure TLazDockTree.InsertControl(AControl: TControl; InsertAt: TAlign;
1098   DropControl: TControl);
1099 { undocks AControl and docks it into the tree
1100   It creates a new TDockZone for AControl and inserts it as a new leaf.
1101   It automatically changes the tree, so that the parent of the new TDockZone
1102   will have the Orientation for InsertAt.
1103 
1104   Example 1:
1105 
1106     A newly created TLazDockTree has only a DockSite (TLazDockForm) and a single
1107     TDockZone - the RootZone, which has as ChildControl the DockSite.
1108 
1109     Visual:
1110       +-DockSite--+
1111       |           |
1112       +-----------+
1113     Tree of TDockZone:
1114       RootZone (DockSite,doNoOrient)
1115 
1116 
1117   Inserting the first control:  InsertControl(Form1,alLeft,nil);
1118     Visual:
1119       +-DockSite---+
1120       |+--Form1---+|
1121       ||          ||
1122       |+----------+|
1123       +------------+
1124     Tree of TDockZone:
1125       RootZone (DockSite,doHorizontal)
1126        +-Zone2 (Form1,doNoOrient)
1127 
1128 
1129   Dock Form2 right of Form1:  InsertControl(Form2,alLeft,Form1);
1130     Visual:
1131       +-DockSite----------+
1132       |+-Form1-+|+-Form2-+|
1133       ||        ||       ||
1134       |+-------+|+-------+|
1135       +-------------------+
1136     Tree of TDockZone:
1137       RootZone (DockSite,doHorizontal)
1138        +-Zone2 (Form1,doNoOrient)
1139        +-Zone3 (Form2,doNoOrient)
1140 }
1141 
1142   procedure PrepareControlForResize(AControl: TControl); inline;
1143   var
1144     a: TAnchorKind;
1145   begin
1146     AControl.Align := alNone;
1147     AControl.Anchors := [akLeft, akTop];
1148     for a := Low(TAnchorKind) to High(TAnchorKind) do
1149       AControl.AnchorSide[a].Control := nil;
1150     AControl.AutoSize := False;
1151   end;
1152 
1153 var
1154   CtlZone, DropZone, OldParentZone, NewParentZone: TDockZone;
1155   NewZone: TLazDockZone;
1156   NewOrientation: TDockOrientation;
1157   NeedNewParentZone: Boolean;
1158   NewBounds: TRect;
1159 begin
1160   CtlZone := RootZone.FindZone(AControl);
1161   if CtlZone <> nil then
1162     RemoveControl(AControl);
1163 
1164   if (DropControl = nil) or (DropControl = AControl) then
1165     DropControl := DockSite;
1166 
1167   DropZone := RootZone.FindZone(DropControl);
1168   if DropZone = nil then
1169     raise Exception.Create('TLazDockTree.InsertControl DropControl is not part of this TDockTree');
1170 
1171   NewOrientation := DockAlignOrientations[InsertAt];
1172 
1173   // undock
1174   UndockControlForDocking(AControl);
1175 
1176   // dock
1177   // create a new zone for AControl
1178   NewZone := DockZoneClass.Create(Self,AControl) as TLazDockZone;
1179 
1180   // insert new zone into tree
1181   if (DropZone = RootZone) and (RootZone.FirstChild = nil) then
1182   begin
1183     // this is the first child
1184     debugln('TLazDockTree.InsertControl First Child');
1185     //RootZone.Orientation := NewOrientation;
1186     RootZone.AddAsFirstChild(NewZone);
1187     AControl.DockOrientation := NewOrientation;
1188     if not AControl.Visible then
1189       DockSite.Visible := False;
1190 
1191     NewBounds := DockSite.ClientRect;
1192     AdjustDockRect(AControl, NewBounds);
1193     PrepareControlForResize(AControl);
1194 
1195     AControl.BoundsRect := NewBounds;
1196     AControl.Parent := DockSite;
1197 
1198     if AControl.Visible then
1199       DockSite.Visible := True;
1200   end else
1201   begin
1202     // there are already other children
1203 
1204     // optimize DropZone
1205     if (DropZone.ChildCount>0) and
1206        (NewOrientation in [doHorizontal,doVertical]) and
1207        (DropZone.Orientation in [NewOrientation, doNoOrient]) then
1208     begin
1209       // docking on a side of an inner node is the same as docking to a side of
1210       // a child
1211       if InsertAt in [alLeft,alTop] then
1212         DropZone := DropZone.FirstChild
1213       else
1214         DropZone := DropZone.GetLastChild;
1215     end;
1216 
1217     // insert a new Parent Zone if needed
1218     NeedNewParentZone := True;
1219     if (DropZone.Parent <> nil) then
1220     begin
1221       if (DropZone.Parent.Orientation = doNoOrient) then
1222         NeedNewParentZone := False;
1223       if (DropZone.Parent.Orientation = NewOrientation) then
1224         NeedNewParentZone := False;
1225     end;
1226     if NeedNewParentZone then
1227     begin
1228       // insert a new zone between current DropZone.Parent and DropZone
1229       // this new zone will become the new DropZone.Parent
1230       OldParentZone := DropZone.Parent;
1231       NewParentZone := DockZoneClass.Create(Self, nil);
1232       if OldParentZone <> nil then
1233         OldParentZone.ReplaceChild(DropZone, NewParentZone);
1234       NewParentZone.AddAsFirstChild(DropZone);
1235       if RootZone = DropZone then
1236         FRootZone := NewParentZone;
1237     end;
1238 
1239     if DropZone.Parent = nil then
1240       RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Parent=nil');
1241     // adjust Orientation in tree
1242     if DropZone.Parent.Orientation = doNoOrient then
1243     begin
1244       // child control already had orientation but now we moved it to parent
1245       // which can take another orientation => change child control orientation
1246       DropZone.Parent.Orientation := NewOrientation;
1247       if (DropZone.Parent.ChildCount = 1) and (DropZone.Parent.FirstChild.ChildControl <> nil) then
1248         DropZone.Parent.FirstChild.ChildControl.DockOrientation := NewOrientation;
1249     end;
1250     if DropZone.Parent.Orientation <> NewOrientation then
1251       RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Orientation<>NewOrientation');
1252 
1253     // insert new node
1254     //DoDi: should insert relative to dropzone, not at begin/end of the parent zone
1255     DropZone.AddSibling(NewZone, InsertAt);
1256 
1257     // add AControl to DockSite
1258     PrepareControlForResize(AControl);
1259     AControl.DockOrientation := NewOrientation;
1260     AControl.Parent := NewZone.GetParentControl;
1261   end;
1262 
1263   // Build dock layout (anchors, splitters, pages)
1264   if NewZone.Parent <> nil then
1265     BuildDockLayout(NewZone.Parent as TLazDockZone)
1266   else
1267     BuildDockLayout(RootZone as TLazDockZone);
1268 end;
1269 
1270 procedure TLazDockTree.RemoveControl(AControl: TControl);
1271 var
1272   RemoveZone, ParentZone: TLazDockZone;
1273 begin
1274   RemoveZone := RootZone.FindZone(AControl) as TLazDockZone;
1275 
1276   // no such control => exit
1277   if RemoveZone = nil then
1278     Exit;
1279 
1280   // has children
1281   if (RemoveZone.ChildCount > 0) then
1282     raise Exception.Create('TLazDockTree.RemoveControl RemoveZone.ChildCount > 0');
1283 
1284   // destroy child zone and all parents if they does not contain anything else
1285   while (RemoveZone <> RootZone) and
1286         (RemoveZone.ChildCount = 0) do
1287   begin
1288     ParentZone := RemoveZone.Parent as TLazDockZone;
1289     RemoveZone.FreeSubComponents;
1290     BreakAnchors(RemoveZone);
1291     if ParentZone <> nil then
1292       ParentZone.Remove(RemoveZone);
1293     RemoveZone.Free;
1294     // try with ParentZone now
1295     RemoveZone := ParentZone;
1296   end;
1297 
1298   // reset orientation
1299   if (RemoveZone.ChildCount = 1) and (RemoveZone.Orientation in [doHorizontal, doVertical]) then
1300     RemoveZone.Orientation := doNoOrient;
1301 
1302   // Build dock layout (anchors, splitters, pages)
1303   if (RemoveZone.Parent <> nil) then
1304     BuildDockLayout(RemoveZone.Parent as TLazDockZone)
1305   else
1306     BuildDockLayout(RootZone as TLazDockZone);
1307 end;
1308 
1309 procedure TLazDockTree.BuildDockLayout(Zone: TLazDockZone);
1310 begin
1311   if DockSite <> nil then
1312     DockSite.DisableAlign;
1313   try
1314     BreakAnchors(Zone);
1315     CreateDockLayoutHelperControls(Zone);
1316     ResetSizes(Zone);
1317     AnchorDockLayout(Zone);
1318   finally
1319     if DockSite <> nil then
1320     begin
1321       DockSite.EnableAlign;
1322       DockSite.Invalidate;
1323     end;
1324   end;
1325 end;
1326 
1327 procedure TLazDockTree.FindBorderControls(Zone: TLazDockZone; Side: TAnchorKind;
1328   var List: TFPList);
1329 begin
1330   if List=nil then List:=TFPList.Create;
1331   if Zone=nil then exit;
1332 
1333   if (Zone.Splitter<>nil) and (Zone.Parent<>nil)
1334   and (Zone.Orientation=doVertical) then begin
1335     // this splitter is leftmost, topmost, bottommost
1336     if Side in [akLeft,akTop,akBottom] then
1337       List.Add(Zone.Splitter);
1338     if Side=akLeft then begin
1339       // the splitter fills the whole left side => no more controls
1340       exit;
1341     end;
1342   end;
1343   if (Zone.Splitter<>nil) and (Zone.Parent<>nil)
1344   and (Zone.Orientation=doHorizontal) then begin
1345     // this splitter is topmost, leftmost, rightmost
1346     if Side in [akTop,akLeft,akRight] then
1347       List.Add(Zone.Splitter);
1348     if Side=akTop then begin
1349       // the splitter fills the whole top side => no more controls
1350       exit;
1351     end;
1352   end;
1353   if Zone.ChildControl<>nil then begin
1354     // the ChildControl fills the whole zone (except for the splitter)
1355     List.Add(Zone.ChildControl);
1356     exit;
1357   end;
1358   if Zone.Pages<>nil then begin
1359     // the pages fills the whole zone (except for the splitter)
1360     List.Add(Zone.Pages);
1361     exit;
1362   end;
1363 
1364   // go recursively through all child zones
1365   if (Zone.Parent<>nil) and (Zone.Orientation in [doVertical,doHorizontal])
1366   and (Zone.FirstChild<>nil) then
1367   begin
1368     if Side in [akLeft,akTop] then
1369       FindBorderControls(Zone.FirstChild as TLazDockZone,Side,List)
1370     else
1371       FindBorderControls(Zone.GetLastChild as TLazDockZone,Side,List);
1372   end;
1373 end;
1374 
FindBorderControlnull1375 function TLazDockTree.FindBorderControl(Zone: TLazDockZone; Side: TAnchorKind
1376   ): TControl;
1377 var
1378   List: TFPList;
1379 begin
1380   Result:=nil;
1381   if Zone=nil then exit;
1382   List:=nil;
1383   FindBorderControls(Zone,Side,List);
1384   if (List=nil) or (List.Count=0) then
1385     Result:=DockSite
1386   else
1387     Result:=TControl(List[0]);
1388   List.Free;
1389 end;
1390 
GetAnchorControlnull1391 function TLazDockTree.GetAnchorControl(Zone: TLazDockZone; Side: TAnchorKind;
1392   OutSide: boolean): TControl;
1393 // find a control to anchor the Zone's Side
1394 begin
1395   if Zone = nil then
1396   begin
1397     Result := DockSite;
1398     exit;
1399   end;
1400 
1401   if not OutSide then
1402   begin
1403     // also check the Splitter and the Page
1404     if (Side = akLeft) and (Zone.Parent <> nil) and
1405        (Zone.Parent.Orientation = doVertical) and (Zone.Splitter<>nil) then
1406     begin
1407       Result := Zone.Splitter;
1408       exit;
1409     end;
1410     if (Side = akTop) and (Zone.Parent<>nil) and
1411        (Zone.Parent.Orientation=doHorizontal) and (Zone.Splitter<>nil) then
1412     begin
1413       Result := Zone.Splitter;
1414       exit;
1415     end;
1416     if (Zone.Page <> nil) then
1417     begin
1418       Result := Zone.Page;
1419       exit;
1420     end;
1421   end;
1422 
1423   // search the neighbour zones:
1424   Result := DockSite;
1425   if (Zone.Parent = nil) then
1426     Exit;
1427 
1428   case Zone.Parent.Orientation of
1429     doHorizontal:
1430       if (Side=akTop) and (Zone.PrevSibling<>nil) then
1431         Result:=FindBorderControl(Zone.PrevSibling as TLazDockZone,akBottom)
1432       else if (Side=akBottom) and (Zone.NextSibling<>nil) then
1433         Result:=FindBorderControl(Zone.NextSibling as TLazDockZone,akTop)
1434       else
1435         Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
1436     doVertical:
1437       if (Side=akLeft) and (Zone.PrevSibling<>nil) then
1438         Result:=FindBorderControl(Zone.PrevSibling as TLazDockZone,akRight)
1439       else if (Side=akRight) and (Zone.NextSibling<>nil) then
1440         Result:=FindBorderControl(Zone.NextSibling as TLazDockZone,akLeft)
1441       else
1442         Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
1443     doPages:
1444       Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
1445   end;
1446 end;
1447 
1448 procedure TLazDockTree.PaintSite(DC: HDC);
1449 var
1450   ACanvas: TCanvas;
1451   ARect: TRect;
1452   i: integer;
1453 begin
1454   // paint bounds for each control and close button
1455   if DockSite.ControlCount > 0 then
1456   begin
1457     ACanvas := TCanvas.Create;
1458     ACanvas.Handle := DC;
1459     try
1460       for i := 0 to DockSite.ControlCount - 1 do
1461       begin
1462         if (DockSite.Controls[i].HostDockSite = DockSite) and
1463            (DockSite.Controls[i].Visible) then
1464         begin
1465           ARect := DockSite.Controls[i].BoundsRect;
1466           case DockSite.Controls[i].DockOrientation of
1467             doHorizontal:
1468               begin
1469                 ARect.Bottom := ARect.Top;
1470                 Dec(ARect.Top, DefaultDockGrabberSize);
1471               end;
1472             doVertical:
1473               begin
1474                 ARect.Right := ARect.Left;
1475                 Dec(ARect.Left, DefaultDockGrabberSize);
1476               end;
1477           end;
1478           PaintDockFrame(ACanvas, DockSite.Controls[i], ARect);
1479         end;
1480       end;
1481     finally
1482       ACanvas.Free;
1483     end;
1484   end;
1485 end;
1486 
1487 procedure TLazDockTree.MessageHandler(Sender: TControl; var Message: TLMessage);
1488 
1489   procedure CheckNeedRedraw(AControl: TControl; ARect: TRect; APart: TLazDockHeaderPart);
1490   var
1491     NewMouseState: TDockHeaderMouseState;
1492   begin
1493     if AControl = nil then
1494       FillChar(ARect, SizeOf(ARect), 0)
1495     else
1496       ARect := TDockHeader.GetRectOfPart(ARect, AControl.DockOrientation, APart);
1497     // we cannot directly redraw this part since we should paint only in paint events
1498     FillChar(NewMouseState, SizeOf(NewMouseState), 0);
1499     NewMouseState.Rect := ARect;
1500     NewMouseState.IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
1501     if not CompareMem(@FMouseState, @NewMouseState, SizeOf(NewMouseState)) then
1502     begin
1503       if not CompareRect(@FMouseState.Rect, @NewMouseState.Rect) then
1504         InvalidateRect(DockSite.Handle, @FMouseState.Rect, False);
1505       FMouseState := NewMouseState;
1506       InvalidateRect(DockSite.Handle, @NewMouseState.Rect, False);
1507     end;
1508   end;
1509 
1510   function GetControlHeaderRect(AControl: TControl; out ARect: TRect): Boolean;
1511   begin
1512     Result := True;
1513     ARect := AControl.BoundsRect;
1514     case AControl.DockOrientation of
1515       doHorizontal:
1516         begin
1517           ARect.Bottom := ARect.Top;
1518           Dec(ARect.Top, DefaultDockGrabberSize);
1519         end;
1520       doVertical:
1521         begin
1522           ARect.Right := ARect.Left;
1523           Dec(ARect.Left, DefaultDockGrabberSize);
1524         end;
1525       else
1526         Result := False;
1527     end;
1528   end;
1529 
1530   function FindControlAndPart(MouseMsg: TLMMouse; out ARect: TRect; out APart: TLazDockHeaderPart): TControl;
1531   var
1532     i: integer;
1533     Pt: TPoint;
1534   begin
1535     Pt := SmallPointToPoint(MouseMsg.Pos);
1536     for i := 0 to DockSite.ControlCount - 1 do
1537     begin
1538       if DockSite.Controls[i].HostDockSite = DockSite then
1539       begin
1540         if not GetControlHeaderRect(DockSite.Controls[i], ARect) then
1541           Continue;
1542         if not PtInRect(ARect, Pt) then
1543           Continue;
1544         // we have control here
1545         Result := DockSite.Controls[i];
1546         APart := TDockHeader.FindPart(ARect, Pt, DockSite.Controls[i].DockOrientation);
1547         Exit;
1548       end;
1549     end;
1550     Result := nil;
1551   end;
1552 
1553 var
1554   ARect: TRect;
1555   Part: TLazDockHeaderPart;
1556   Control: TControl;
1557   AZone: TLazDockZone;
1558 begin
1559   case Message.msg of
1560     LM_LBUTTONUP:
1561       begin
1562         Control := FindControlAndPart(TLMMouse(Message), ARect, Part);
1563         CheckNeedRedraw(Control, ARect, Part);
1564         TDockHeader.PerformMouseUp(Control, Part);
1565       end;
1566     LM_LBUTTONDOWN:
1567       begin
1568         Control := FindControlAndPart(TLMMouse(Message), ARect, Part);
1569         CheckNeedRedraw(Control, ARect, Part);
1570         TDockHeader.PerformMouseDown(Control, Part);
1571       end;
1572     LM_MOUSEMOVE:
1573       begin
1574         Control := FindControlAndPart(TLMMouse(Message), ARect, Part);
1575         CheckNeedRedraw(Control, ARect, Part);
1576       end;
1577     CM_MOUSELEAVE:
1578       CheckNeedRedraw(nil, Rect(0,0,0,0), ldhpAll);
1579     CM_TEXTCHANGED:
1580       begin
1581         if GetControlHeaderRect(Sender, ARect) then
1582         begin
1583           ARect := TDockHeader.GetRectOfPart(ARect, Sender.DockOrientation, ldhpCaption);
1584           InvalidateRect(DockSite.Handle, @ARect, False);
1585         end;
1586       end;
1587     CM_VISIBLECHANGED:
1588       begin
1589         if not (csDestroying in Sender.ComponentState) then
1590         begin
1591           AZone := RootZone.FindZone(Sender) as TLazDockZone;
1592           if AZone <> nil then
1593             BuildDockLayout(TLazDockZone(AZone.Parent));
1594         end;
1595       end;
1596     LM_SIZE, LM_MOVE:
1597       begin
1598         if GetControlHeaderRect(Sender, ARect) then
1599           InvalidateRect(DockSite.Handle, @ARect, False);
1600       end;
1601   end
1602 end;
1603 
1604 procedure TLazDockTree.DumpLayout(FileName: String);
1605 var
1606   Stream: TStream;
1607 
1608   procedure WriteLn(S: String);
1609   begin
1610     S := S + #$D#$A;
1611     Stream.Write(S[1], Length(S));
1612   end;
1613 
1614   procedure WriteHeader;
1615   begin
1616     WriteLn('<HTML>');
1617     WriteLn('<HEAD>');
1618     WriteLn('<TITLE>Dock Layout</TITLE>');
1619     WriteLn('<META content="text/html; charset=utf-8" http-equiv=Content-Type>');
1620     WriteLn('</HEAD>');
1621     WriteLn('<BODY>');
1622   end;
1623 
1624   procedure WriteFooter;
1625   begin
1626     WriteLn('</BODY>');
1627     WriteLn('</HTML>');
1628   end;
1629 
1630   procedure DumpAnchors(Title: String; AControl: TControl);
1631   var
1632     a: TAnchorKind;
1633     S, Name: String;
1634   begin
1635     S := Title;
1636     if AControl.Anchors <> [] then
1637     begin
1638       S := S + '<UL>';
1639       for a := Low(TAnchorKind) to High(TAnchorKind) do
1640         if a in AControl.Anchors then
1641         begin
1642           Name := DbgsName(AControl.AnchorSide[a].Control);
1643           if (AControl.AnchorSide[a].Control <> nil) and (AControl.AnchorSide[a].Control.Name = '') then
1644             Name := dbgs(AControl.AnchorSide[a].Control) + Name;
1645           S := S + '<LI><b>' + GetEnumName(TypeInfo(TAnchorKind), Ord(a)) + '</b> = ' +
1646              Name + ' (' +
1647              GetEnumName(TypeInfo(TAnchorSideReference), Ord(AControl.AnchorSide[a].Side)) +
1648              ')' + '</LI>';
1649         end;
1650       S := S + '</UL>';
1651     end
1652     else
1653       S := S + '[]';
1654     WriteLn(S);
1655   end;
1656 
1657   procedure DumpZone(Zone: TDockZone);
1658   const
1659     DumpStr = 'Zone: Orientation = <b>%s</b>, ChildCount = <b>%d</b>, ChildControl = <b>%s</b>, %s, Splitter = <b>%s</b>';
1660   var
1661     S: string;
1662   begin
1663     WriteStr(S, Zone.Orientation);
1664     WriteLn(Format(DumpStr, [S, Zone.ChildCount, DbgSName(Zone.ChildControl),
1665       DbgS(Bounds(Zone.Left, Zone.Top, Zone.Width, Zone.Height)),
1666       dbgs(TLazDockZone(Zone).Splitter)]));
1667     if TLazDockZone(Zone).Splitter <> nil then
1668       DumpAnchors('<br>Splitter anchors: ', TLazDockZone(Zone).Splitter);
1669     if Zone.ChildControl <> nil then
1670       DumpAnchors('<br>ChildControl anchors: ', Zone.ChildControl);
1671   end;
1672 
1673   procedure WriteZone(Zone: TDockZone);
1674   begin
1675     if Zone <> nil then
1676     begin
1677       WriteLn('<LI>');
1678       DumpZone(Zone);
1679       if Zone.ChildCount > 0 then
1680       begin
1681         WriteLn('<OL>');
1682         WriteZone(Zone.FirstChild);
1683         WriteLn('</OL>');
1684       end;
1685       WriteLn('</LI>');
1686       WriteZone(Zone.NextSibling);
1687     end;
1688   end;
1689 
1690   procedure WriteLayout;
1691   begin
1692     WriteLn('<OL>');
1693     WriteZone(RootZone);
1694     WriteLn('</OL>');
1695   end;
1696 
1697 begin
1698   Stream := TFileStream.Create(FileName, fmCreate);
1699   try
1700     WriteHeader;
1701     WriteLayout;
1702     WriteFooter;
1703   finally
1704     Stream.Free;
1705   end;
1706 end;
1707 
1708 { TLazDockZone }
1709 
1710 destructor TLazDockZone.Destroy;
1711 begin
1712   FreeSubComponents;
1713   inherited Destroy;
1714 end;
1715 
1716 procedure TLazDockZone.FreeSubComponents;
1717 begin
1718   FreeAndNil(FSplitter);
1719   FreeAndNil(FPage);
1720   FreeAndNil(FPages);
1721 end;
1722 
GetCaptionnull1723 function TLazDockZone.GetCaption: string;
1724 begin
1725   if ChildControl<>nil then
1726     Result:=ChildControl.Caption
1727   else
1728     Result:=IntToStr(GetIndex);
1729 end;
1730 
GetParentControlnull1731 function TLazDockZone.GetParentControl: TWinControl;
1732 var
1733   Zone: TDockZone;
1734 begin
1735   Result := nil;
1736   Zone := Parent;
1737   while Zone <> nil do
1738   begin
1739     if Zone.Orientation = doPages then
1740       Exit((Zone as TLazDockZone).Pages);
1741 
1742     if (Zone.Parent = nil) then
1743     begin
1744       if Zone.ChildControl is TWinControl then
1745         Result := TWinControl(Zone.ChildControl)
1746       else
1747       if Zone = Tree.RootZone then
1748         Result := Tree.DockSite;
1749       Exit;
1750     end;
1751     Zone := Zone.Parent;
1752   end;
1753 end;
1754 
1755 { TLazDockPage }
1756 
GetPageControlnull1757 function TLazDockPage.GetPageControl: TLazDockPages;
1758 begin
1759   Result:=Parent as TLazDockPages;
1760 end;
1761 
1762 procedure TLazDockPage.InsertControl(AControl: TControl; Index: integer);
1763 begin
1764   inherited InsertControl(AControl, Index);
1765   TLazDockForm.UpdateMainControlInParents(Self);
1766 end;
1767 
1768 { TLazDockForm }
1769 
1770 procedure TLazDockForm.SetMainControl(const AValue: TControl);
1771 var
1772   NewValue: TControl;
1773 begin
1774   if (AValue<>nil) and (not IsParentOf(AValue)) then
1775     raise Exception.Create('invalid main control');
1776   NewValue:=AValue;
1777   if NewValue=nil then
1778     NewValue:=FindMainControlCandidate;
1779   if FMainControl=NewValue then exit;
1780   FMainControl:=NewValue;
1781   if FMainControl<>nil then
1782     FMainControl.FreeNotification(Self);
1783   UpdateCaption;
1784 end;
1785 
1786 procedure TLazDockForm.PaintWindow(DC: HDC);
1787 var
1788   i: Integer;
1789   Control: TControl;
1790   ACanvas: TCanvas;
1791   Pt: TPoint;
1792 begin
1793   inherited PaintWindow(DC);
1794   ACanvas:=nil;
1795   try
1796     for i := 0 to ControlCount-1 do
1797     begin
1798       Control := Controls[i];
1799       if not ControlHasTitle(Control) then
1800         continue;
1801 
1802       if ACanvas = nil then
1803       begin
1804         ACanvas := TCanvas.Create;
1805         ACanvas.Handle := DC;
1806       end;
1807       GetCursorPos(Pt);
1808       Pt := ScreenToClient(Pt);
1809       TDockHeader.Draw(ACanvas, Control.Caption, FDockHeaderImages,
1810         GetTitleOrientation(Control), GetTitleRect(Control), Pt);
1811     end;
1812   finally
1813     ACanvas.Free;
1814   end;
1815 end;
1816 
1817 procedure TLazDockForm.Notification(AComponent: TComponent;
1818   Operation: TOperation);
1819 begin
1820   if (Operation=opRemove) then begin
1821     if AComponent=FMainControl then
1822       MainControl:=nil;
1823   end;
1824   inherited Notification(AComponent, Operation);
1825 end;
1826 
1827 procedure TLazDockForm.InsertControl(AControl: TControl; Index: integer);
1828 begin
1829   inherited InsertControl(AControl, Index);
1830   UpdateMainControl;
1831 end;
1832 
1833 procedure TLazDockForm.UpdateMainControl;
1834 var
1835   NewMainControl: TControl;
1836 begin
1837   if (FMainControl=nil) or (not FMainControl.IsVisible) then begin
1838     NewMainControl:=FindMainControlCandidate;
1839     if NewMainControl<>nil then
1840       MainControl:=NewMainControl;
1841   end;
1842 end;
1843 
CloseQuerynull1844 function TLazDockForm.CloseQuery: boolean;
1845 // query all top level forms, if form can close
1846 
1847   function QueryForms(ParentControl: TWinControl): boolean;
1848   var
1849     i: Integer;
1850     AControl: TControl;
1851   begin
1852     for i:=0 to ParentControl.ControlCount-1 do begin
1853       AControl:=ParentControl.Controls[i];
1854       if (AControl is TWinControl) then begin
1855         if (AControl is TCustomForm) then begin
1856           // a top level form: query and do not ask children
1857           if (not TCustomForm(AControl).CloseQuery) then
1858             exit(false);
1859         end
1860         else if not QueryForms(TWinControl(AControl)) then
1861           // search children for forms
1862           exit(false);
1863       end;
1864     end;
1865     Result:=true;
1866   end;
1867 
1868 begin
1869   Result:=inherited CloseQuery;
1870   if Result then
1871     Result:=QueryForms(Self);
1872 end;
1873 
1874 procedure TLazDockForm.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
1875   Y: Integer);
1876 var
1877   Part: TLazDockHeaderPart;
1878   Control: TControl;
1879 begin
1880   inherited MouseUp(Button, Shift, X, Y);
1881   TrackMouse(X, Y);
1882   if Button = mbLeft then
1883   begin
1884     Control := FindHeader(X, Y, Part);
1885     if (Control <> nil) then
1886       TDockHeader.PerformMouseUp(Control, Part);
1887   end;
1888 end;
1889 
1890 procedure TLazDockForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
1891   Y: Integer);
1892 var
1893   Part: TLazDockHeaderPart;
1894   Control: TControl;
1895 begin
1896   inherited MouseDown(Button, Shift, X, Y);
1897   TrackMouse(X, Y);
1898   if Button = mbLeft then
1899   begin
1900     Control := FindHeader(X, Y, Part);
1901     if (Control <> nil) then
1902       TDockHeader.PerformMouseDown(Control, Part);
1903   end;
1904 end;
1905 
1906 procedure TLazDockForm.MouseMove(Shift: TShiftState; X, Y: Integer);
1907 begin
1908   inherited MouseMove(Shift, X, Y);
1909   TrackMouse(X, Y);
1910 end;
1911 
1912 procedure TLazDockForm.MouseLeave;
1913 begin
1914   inherited MouseLeave;
1915   TrackMouse(-1, -1);
1916 end;
1917 
1918 procedure TLazDockForm.TrackMouse(X, Y: Integer);
1919 var
1920   Control: TControl;
1921   Part: TLazDockHeaderPart;
1922   ARect: TRect;
1923   NewMouseState: TDockHeaderMouseState;
1924 begin
1925   Control := FindHeader(X, Y, Part);
1926   FillChar(NewMouseState,SizeOf(NewMouseState),0);
1927   if (Control <> nil) then
1928   begin
1929     ARect := GetTitleRect(Control);
1930     ARect := TDockHeader.GetRectOfPart(ARect, GetTitleOrientation(Control), Part);
1931     NewMouseState.Rect := ARect;
1932     NewMouseState.IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
1933   end;
1934   if not CompareMem(@FMouseState, @NewMouseState, SizeOf(NewMouseState)) then
1935   begin
1936     if not CompareRect(@FMouseState.Rect, @NewMouseState.Rect) then
1937       InvalidateRect(Handle, @FMouseState.Rect, False);
1938     FMouseState := NewMouseState;
1939     InvalidateRect(Handle, @NewMouseState.Rect, False);
1940   end;
1941 end;
1942 
1943 constructor TLazDockForm.Create(AOwner: TComponent);
1944 begin
1945   inherited Create(AOwner);
1946   FillChar(FMouseState, SizeOf(FMouseState), 0);
1947   TDockHeader.CreateDockHeaderImages(FDockHeaderImages);
1948 end;
1949 
1950 destructor TLazDockForm.Destroy;
1951 begin
1952   TDockHeader.DestroyDockHeaderImages(FDockHeaderImages);
1953   inherited Destroy;
1954 end;
1955 
1956 procedure TLazDockForm.UpdateCaption;
1957 begin
1958   if FMainControl<>nil then
1959     Caption:=FMainControl.Caption
1960   else
1961     Caption:='';
1962 end;
1963 
1964 class procedure TLazDockForm.UpdateMainControlInParents(StartControl: TControl);
1965 var
1966   Form: TLazDockForm;
1967 begin
1968   while StartControl<>nil do begin
1969     if (StartControl is TLazDockForm) then
1970     begin
1971       Form:=TLazDockForm(StartControl);
1972       if (Form.MainControl=nil)
1973       or (not Form.MainControl.IsVisible) then
1974         Form.UpdateMainControl;
1975     end;
1976     StartControl:=StartControl.Parent;
1977   end;
1978 end;
1979 
FindMainControlCandidatenull1980 function TLazDockForm.FindMainControlCandidate: TControl;
1981 var
1982   BestLevel: integer;
1983 
1984   procedure FindCandidate(ParentControl: TWinControl; Level: integer);
1985   var
1986     i: Integer;
1987     AControl: TControl;
1988     ResultIsForm, ControlIsForm: boolean;
1989   begin
1990     for i:=0 to ParentControl.ControlCount-1 do begin
1991       AControl:=ParentControl.Controls[i];
1992       //DebugLn(['FindCandidate ParentControl=',DbgSName(ParentControl),' AControl=',DbgSName(AControl)]);
1993       if (not AControl.IsControlVisible) then continue;
1994       if ((AControl.Name<>'') or (AControl.Caption<>''))
1995       and (not (AControl is TLazDockForm))
1996       and (not (AControl is TLazDockSplitter))
1997       and (not (AControl is TLazDockPages))
1998       and (not (AControl is TLazDockPage))
1999       then begin
2000         // this is a candidate
2001         // prefer forms and top level controls
2002         if (Application<>nil) and (Application.MainForm=AControl) then begin
2003           // the MainForm is the best control
2004           Result:=Application.MainForm;
2005           BestLevel:=-1;
2006           exit;
2007         end;
2008         ResultIsForm:=Result is TCustomForm;
2009         ControlIsForm:=AControl is TCustomForm;
2010         if (Result=nil)
2011         or ((not ResultIsForm) and ControlIsForm)
2012         or ((ResultIsForm=ControlIsForm) and (Level<BestLevel))
2013         then begin
2014           BestLevel:=Level;
2015           Result:=AControl;
2016         end;
2017       end;
2018       if AControl is TWinControl then
2019         FindCandidate(TWinControl(AControl),Level+1);
2020     end;
2021   end;
2022 
2023 begin
2024   Result:=nil;
2025   BestLevel:=High(Integer);
2026   FindCandidate(Self,0);
2027 end;
2028 
FindHeadernull2029 function TLazDockForm.FindHeader(x, y: integer; out Part: TLazDockHeaderPart): TControl;
2030 var
2031   i: Integer;
2032   Control: TControl;
2033   TitleRect: TRect;
2034   p: TPoint;
2035   Orientation: TDockOrientation;
2036 begin
2037   for i := 0 to ControlCount-1 do
2038   begin
2039     Control := Controls[i];
2040     if not ControlHasTitle(Control) then
2041       Continue;
2042     TitleRect := GetTitleRect(Control);
2043     p := Point(X,Y);
2044     if not PtInRect(TitleRect, p) then
2045       Continue;
2046     // on header
2047     // => check sub parts
2048     Result := Control;
2049     Orientation := GetTitleOrientation(Control);
2050     Part := TDockHeader.FindPart(TitleRect, p, Orientation);
2051     Exit;
2052   end;
2053   Result := nil;
2054 end;
2055 
IsDockedControlnull2056 function TLazDockForm.IsDockedControl(Control: TControl): boolean;
2057 // checks if control is a child, not a TLazDockSplitter and properly anchor docked
2058 var
2059   a: TAnchorKind;
2060   AnchorControl: TControl;
2061 begin
2062   Result:=false;
2063   if (Control.Anchors<>[akLeft,akRight,akBottom,akTop])
2064   or (Control.Parent<>Self) then
2065     exit;
2066   for a:=low(TAnchorKind) to high(TAnchorKind) do begin
2067     AnchorControl:=Control.AnchorSide[a].Control;
2068     if (AnchorControl=nil) then exit;
2069     if (AnchorControl<>Self) and (not (AnchorControl is TLazDockSplitter)) then
2070       exit;
2071   end;
2072   Result:=true;
2073 end;
2074 
ControlHasTitlenull2075 function TLazDockForm.ControlHasTitle(Control: TControl): boolean;
2076 begin
2077   Result:=Control.Visible
2078            and IsDockedControl(Control)
2079            and ((Control.BorderSpacing.Left>0) or (Control.BorderSpacing.Top>0));
2080 end;
2081 
GetTitleRectnull2082 function TLazDockForm.GetTitleRect(Control: TControl): TRect;
2083 begin
2084   Result := Control.BoundsRect;
2085   if Control.BorderSpacing.Top > 0 then
2086   begin
2087     Result.Top := Control.Top - Control.BorderSpacing.Top;
2088     Result.Bottom := Control.Top;
2089   end else
2090   begin
2091     Result.Left := Control.Left - Control.BorderSpacing.Left;
2092     Result.Right := Control.Left;
2093   end;
2094 end;
2095 
GetTitleOrientationnull2096 function TLazDockForm.GetTitleOrientation(Control: TControl): TDockOrientation;
2097 begin
2098   if Control.BorderSpacing.Top > 0 then
2099     Result := doHorizontal
2100   else
2101   if Control.BorderSpacing.Left > 0 then
2102     Result := doVertical
2103   else
2104     Result := doNoOrient;
2105 end;
2106 
2107 { TLazDockSplitter }
2108 
2109 constructor TLazDockSplitter.Create(AOwner: TComponent);
2110 begin
2111   inherited Create(AOwner);
2112   MinSize := 1;
2113 end;
2114 
2115 initialization
2116   DefaultDockManagerClass := TLazDockTree;
2117 end.
2118