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