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;
173     procedure Change; override;
174   public
175     constructor Create(TheOwner: TComponent); override;
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(
770   const AValue: TLazDockPage);
771 begin
772   ActivePageComponent:=AValue;
773 end;
774 
TLazDockPages.GetFloatingDockSiteClassnull775 function TLazDockPages.GetFloatingDockSiteClass: TWinControlClass;
776 begin
777   Result:=TLazDockForm;
778 end;
779 
780 procedure TLazDockPages.Change;
781 begin
782   inherited Change;
783   TLazDockForm.UpdateMainControlInParents(Self);
784 end;
785 
786 constructor TLazDockPages.Create(TheOwner: TComponent);
787 begin
788   PageClass := TLazDockPage;
789   inherited Create(TheOwner);
790 end;
791 
792 { TLazDockTree }
793 
794 procedure TLazDockTree.UndockControlForDocking(AControl: TControl);
795 var
796   AWinControl: TWinControl;
797   Sibling: TControl;
798   a: TAnchorKind;
799   i: Integer;
800 begin
801   DebugLn(['TLazDockTree.UndockControlForDocking AControl=',DbgSName(AControl),' AControl.Parent=',DbgSName(AControl.Parent)]);
802   // undock AControl
803   if AControl is TWinControl then
804   begin
805     AWinControl := TWinControl(AControl);
806     if (AWinControl.DockManager<>nil) and (AWinControl.DockManager<>Self) then
807     begin
808       raise Exception.Create('TLazDockTree.UndockControlForDocking mixing docking managers is not supported');
809     end;
810   end;
811   if AControl.Parent <> nil then
812   begin
813     AControl.Parent := nil;
814   end;
815   for i:=AControl.AnchoredControlCount - 1 downto 0 do
816   begin
817     Sibling := AControl.AnchoredControls[i];
818     if (Sibling <> AControl.Parent) and (Sibling.Parent <> AControl) then
819     begin
820       for a := Low(TAnchorKind) to High(TAnchorKind) do
821         if Sibling.AnchorSide[a].Control = AControl then
822           Sibling.AnchorSide[a].Control := nil;
823     end;
824   end;
825 end;
826 
DefaultDockGrabberSizenull827 function TLazDockTree.DefaultDockGrabberSize: Integer;
828 begin
829   Result := {Abs(DockSite.Font.Height) + 4} 20;
830 end;
831 
832 procedure TLazDockTree.BreakAnchors(Zone: TDockZone);
833 begin
834   if Zone = nil then Exit;
835   if (Zone.ChildControl <> nil) and (Zone.ChildControl <> DockSite) then
836   begin
837     Zone.ChildControl.AnchorSide[akLeft].Control := nil;
838     Zone.ChildControl.AnchorSide[akTop].Control := nil;
839     Zone.ChildControl.Anchors := [akLeft, akTop];
840     Zone.ChildControl.BorderSpacing.Left := 0;
841     Zone.ChildControl.BorderSpacing.Top := 0;
842   end;
843   BreakAnchors(Zone.FirstChild);
844   BreakAnchors(Zone.NextSibling);
845 end;
846 
847 procedure TLazDockTree.PaintDockFrame(ACanvas: TCanvas; AControl: TControl; const ARect: TRect);
848 var
849   Pt: TPoint;
850 begin
851   GetCursorPos(Pt);
852   Pt := DockSite.ScreenToClient(Pt);
853   TDockHeader.Draw(ACanvas, DockSite.GetDockCaption(AControl), FDockHeaderImages,
854     AControl.DockOrientation, ARect, Pt);
855 end;
856 
857 procedure TLazDockTree.CreateDockLayoutHelperControls(Zone: TLazDockZone);
858 var
859   ParentPages: TLazDockPages;
860   ZoneIndex: LongInt;
861 begin
862   if Zone = nil then
863     Exit;
864 
865   // create needed TLazDockSplitter
866   if (Zone.Parent <> nil) and
867      (Zone.Parent.Orientation in [doVertical,doHorizontal]) and
868      (Zone.PrevSibling <> nil) then
869   begin
870     // a zone with a side sibling -> needs a TLazDockSplitter
871     if Zone.Splitter = nil then
872     begin
873       Zone.Splitter := TLazDockSplitter.Create(nil);
874       Zone.Splitter.Align := alNone;
875     end;
876   end
877   else
878   if Zone.Splitter <> nil then
879   begin
880     // zone no longer needs the splitter
881     Zone.Splitter.Free;
882     Zone.Splitter := nil;
883   end;
884 
885   // create needed TLazDockPages
886   if (Zone.Orientation = doPages) then
887   begin
888     // a zone of pages -> needs a TLazDockPages
889     if Zone.FirstChild = nil then
890       RaiseGDBException('TLazDockTree.CreateDockLayoutHelperControls Inconsistency: doPages without children');
891     if (Zone.Pages = nil) then
892       Zone.Pages:=TLazDockPages.Create(nil);
893   end
894   else
895   if Zone.Pages<>nil then
896   begin
897     // zone no longer needs the pages
898     Zone.Pages.Free;
899     Zone.Pages := nil;
900   end;
901 
902   // create needed TLazDockPage
903   if (Zone.Parent<>nil) and
904      (Zone.Parent.Orientation = doPages) then
905   begin
906     // a zone as page -> needs a TLazDockPage
907     if (Zone.Page = nil) then
908     begin
909       ParentPages := TLazDockZone(Zone.Parent).Pages;
910       ZoneIndex := Zone.GetIndex;
911       ParentPages.Pages.Insert(ZoneIndex,Zone.GetCaption);
912       Zone.Page := ParentPages.Page[ZoneIndex];
913     end;
914   end
915   else
916   if Zone.Page <> nil then
917   begin
918     // zone no longer needs the page
919     Zone.Page.Free;
920     Zone.Page := nil;
921   end;
922 
923   // create controls for children and siblings
924   CreateDockLayoutHelperControls(Zone.FirstChild as TLazDockZone);
925   CreateDockLayoutHelperControls(Zone.NextSibling as TLazDockZone);
926 end;
927 
928 procedure TLazDockTree.ResetSizes(Zone: TLazDockZone);
929 var
930   NewSize, NewPos: Integer;
931   Child: TLazDockZone;
932 begin
933   if Zone = nil then
934     Exit;
935 
936   // split available size between children
937   if (Zone.Orientation in [doHorizontal, doVertical]) and
938      (Zone.VisibleChildCount > 0) then
939   begin
940     NewSize := Zone.LimitSize div Zone.VisibleChildCount;
941     NewPos := Zone.LimitBegin;
942     Child := Zone.FirstChild as TLazDockZone;
943     while Child <> nil do
944     begin
945       if Child.Visible then
946       begin
947         case Zone.Orientation of
948           doHorizontal:
949             begin
950               Child.Top := NewPos;
951               Child.Height := NewSize;
952             end;
953           doVertical:
954             begin
955               Child.Left := NewPos;
956               Child.Width := NewSize;
957             end;
958         end;
959         ResetSizes(Child);
960         inc(NewPos, NewSize);
961       end;
962       Child := Child.NextSibling as TLazDockZone;
963     end;
964   end;
965 end;
966 
967 procedure TLazDockTree.AdjustDockRect(AControl: TControl; var ARect: TRect);
968 begin
969   // offset one of the borders of control rect in order to get space for frame
970   case AControl.DockOrientation of
971     doHorizontal:
972       Inc(ARect.Top, DefaultDockGrabberSize);
973     doVertical:
974       Inc(ARect.Left, DefaultDockGrabberSize);
975   end;
976 end;
977 
978 procedure TLazDockTree.AnchorDockLayout(Zone: TLazDockZone);
979 // setup all anchors between all docked controls and helper controls
980 const
981   SplitterWidth = 5;
982   SplitterHeight = 5;
983 var
984   AnchorControls: array[TAnchorKind] of TControl;
985   a: TAnchorKind;
986   SplitterSide: TAnchorKind;
987   CurControl: TControl;
988   NewSplitterAnchors: TAnchors;
989   NewAnchors: TAnchors;
990 begin
991   if Zone = nil then
992     Exit;
993 
994   if Zone.Pages <> nil then
995     CurControl := Zone.Pages
996   else
997     CurControl := Zone.ChildControl;
998   //DebugLn(['TLazDockTree.AnchorDockLayout CurControl=',DbgSName(CurControl),' DockSite=',DbgSName(DockSite)]);
999   if ((CurControl <> nil) and (CurControl <> DockSite)) or (Zone.Splitter <> nil) then
1000   begin
1001     // get outside anchor controls
1002     NewAnchors := [akLeft, akRight, akTop, akBottom];
1003     for a := Low(TAnchorKind) to High(TAnchorKind) do
1004       AnchorControls[a] := GetAnchorControl(Zone, a, true);
1005 
1006     // anchor splitter
1007     if (Zone.Splitter <> nil) then
1008     begin
1009       if Zone.Parent.Orientation = doHorizontal then
1010       begin
1011         SplitterSide := akTop;
1012         NewSplitterAnchors := [akLeft, akRight];
1013         Zone.Splitter.AnchorSide[akLeft].Side := asrTop;
1014         Zone.Splitter.AnchorSide[akRight].Side := asrBottom;
1015         Zone.Splitter.Height := SplitterHeight;
1016         if Zone.PrevSibling <> nil then
1017           Zone.Splitter.Top := (Zone.PrevSibling.Top + Zone.PrevSibling.Height) - DefaultDockGrabberSize;
1018         Zone.Splitter.ResizeAnchor := akBottom;
1019       end
1020       else
1021       begin
1022         SplitterSide := akLeft;
1023         NewSplitterAnchors := [akTop, akBottom];
1024         Zone.Splitter.AnchorSide[akTop].Side := asrTop;
1025         Zone.Splitter.AnchorSide[akBottom].Side := asrBottom;
1026         Zone.Splitter.Width := SplitterWidth;
1027         if Zone.PrevSibling <> nil then
1028           Zone.Splitter.Left := (Zone.PrevSibling.Left + Zone.PrevSibling.Width) - DefaultDockGrabberSize;
1029         Zone.Splitter.ResizeAnchor := akRight;
1030       end;
1031       // IMPORTANT: first set the AnchorSide, then set the Anchors
1032       for a := Low(TAnchorKind) to High(TAnchorKind) do
1033       begin
1034         if a in NewSplitterAnchors then
1035           Zone.Splitter.AnchorSide[a].Control := AnchorControls[a]
1036         else
1037           Zone.Splitter.AnchorSide[a].Control := nil;
1038       end;
1039       Zone.Splitter.Anchors := NewSplitterAnchors;
1040       Zone.Splitter.Parent := Zone.GetParentControl;
1041       AnchorControls[SplitterSide] := Zone.Splitter;
1042     end;
1043 
1044     if (CurControl <> nil) then
1045     begin
1046       // anchor pages
1047       // IMPORTANT: first set the AnchorSide, then set the Anchors
1048       //DebugLn(['TLazDockTree.AnchorDockLayout CurControl.Parent=',DbgSName(CurControl.Parent),' ',CurControl.Visible]);
1049       for a := Low(TAnchorKind) to High(TAnchorKind) do
1050       begin
1051         if AnchorControls[a] <> CurControl then
1052           CurControl.AnchorSide[a].Control := AnchorControls[a];
1053         if (AnchorControls[a] <> nil) and (AnchorControls[a].Parent = CurControl.Parent) then
1054           CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[a]
1055         else
1056           CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[OppositeAnchor[a]];
1057       end;
1058       CurControl.Anchors := NewAnchors;
1059       // set space for header
1060       case CurControl.DockOrientation of
1061         doHorizontal: CurControl.BorderSpacing.Top := DefaultDockGrabberSize;
1062         doVertical: CurControl.BorderSpacing.Left := DefaultDockGrabberSize;
1063       end;
1064     end;
1065   end;
1066 
1067   // anchor controls for children and siblings
1068   AnchorDockLayout(Zone.FirstChild as TLazDockZone);
1069   AnchorDockLayout(Zone.NextSibling as TLazDockZone);
1070 end;
1071 
1072 constructor TLazDockTree.Create(TheDockSite: TWinControl);
1073 begin
1074   FillChar(FMouseState, SizeOf(FMouseState), 0);
1075   TDockHeader.CreateDockHeaderImages(FDockHeaderImages);
1076   SetDockZoneClass(TLazDockZone);
1077   if TheDockSite = nil then
1078   begin
1079     TheDockSite := TLazDockForm.Create(nil);
1080     TheDockSite.DockManager := Self;
1081     FAutoFreeDockSite := True;
1082   end;
1083   inherited Create(TheDockSite);
1084 end;
1085 
1086 destructor TLazDockTree.Destroy;
1087 begin
1088   if FAutoFreeDockSite then
1089   begin
1090     if DockSite.DockManager = Self then
1091       DockSite.DockManager := nil;
1092     DockSite.Free;
1093     DockSite := nil;
1094   end;
1095   TDockHeader.DestroyDockHeaderImages(FDockHeaderImages);
1096   inherited Destroy;
1097 end;
1098 
1099 procedure TLazDockTree.InsertControl(AControl: TControl; InsertAt: TAlign;
1100   DropControl: TControl);
1101 { undocks AControl and docks it into the tree
1102   It creates a new TDockZone for AControl and inserts it as a new leaf.
1103   It automatically changes the tree, so that the parent of the new TDockZone
1104   will have the Orientation for InsertAt.
1105 
1106   Example 1:
1107 
1108     A newly created TLazDockTree has only a DockSite (TLazDockForm) and a single
1109     TDockZone - the RootZone, which has as ChildControl the DockSite.
1110 
1111     Visual:
1112       +-DockSite--+
1113       |           |
1114       +-----------+
1115     Tree of TDockZone:
1116       RootZone (DockSite,doNoOrient)
1117 
1118 
1119   Inserting the first control:  InsertControl(Form1,alLeft,nil);
1120     Visual:
1121       +-DockSite---+
1122       |+--Form1---+|
1123       ||          ||
1124       |+----------+|
1125       +------------+
1126     Tree of TDockZone:
1127       RootZone (DockSite,doHorizontal)
1128        +-Zone2 (Form1,doNoOrient)
1129 
1130 
1131   Dock Form2 right of Form1:  InsertControl(Form2,alLeft,Form1);
1132     Visual:
1133       +-DockSite----------+
1134       |+-Form1-+|+-Form2-+|
1135       ||        ||       ||
1136       |+-------+|+-------+|
1137       +-------------------+
1138     Tree of TDockZone:
1139       RootZone (DockSite,doHorizontal)
1140        +-Zone2 (Form1,doNoOrient)
1141        +-Zone3 (Form2,doNoOrient)
1142 }
1143 
1144   procedure PrepareControlForResize(AControl: TControl); inline;
1145   var
1146     a: TAnchorKind;
1147   begin
1148     AControl.Align := alNone;
1149     AControl.Anchors := [akLeft, akTop];
1150     for a := Low(TAnchorKind) to High(TAnchorKind) do
1151       AControl.AnchorSide[a].Control := nil;
1152     AControl.AutoSize := False;
1153   end;
1154 
1155 var
1156   CtlZone, DropZone, OldParentZone, NewParentZone: TDockZone;
1157   NewZone: TLazDockZone;
1158   NewOrientation: TDockOrientation;
1159   NeedNewParentZone: Boolean;
1160   NewBounds: TRect;
1161 begin
1162   CtlZone := RootZone.FindZone(AControl);
1163   if CtlZone <> nil then
1164     RemoveControl(AControl);
1165 
1166   if (DropControl = nil) or (DropControl = AControl) then
1167     DropControl := DockSite;
1168 
1169   DropZone := RootZone.FindZone(DropControl);
1170   if DropZone = nil then
1171     raise Exception.Create('TLazDockTree.InsertControl DropControl is not part of this TDockTree');
1172 
1173   NewOrientation := DockAlignOrientations[InsertAt];
1174 
1175   // undock
1176   UndockControlForDocking(AControl);
1177 
1178   // dock
1179   // create a new zone for AControl
1180   NewZone := DockZoneClass.Create(Self,AControl) as TLazDockZone;
1181 
1182   // insert new zone into tree
1183   if (DropZone = RootZone) and (RootZone.FirstChild = nil) then
1184   begin
1185     // this is the first child
1186     debugln('TLazDockTree.InsertControl First Child');
1187     //RootZone.Orientation := NewOrientation;
1188     RootZone.AddAsFirstChild(NewZone);
1189     AControl.DockOrientation := NewOrientation;
1190     if not AControl.Visible then
1191       DockSite.Visible := False;
1192 
1193     NewBounds := DockSite.ClientRect;
1194     AdjustDockRect(AControl, NewBounds);
1195     PrepareControlForResize(AControl);
1196 
1197     AControl.BoundsRect := NewBounds;
1198     AControl.Parent := DockSite;
1199 
1200     if AControl.Visible then
1201       DockSite.Visible := True;
1202   end else
1203   begin
1204     // there are already other children
1205 
1206     // optimize DropZone
1207     if (DropZone.ChildCount>0) and
1208        (NewOrientation in [doHorizontal,doVertical]) and
1209        (DropZone.Orientation in [NewOrientation, doNoOrient]) then
1210     begin
1211       // docking on a side of an inner node is the same as docking to a side of
1212       // a child
1213       if InsertAt in [alLeft,alTop] then
1214         DropZone := DropZone.FirstChild
1215       else
1216         DropZone := DropZone.GetLastChild;
1217     end;
1218 
1219     // insert a new Parent Zone if needed
1220     NeedNewParentZone := True;
1221     if (DropZone.Parent <> nil) then
1222     begin
1223       if (DropZone.Parent.Orientation = doNoOrient) then
1224         NeedNewParentZone := False;
1225       if (DropZone.Parent.Orientation = NewOrientation) then
1226         NeedNewParentZone := False;
1227     end;
1228     if NeedNewParentZone then
1229     begin
1230       // insert a new zone between current DropZone.Parent and DropZone
1231       // this new zone will become the new DropZone.Parent
1232       OldParentZone := DropZone.Parent;
1233       NewParentZone := DockZoneClass.Create(Self, nil);
1234       if OldParentZone <> nil then
1235         OldParentZone.ReplaceChild(DropZone, NewParentZone);
1236       NewParentZone.AddAsFirstChild(DropZone);
1237       if RootZone = DropZone then
1238         FRootZone := NewParentZone;
1239     end;
1240 
1241     if DropZone.Parent = nil then
1242       RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Parent=nil');
1243     // adjust Orientation in tree
1244     if DropZone.Parent.Orientation = doNoOrient then
1245     begin
1246       // child control already had orientation but now we moved it to parent
1247       // which can take another orientation => change child control orientation
1248       DropZone.Parent.Orientation := NewOrientation;
1249       if (DropZone.Parent.ChildCount = 1) and (DropZone.Parent.FirstChild.ChildControl <> nil) then
1250         DropZone.Parent.FirstChild.ChildControl.DockOrientation := NewOrientation;
1251     end;
1252     if DropZone.Parent.Orientation <> NewOrientation then
1253       RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Orientation<>NewOrientation');
1254 
1255     // insert new node
1256     //DoDi: should insert relative to dropzone, not at begin/end of the parent zone
1257     DropZone.AddSibling(NewZone, InsertAt);
1258 
1259     // add AControl to DockSite
1260     PrepareControlForResize(AControl);
1261     AControl.DockOrientation := NewOrientation;
1262     AControl.Parent := NewZone.GetParentControl;
1263   end;
1264 
1265   // Build dock layout (anchors, splitters, pages)
1266   if NewZone.Parent <> nil then
1267     BuildDockLayout(NewZone.Parent as TLazDockZone)
1268   else
1269     BuildDockLayout(RootZone as TLazDockZone);
1270 end;
1271 
1272 procedure TLazDockTree.RemoveControl(AControl: TControl);
1273 var
1274   RemoveZone, ParentZone: TLazDockZone;
1275 begin
1276   RemoveZone := RootZone.FindZone(AControl) as TLazDockZone;
1277 
1278   // no such control => exit
1279   if RemoveZone = nil then
1280     Exit;
1281 
1282   // has children
1283   if (RemoveZone.ChildCount > 0) then
1284     raise Exception.Create('TLazDockTree.RemoveControl RemoveZone.ChildCount > 0');
1285 
1286   // destroy child zone and all parents if they does not contain anything else
1287   while (RemoveZone <> RootZone) and
1288         (RemoveZone.ChildCount = 0) do
1289   begin
1290     ParentZone := RemoveZone.Parent as TLazDockZone;
1291     RemoveZone.FreeSubComponents;
1292     BreakAnchors(RemoveZone);
1293     if ParentZone <> nil then
1294       ParentZone.Remove(RemoveZone);
1295     RemoveZone.Free;
1296     // try with ParentZone now
1297     RemoveZone := ParentZone;
1298   end;
1299 
1300   // reset orientation
1301   if (RemoveZone.ChildCount = 1) and (RemoveZone.Orientation in [doHorizontal, doVertical]) then
1302     RemoveZone.Orientation := doNoOrient;
1303 
1304   // Build dock layout (anchors, splitters, pages)
1305   if (RemoveZone.Parent <> nil) then
1306     BuildDockLayout(RemoveZone.Parent as TLazDockZone)
1307   else
1308     BuildDockLayout(RootZone as TLazDockZone);
1309 end;
1310 
1311 procedure TLazDockTree.BuildDockLayout(Zone: TLazDockZone);
1312 begin
1313   if DockSite <> nil then
1314     DockSite.DisableAlign;
1315   try
1316     BreakAnchors(Zone);
1317     CreateDockLayoutHelperControls(Zone);
1318     ResetSizes(Zone);
1319     AnchorDockLayout(Zone);
1320   finally
1321     if DockSite <> nil then
1322     begin
1323       DockSite.EnableAlign;
1324       DockSite.Invalidate;
1325     end;
1326   end;
1327 end;
1328 
1329 procedure TLazDockTree.FindBorderControls(Zone: TLazDockZone; Side: TAnchorKind;
1330   var List: TFPList);
1331 begin
1332   if List=nil then List:=TFPList.Create;
1333   if Zone=nil then exit;
1334 
1335   if (Zone.Splitter<>nil) and (Zone.Parent<>nil)
1336   and (Zone.Orientation=doVertical) then begin
1337     // this splitter is leftmost, topmost, bottommost
1338     if Side in [akLeft,akTop,akBottom] then
1339       List.Add(Zone.Splitter);
1340     if Side=akLeft then begin
1341       // the splitter fills the whole left side => no more controls
1342       exit;
1343     end;
1344   end;
1345   if (Zone.Splitter<>nil) and (Zone.Parent<>nil)
1346   and (Zone.Orientation=doHorizontal) then begin
1347     // this splitter is topmost, leftmost, rightmost
1348     if Side in [akTop,akLeft,akRight] then
1349       List.Add(Zone.Splitter);
1350     if Side=akTop then begin
1351       // the splitter fills the whole top side => no more controls
1352       exit;
1353     end;
1354   end;
1355   if Zone.ChildControl<>nil then begin
1356     // the ChildControl fills the whole zone (except for the splitter)
1357     List.Add(Zone.ChildControl);
1358     exit;
1359   end;
1360   if Zone.Pages<>nil then begin
1361     // the pages fills the whole zone (except for the splitter)
1362     List.Add(Zone.Pages);
1363     exit;
1364   end;
1365 
1366   // go recursively through all child zones
1367   if (Zone.Parent<>nil) and (Zone.Orientation in [doVertical,doHorizontal])
1368   and (Zone.FirstChild<>nil) then
1369   begin
1370     if Side in [akLeft,akTop] then
1371       FindBorderControls(Zone.FirstChild as TLazDockZone,Side,List)
1372     else
1373       FindBorderControls(Zone.GetLastChild as TLazDockZone,Side,List);
1374   end;
1375 end;
1376 
FindBorderControlnull1377 function TLazDockTree.FindBorderControl(Zone: TLazDockZone; Side: TAnchorKind
1378   ): TControl;
1379 var
1380   List: TFPList;
1381 begin
1382   Result:=nil;
1383   if Zone=nil then exit;
1384   List:=nil;
1385   FindBorderControls(Zone,Side,List);
1386   if (List=nil) or (List.Count=0) then
1387     Result:=DockSite
1388   else
1389     Result:=TControl(List[0]);
1390   List.Free;
1391 end;
1392 
GetAnchorControlnull1393 function TLazDockTree.GetAnchorControl(Zone: TLazDockZone; Side: TAnchorKind;
1394   OutSide: boolean): TControl;
1395 // find a control to anchor the Zone's Side
1396 begin
1397   if Zone = nil then
1398   begin
1399     Result := DockSite;
1400     exit;
1401   end;
1402 
1403   if not OutSide then
1404   begin
1405     // also check the Splitter and the Page
1406     if (Side = akLeft) and (Zone.Parent <> nil) and
1407        (Zone.Parent.Orientation = doVertical) and (Zone.Splitter<>nil) then
1408     begin
1409       Result := Zone.Splitter;
1410       exit;
1411     end;
1412     if (Side = akTop) and (Zone.Parent<>nil) and
1413        (Zone.Parent.Orientation=doHorizontal) and (Zone.Splitter<>nil) then
1414     begin
1415       Result := Zone.Splitter;
1416       exit;
1417     end;
1418     if (Zone.Page <> nil) then
1419     begin
1420       Result := Zone.Page;
1421       exit;
1422     end;
1423   end;
1424 
1425   // search the neighbour zones:
1426   Result := DockSite;
1427   if (Zone.Parent = nil) then
1428     Exit;
1429 
1430   case Zone.Parent.Orientation of
1431     doHorizontal:
1432       if (Side=akTop) and (Zone.PrevSibling<>nil) then
1433         Result:=FindBorderControl(Zone.PrevSibling as TLazDockZone,akBottom)
1434       else if (Side=akBottom) and (Zone.NextSibling<>nil) then
1435         Result:=FindBorderControl(Zone.NextSibling as TLazDockZone,akTop)
1436       else
1437         Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
1438     doVertical:
1439       if (Side=akLeft) and (Zone.PrevSibling<>nil) then
1440         Result:=FindBorderControl(Zone.PrevSibling as TLazDockZone,akRight)
1441       else if (Side=akRight) and (Zone.NextSibling<>nil) then
1442         Result:=FindBorderControl(Zone.NextSibling as TLazDockZone,akLeft)
1443       else
1444         Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
1445     doPages:
1446       Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
1447   end;
1448 end;
1449 
1450 procedure TLazDockTree.PaintSite(DC: HDC);
1451 var
1452   ACanvas: TCanvas;
1453   ARect: TRect;
1454   i: integer;
1455 begin
1456   // paint bounds for each control and close button
1457   if DockSite.ControlCount > 0 then
1458   begin
1459     ACanvas := TCanvas.Create;
1460     ACanvas.Handle := DC;
1461     try
1462       for i := 0 to DockSite.ControlCount - 1 do
1463       begin
1464         if (DockSite.Controls[i].HostDockSite = DockSite) and
1465            (DockSite.Controls[i].Visible) then
1466         begin
1467           ARect := DockSite.Controls[i].BoundsRect;
1468           case DockSite.Controls[i].DockOrientation of
1469             doHorizontal:
1470               begin
1471                 ARect.Bottom := ARect.Top;
1472                 Dec(ARect.Top, DefaultDockGrabberSize);
1473               end;
1474             doVertical:
1475               begin
1476                 ARect.Right := ARect.Left;
1477                 Dec(ARect.Left, DefaultDockGrabberSize);
1478               end;
1479           end;
1480           PaintDockFrame(ACanvas, DockSite.Controls[i], ARect);
1481         end;
1482       end;
1483     finally
1484       ACanvas.Free;
1485     end;
1486   end;
1487 end;
1488 
1489 procedure TLazDockTree.MessageHandler(Sender: TControl; var Message: TLMessage);
1490 
1491   procedure CheckNeedRedraw(AControl: TControl; ARect: TRect; APart: TLazDockHeaderPart);
1492   var
1493     NewMouseState: TDockHeaderMouseState;
1494   begin
1495     if AControl = nil then
1496       FillChar(ARect, SizeOf(ARect), 0)
1497     else
1498       ARect := TDockHeader.GetRectOfPart(ARect, AControl.DockOrientation, APart);
1499     // we cannot directly redraw this part since we should paint only in paint events
1500     FillChar(NewMouseState, SizeOf(NewMouseState), 0);
1501     NewMouseState.Rect := ARect;
1502     NewMouseState.IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
1503     if not CompareMem(@FMouseState, @NewMouseState, SizeOf(NewMouseState)) then
1504     begin
1505       if not CompareRect(@FMouseState.Rect, @NewMouseState.Rect) then
1506         InvalidateRect(DockSite.Handle, @FMouseState.Rect, False);
1507       FMouseState := NewMouseState;
1508       InvalidateRect(DockSite.Handle, @NewMouseState.Rect, False);
1509     end;
1510   end;
1511 
1512   function GetControlHeaderRect(AControl: TControl; out ARect: TRect): Boolean;
1513   begin
1514     Result := True;
1515     ARect := AControl.BoundsRect;
1516     case AControl.DockOrientation of
1517       doHorizontal:
1518         begin
1519           ARect.Bottom := ARect.Top;
1520           Dec(ARect.Top, DefaultDockGrabberSize);
1521         end;
1522       doVertical:
1523         begin
1524           ARect.Right := ARect.Left;
1525           Dec(ARect.Left, DefaultDockGrabberSize);
1526         end;
1527       else
1528         Result := False;
1529     end;
1530   end;
1531 
1532   function FindControlAndPart(MouseMsg: TLMMouse; out ARect: TRect; out APart: TLazDockHeaderPart): TControl;
1533   var
1534     i: integer;
1535     Pt: TPoint;
1536   begin
1537     Pt := SmallPointToPoint(MouseMsg.Pos);
1538     for i := 0 to DockSite.ControlCount - 1 do
1539     begin
1540       if DockSite.Controls[i].HostDockSite = DockSite then
1541       begin
1542         if not GetControlHeaderRect(DockSite.Controls[i], ARect) then
1543           Continue;
1544         if not PtInRect(ARect, Pt) then
1545           Continue;
1546         // we have control here
1547         Result := DockSite.Controls[i];
1548         APart := TDockHeader.FindPart(ARect, Pt, DockSite.Controls[i].DockOrientation);
1549         Exit;
1550       end;
1551     end;
1552     Result := nil;
1553   end;
1554 
1555 var
1556   ARect: TRect;
1557   Part: TLazDockHeaderPart;
1558   Control: TControl;
1559   AZone: TLazDockZone;
1560 begin
1561   case Message.msg of
1562     LM_LBUTTONUP:
1563       begin
1564         Control := FindControlAndPart(TLMMouse(Message), ARect, Part);
1565         CheckNeedRedraw(Control, ARect, Part);
1566         TDockHeader.PerformMouseUp(Control, Part);
1567       end;
1568     LM_LBUTTONDOWN:
1569       begin
1570         Control := FindControlAndPart(TLMMouse(Message), ARect, Part);
1571         CheckNeedRedraw(Control, ARect, Part);
1572         TDockHeader.PerformMouseDown(Control, Part);
1573       end;
1574     LM_MOUSEMOVE:
1575       begin
1576         Control := FindControlAndPart(TLMMouse(Message), ARect, Part);
1577         CheckNeedRedraw(Control, ARect, Part);
1578       end;
1579     CM_MOUSELEAVE:
1580       CheckNeedRedraw(nil, Rect(0,0,0,0), ldhpAll);
1581     CM_TEXTCHANGED:
1582       begin
1583         if GetControlHeaderRect(Sender, ARect) then
1584         begin
1585           ARect := TDockHeader.GetRectOfPart(ARect, Sender.DockOrientation, ldhpCaption);
1586           InvalidateRect(DockSite.Handle, @ARect, False);
1587         end;
1588       end;
1589     CM_VISIBLECHANGED:
1590       begin
1591         if not (csDestroying in Sender.ComponentState) then
1592         begin
1593           AZone := RootZone.FindZone(Sender) as TLazDockZone;
1594           if AZone <> nil then
1595             BuildDockLayout(TLazDockZone(AZone.Parent));
1596         end;
1597       end;
1598     LM_SIZE, LM_MOVE:
1599       begin
1600         if GetControlHeaderRect(Sender, ARect) then
1601           InvalidateRect(DockSite.Handle, @ARect, False);
1602       end;
1603   end
1604 end;
1605 
1606 procedure TLazDockTree.DumpLayout(FileName: String);
1607 var
1608   Stream: TStream;
1609 
1610   procedure WriteLn(S: String);
1611   begin
1612     S := S + #$D#$A;
1613     Stream.Write(S[1], Length(S));
1614   end;
1615 
1616   procedure WriteHeader;
1617   begin
1618     WriteLn('<HTML>');
1619     WriteLn('<HEAD>');
1620     WriteLn('<TITLE>Dock Layout</TITLE>');
1621     WriteLn('<META content="text/html; charset=utf-8" http-equiv=Content-Type>');
1622     WriteLn('</HEAD>');
1623     WriteLn('<BODY>');
1624   end;
1625 
1626   procedure WriteFooter;
1627   begin
1628     WriteLn('</BODY>');
1629     WriteLn('</HTML>');
1630   end;
1631 
1632   procedure DumpAnchors(Title: String; AControl: TControl);
1633   var
1634     a: TAnchorKind;
1635     S, Name: String;
1636   begin
1637     S := Title;
1638     if AControl.Anchors <> [] then
1639     begin
1640       S := S + '<UL>';
1641       for a := Low(TAnchorKind) to High(TAnchorKind) do
1642         if a in AControl.Anchors then
1643         begin
1644           Name := DbgsName(AControl.AnchorSide[a].Control);
1645           if (AControl.AnchorSide[a].Control <> nil) and (AControl.AnchorSide[a].Control.Name = '') then
1646             Name := dbgs(AControl.AnchorSide[a].Control) + Name;
1647           S := S + '<LI><b>' + GetEnumName(TypeInfo(TAnchorKind), Ord(a)) + '</b> = ' +
1648              Name + ' (' +
1649              GetEnumName(TypeInfo(TAnchorSideReference), Ord(AControl.AnchorSide[a].Side)) +
1650              ')' + '</LI>';
1651         end;
1652       S := S + '</UL>';
1653     end
1654     else
1655       S := S + '[]';
1656     WriteLn(S);
1657   end;
1658 
1659   procedure DumpZone(Zone: TDockZone);
1660   const
1661     DumpStr = 'Zone: Orientation = <b>%s</b>, ChildCount = <b>%d</b>, ChildControl = <b>%s</b>, %s, Splitter = <b>%s</b>';
1662   var
1663     S: string;
1664   begin
1665     WriteStr(S, Zone.Orientation);
1666     WriteLn(Format(DumpStr, [S, Zone.ChildCount, DbgSName(Zone.ChildControl),
1667       DbgS(Bounds(Zone.Left, Zone.Top, Zone.Width, Zone.Height)),
1668       dbgs(TLazDockZone(Zone).Splitter)]));
1669     if TLazDockZone(Zone).Splitter <> nil then
1670       DumpAnchors('<br>Splitter anchors: ', TLazDockZone(Zone).Splitter);
1671     if Zone.ChildControl <> nil then
1672       DumpAnchors('<br>ChildControl anchors: ', Zone.ChildControl);
1673   end;
1674 
1675   procedure WriteZone(Zone: TDockZone);
1676   begin
1677     if Zone <> nil then
1678     begin
1679       WriteLn('<LI>');
1680       DumpZone(Zone);
1681       if Zone.ChildCount > 0 then
1682       begin
1683         WriteLn('<OL>');
1684         WriteZone(Zone.FirstChild);
1685         WriteLn('</OL>');
1686       end;
1687       WriteLn('</LI>');
1688       WriteZone(Zone.NextSibling);
1689     end;
1690   end;
1691 
1692   procedure WriteLayout;
1693   begin
1694     WriteLn('<OL>');
1695     WriteZone(RootZone);
1696     WriteLn('</OL>');
1697   end;
1698 
1699 begin
1700   Stream := TFileStream.Create(FileName, fmCreate);
1701   try
1702     WriteHeader;
1703     WriteLayout;
1704     WriteFooter;
1705   finally
1706     Stream.Free;
1707   end;
1708 end;
1709 
1710 { TLazDockZone }
1711 
1712 destructor TLazDockZone.Destroy;
1713 begin
1714   FreeSubComponents;
1715   inherited Destroy;
1716 end;
1717 
1718 procedure TLazDockZone.FreeSubComponents;
1719 begin
1720   FreeAndNil(FSplitter);
1721   FreeAndNil(FPage);
1722   FreeAndNil(FPages);
1723 end;
1724 
GetCaptionnull1725 function TLazDockZone.GetCaption: string;
1726 begin
1727   if ChildControl<>nil then
1728     Result:=ChildControl.Caption
1729   else
1730     Result:=IntToStr(GetIndex);
1731 end;
1732 
GetParentControlnull1733 function TLazDockZone.GetParentControl: TWinControl;
1734 var
1735   Zone: TDockZone;
1736 begin
1737   Result := nil;
1738   Zone := Parent;
1739   while Zone <> nil do
1740   begin
1741     if Zone.Orientation = doPages then
1742       Exit((Zone as TLazDockZone).Pages);
1743 
1744     if (Zone.Parent = nil) then
1745     begin
1746       if Zone.ChildControl is TWinControl then
1747         Result := TWinControl(Zone.ChildControl)
1748       else
1749       if Zone = Tree.RootZone then
1750         Result := Tree.DockSite;
1751       Exit;
1752     end;
1753     Zone := Zone.Parent;
1754   end;
1755 end;
1756 
1757 { TLazDockPage }
1758 
GetPageControlnull1759 function TLazDockPage.GetPageControl: TLazDockPages;
1760 begin
1761   Result:=Parent as TLazDockPages;
1762 end;
1763 
1764 procedure TLazDockPage.InsertControl(AControl: TControl; Index: integer);
1765 begin
1766   inherited InsertControl(AControl, Index);
1767   TLazDockForm.UpdateMainControlInParents(Self);
1768 end;
1769 
1770 { TLazDockForm }
1771 
1772 procedure TLazDockForm.SetMainControl(const AValue: TControl);
1773 var
1774   NewValue: TControl;
1775 begin
1776   if (AValue<>nil) and (not IsParentOf(AValue)) then
1777     raise Exception.Create('invalid main control');
1778   NewValue:=AValue;
1779   if NewValue=nil then
1780     NewValue:=FindMainControlCandidate;
1781   if FMainControl=NewValue then exit;
1782   FMainControl:=NewValue;
1783   if FMainControl<>nil then
1784     FMainControl.FreeNotification(Self);
1785   UpdateCaption;
1786 end;
1787 
1788 procedure TLazDockForm.PaintWindow(DC: HDC);
1789 var
1790   i: Integer;
1791   Control: TControl;
1792   ACanvas: TCanvas;
1793   Pt: TPoint;
1794 begin
1795   inherited PaintWindow(DC);
1796   ACanvas:=nil;
1797   try
1798     for i := 0 to ControlCount-1 do
1799     begin
1800       Control := Controls[i];
1801       if not ControlHasTitle(Control) then
1802         continue;
1803 
1804       if ACanvas = nil then
1805       begin
1806         ACanvas := TCanvas.Create;
1807         ACanvas.Handle := DC;
1808       end;
1809       GetCursorPos(Pt);
1810       Pt := ScreenToClient(Pt);
1811       TDockHeader.Draw(ACanvas, Control.Caption, FDockHeaderImages,
1812         GetTitleOrientation(Control), GetTitleRect(Control), Pt);
1813     end;
1814   finally
1815     ACanvas.Free;
1816   end;
1817 end;
1818 
1819 procedure TLazDockForm.Notification(AComponent: TComponent;
1820   Operation: TOperation);
1821 begin
1822   if (Operation=opRemove) then begin
1823     if AComponent=FMainControl then
1824       MainControl:=nil;
1825   end;
1826   inherited Notification(AComponent, Operation);
1827 end;
1828 
1829 procedure TLazDockForm.InsertControl(AControl: TControl; Index: integer);
1830 begin
1831   inherited InsertControl(AControl, Index);
1832   UpdateMainControl;
1833 end;
1834 
1835 procedure TLazDockForm.UpdateMainControl;
1836 var
1837   NewMainControl: TControl;
1838 begin
1839   if (FMainControl=nil) or (not FMainControl.IsVisible) then begin
1840     NewMainControl:=FindMainControlCandidate;
1841     if NewMainControl<>nil then
1842       MainControl:=NewMainControl;
1843   end;
1844 end;
1845 
CloseQuerynull1846 function TLazDockForm.CloseQuery: boolean;
1847 // query all top level forms, if form can close
1848 
1849   function QueryForms(ParentControl: TWinControl): boolean;
1850   var
1851     i: Integer;
1852     AControl: TControl;
1853   begin
1854     for i:=0 to ParentControl.ControlCount-1 do begin
1855       AControl:=ParentControl.Controls[i];
1856       if (AControl is TWinControl) then begin
1857         if (AControl is TCustomForm) then begin
1858           // a top level form: query and do not ask children
1859           if (not TCustomForm(AControl).CloseQuery) then
1860             exit(false);
1861         end
1862         else if not QueryForms(TWinControl(AControl)) then
1863           // search children for forms
1864           exit(false);
1865       end;
1866     end;
1867     Result:=true;
1868   end;
1869 
1870 begin
1871   Result:=inherited CloseQuery;
1872   if Result then
1873     Result:=QueryForms(Self);
1874 end;
1875 
1876 procedure TLazDockForm.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
1877   Y: Integer);
1878 var
1879   Part: TLazDockHeaderPart;
1880   Control: TControl;
1881 begin
1882   inherited MouseUp(Button, Shift, X, Y);
1883   TrackMouse(X, Y);
1884   if Button = mbLeft then
1885   begin
1886     Control := FindHeader(X, Y, Part);
1887     if (Control <> nil) then
1888       TDockHeader.PerformMouseUp(Control, Part);
1889   end;
1890 end;
1891 
1892 procedure TLazDockForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
1893   Y: Integer);
1894 var
1895   Part: TLazDockHeaderPart;
1896   Control: TControl;
1897 begin
1898   inherited MouseDown(Button, Shift, X, Y);
1899   TrackMouse(X, Y);
1900   if Button = mbLeft then
1901   begin
1902     Control := FindHeader(X, Y, Part);
1903     if (Control <> nil) then
1904       TDockHeader.PerformMouseDown(Control, Part);
1905   end;
1906 end;
1907 
1908 procedure TLazDockForm.MouseMove(Shift: TShiftState; X, Y: Integer);
1909 begin
1910   inherited MouseMove(Shift, X, Y);
1911   TrackMouse(X, Y);
1912 end;
1913 
1914 procedure TLazDockForm.MouseLeave;
1915 begin
1916   inherited MouseLeave;
1917   TrackMouse(-1, -1);
1918 end;
1919 
1920 procedure TLazDockForm.TrackMouse(X, Y: Integer);
1921 var
1922   Control: TControl;
1923   Part: TLazDockHeaderPart;
1924   ARect: TRect;
1925   NewMouseState: TDockHeaderMouseState;
1926 begin
1927   Control := FindHeader(X, Y, Part);
1928   FillChar(NewMouseState,SizeOf(NewMouseState),0);
1929   if (Control <> nil) then
1930   begin
1931     ARect := GetTitleRect(Control);
1932     ARect := TDockHeader.GetRectOfPart(ARect, GetTitleOrientation(Control), Part);
1933     NewMouseState.Rect := ARect;
1934     NewMouseState.IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0;
1935   end;
1936   if not CompareMem(@FMouseState, @NewMouseState, SizeOf(NewMouseState)) then
1937   begin
1938     if not CompareRect(@FMouseState.Rect, @NewMouseState.Rect) then
1939       InvalidateRect(Handle, @FMouseState.Rect, False);
1940     FMouseState := NewMouseState;
1941     InvalidateRect(Handle, @NewMouseState.Rect, False);
1942   end;
1943 end;
1944 
1945 constructor TLazDockForm.Create(AOwner: TComponent);
1946 begin
1947   inherited Create(AOwner);
1948   FillChar(FMouseState, SizeOf(FMouseState), 0);
1949   TDockHeader.CreateDockHeaderImages(FDockHeaderImages);
1950 end;
1951 
1952 destructor TLazDockForm.Destroy;
1953 begin
1954   TDockHeader.DestroyDockHeaderImages(FDockHeaderImages);
1955   inherited Destroy;
1956 end;
1957 
1958 procedure TLazDockForm.UpdateCaption;
1959 begin
1960   if FMainControl<>nil then
1961     Caption:=FMainControl.Caption
1962   else
1963     Caption:='';
1964 end;
1965 
1966 class procedure TLazDockForm.UpdateMainControlInParents(StartControl: TControl);
1967 var
1968   Form: TLazDockForm;
1969 begin
1970   while StartControl<>nil do begin
1971     if (StartControl is TLazDockForm) then
1972     begin
1973       Form:=TLazDockForm(StartControl);
1974       if (Form.MainControl=nil)
1975       or (not Form.MainControl.IsVisible) then
1976         Form.UpdateMainControl;
1977     end;
1978     StartControl:=StartControl.Parent;
1979   end;
1980 end;
1981 
FindMainControlCandidatenull1982 function TLazDockForm.FindMainControlCandidate: TControl;
1983 var
1984   BestLevel: integer;
1985 
1986   procedure FindCandidate(ParentControl: TWinControl; Level: integer);
1987   var
1988     i: Integer;
1989     AControl: TControl;
1990     ResultIsForm, ControlIsForm: boolean;
1991   begin
1992     for i:=0 to ParentControl.ControlCount-1 do begin
1993       AControl:=ParentControl.Controls[i];
1994       //DebugLn(['FindCandidate ParentControl=',DbgSName(ParentControl),' AControl=',DbgSName(AControl)]);
1995       if (not AControl.IsControlVisible) then continue;
1996       if ((AControl.Name<>'') or (AControl.Caption<>''))
1997       and (not (AControl is TLazDockForm))
1998       and (not (AControl is TLazDockSplitter))
1999       and (not (AControl is TLazDockPages))
2000       and (not (AControl is TLazDockPage))
2001       then begin
2002         // this is a candidate
2003         // prefer forms and top level controls
2004         if (Application<>nil) and (Application.MainForm=AControl) then begin
2005           // the MainForm is the best control
2006           Result:=Application.MainForm;
2007           BestLevel:=-1;
2008           exit;
2009         end;
2010         ResultIsForm:=Result is TCustomForm;
2011         ControlIsForm:=AControl is TCustomForm;
2012         if (Result=nil)
2013         or ((not ResultIsForm) and ControlIsForm)
2014         or ((ResultIsForm=ControlIsForm) and (Level<BestLevel))
2015         then begin
2016           BestLevel:=Level;
2017           Result:=AControl;
2018         end;
2019       end;
2020       if AControl is TWinControl then
2021         FindCandidate(TWinControl(AControl),Level+1);
2022     end;
2023   end;
2024 
2025 begin
2026   Result:=nil;
2027   BestLevel:=High(Integer);
2028   FindCandidate(Self,0);
2029 end;
2030 
FindHeadernull2031 function TLazDockForm.FindHeader(x, y: integer; out Part: TLazDockHeaderPart): TControl;
2032 var
2033   i: Integer;
2034   Control: TControl;
2035   TitleRect: TRect;
2036   p: TPoint;
2037   Orientation: TDockOrientation;
2038 begin
2039   for i := 0 to ControlCount-1 do
2040   begin
2041     Control := Controls[i];
2042     if not ControlHasTitle(Control) then
2043       Continue;
2044     TitleRect := GetTitleRect(Control);
2045     p := Point(X,Y);
2046     if not PtInRect(TitleRect, p) then
2047       Continue;
2048     // on header
2049     // => check sub parts
2050     Result := Control;
2051     Orientation := GetTitleOrientation(Control);
2052     Part := TDockHeader.FindPart(TitleRect, p, Orientation);
2053     Exit;
2054   end;
2055   Result := nil;
2056 end;
2057 
IsDockedControlnull2058 function TLazDockForm.IsDockedControl(Control: TControl): boolean;
2059 // checks if control is a child, not a TLazDockSplitter and properly anchor docked
2060 var
2061   a: TAnchorKind;
2062   AnchorControl: TControl;
2063 begin
2064   Result:=false;
2065   if (Control.Anchors<>[akLeft,akRight,akBottom,akTop])
2066   or (Control.Parent<>Self) then
2067     exit;
2068   for a:=low(TAnchorKind) to high(TAnchorKind) do begin
2069     AnchorControl:=Control.AnchorSide[a].Control;
2070     if (AnchorControl=nil) then exit;
2071     if (AnchorControl<>Self) and (not (AnchorControl is TLazDockSplitter)) then
2072       exit;
2073   end;
2074   Result:=true;
2075 end;
2076 
ControlHasTitlenull2077 function TLazDockForm.ControlHasTitle(Control: TControl): boolean;
2078 begin
2079   Result:=Control.Visible
2080            and IsDockedControl(Control)
2081            and ((Control.BorderSpacing.Left>0) or (Control.BorderSpacing.Top>0));
2082 end;
2083 
GetTitleRectnull2084 function TLazDockForm.GetTitleRect(Control: TControl): TRect;
2085 begin
2086   Result := Control.BoundsRect;
2087   if Control.BorderSpacing.Top > 0 then
2088   begin
2089     Result.Top := Control.Top - Control.BorderSpacing.Top;
2090     Result.Bottom := Control.Top;
2091   end else
2092   begin
2093     Result.Left := Control.Left - Control.BorderSpacing.Left;
2094     Result.Right := Control.Left;
2095   end;
2096 end;
2097 
GetTitleOrientationnull2098 function TLazDockForm.GetTitleOrientation(Control: TControl): TDockOrientation;
2099 begin
2100   if Control.BorderSpacing.Top > 0 then
2101     Result := doHorizontal
2102   else
2103   if Control.BorderSpacing.Left > 0 then
2104     Result := doVertical
2105   else
2106     Result := doNoOrient;
2107 end;
2108 
2109 { TLazDockSplitter }
2110 
2111 constructor TLazDockSplitter.Create(AOwner: TComponent);
2112 begin
2113   inherited Create(AOwner);
2114   MinSize := 1;
2115 end;
2116 
2117 initialization
2118   DefaultDockManagerClass := TLazDockTree;
2119 end.
2120