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