1 { Unit implementing anchor docking.
2
3 Copyright (C) 2018 Mattias Gaertner mattias@freepascal.org
4
5 This library is free software; you can redistribute it and/or modify it
6 under the terms of the GNU Library General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or (at your
8 option) any later version with the following modification:
9
10 As a special exception, the copyright holders of this library give you
11 permission to link this library with independent modules to produce an
12 executable, regardless of the license terms of these independent modules,and
13 to copy and distribute the resulting executable under terms of your choice,
14 provided that you also meet, for each linked independent module, the terms
15 and conditions of the license of that module. An independent module is a
16 module which is not derived from or based on this library. If you modify
17 this library, you may extend this exception to your version of the library,
18 but you are not obligated to do so. If you do not wish to do so, delete this
19 exception statement from your version.
20
21 This program is distributed in the hope that it will be useful, but WITHOUT
22 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
23 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
24 for more details.
25
26 You should have received a copy of the GNU Library General Public License
27 along with this library; if not, write to the Free Software Foundation,
28 Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
29
30 Features:
31 - dnd docking
32 - preview rectangle while drag over
33 - inside and outside docking
34 - header with close button and hints
35 - using stock item for close button glyph
36 - auto header caption from content
37 - hide header caption for floating form
38 - auto site for headers to safe space (configurable)
39 - bidimode for headers
40 - page docking
41 - pagecontrols uses TPageControl for native look&feel
42 - page control is automatically removed if only one page left
43 - scaling on resize (configurable)
44 - auto insert splitters between controls (size configurable)
45 - keep size when docking
46 - header is automatically hidden when docked into page
47 - save complete layout
48 - restore layout:
49 - close unneeded windows,
50 - automatic clean up if windows are missing,
51 - reusing existing docksites to minimize flickering
52 - popup menu
53 - close site
54 - lock/unlock
55 - header auto, left, top, right, bottom
56 - undock (needed if no place to undock on screen)
57 - merge (for example after moving a dock page into a layout)
58 - enlarge side to left, top, right, bottom
59 - move page left, right, leftmost, rightmost
60 - close page
61 - tab position (default, left, top, right, bottom)
62 - options
63 - dock site: MakeDockSite for forms, that should be able to dock other sites,
64 but should not be docked themselves. Their Parent is always nil.
65 - design time package for IDE
66 - dnd move page index
67 - dnd move page to another pagecontrol
68 - on close button: save a restore layout
69 - option to show/hide dock headers
70 - option HeaderStyle to change appearance of grabbers
71 - option MultiLine show pages tabs on multiple lines when needed
72 - option FloatingWindowsOnTop MainDockForm has FormStyle fsNormal, all other
73 not docked windows get FormStyle fsStayOnTop to not hide helper windows
74
75 ToDo:
76 - option to save on IDE close (if MainForm is visible on active screen)
77 - restore: put MainForm on active screen
78 - restore custom dock site splitter without resizing content, only resize docked site
79 - undock on hide
80 - popup menu
81 - shrink side left, top, right, bottom
82 - implement a simple way to make forms dockable at designtime without any code
83 - on show again (hide form, show form): restore layout
84 - close button for pages
85 - event for drawing grabbers+headers
86 - save/restore other splitters
87
88 Parent bug with links to all other:
89 - http://bugs.freepascal.org/view.php?id=18298 default layout sometimes wrong main bar
90 Other bugs:
91 - http://bugs.freepascal.org/view.php?id=19810 multi monitor
92 }
93 unit AnchorDocking;
94
95 {$mode objfpc}{$H+}
96 {$modeswitch advancedrecords}
97 {$modeswitch typehelpers}
98
99 // better use this definitions in project options, as it used in other units too
100 { $DEFINE VerboseAnchorDockRestore}
101 { $DEFINE VerboseADCustomSite}
102 { $DEFINE VerboseAnchorDockPages}
103 { $DEFINE VerboseAnchorDocking}
104 { $DEFINE VerboseADFloatingWindowsOnTop}
105
106 interface
107
108 uses
109 Math, Classes, SysUtils, types, fgl,
110 LCLType, LCLIntf, LCLProc,
111 Controls, Forms, ExtCtrls, ComCtrls, Graphics, Themes, Menus, Buttons,
112 LazConfigStorage, Laz2_XMLCfg, LazFileCache, LazUTF8,
113 AnchorDockStr, AnchorDockStorage, AnchorDockPanel;
114
115 {$IFDEF DebugDisableAutoSizing}
116 const ADAutoSizingReason = 'TAnchorDockMaster Delayed';
117 {$ENDIF}
118
119 const EmptyMouseTimeStartX=low(Integer);
120 MouseNoMoveDelta=5;
121 MouseNoMoveTime=500;
122 HideOverlappingFormByMouseLoseTime=500;
123 ButtonBorderSpacingAround=4;
124 OppositeAnchorKind2Align: array[TAnchorKind] of TAlign = (
125 alBottom, // akTop,
126 alRight, // akLeft,
127 alLeft, // akRight,
128 alTop // akBottom
129 );
130 OppositeAnchorKind: array[TAnchorKind] of TAnchorKind = (
131 akBottom, // akTop,
132 akRight, // akLeft,
133 akLeft, // akRight,
134 akTop // akBottom
135 );
136 {AnchorKind2Align: array[TAnchorKind] of TAlign = (
137 alTop, // akTop,
138 alLeft, // akLeft,
139 alRight,// akRight,
140 alBottom// akBottom
141 );}
142 OppositeAnchorKind2TADLHeaderPosition: array[TAnchorKind] of TADLHeaderPosition = (
143 adlhpBottom, // akTop,
144 adlhpRight, // akLeft,
145 adlhpLeft, // akRight,
146 adlhpTop // akBottom
147 );
148
149
150 type
151 TAnchorDockHostSite = class;
152
153 { TAnchorDockCloseButton
154 Close button used in TAnchorDockHeader, uses the close button glyph of the
155 theme shrinked to a small size. The glyph is shared by all close buttons. }
156
157 TAnchorDockCloseButton = class(TCustomSpeedButton)
158 protected
GetDrawDetailsnull159 function GetDrawDetails: TThemedElementDetails; override;
160 procedure CalculatePreferredSize(var PreferredWidth,
161 PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override;
162 end;
163
164 TAnchorDockMinimizeButton = class(TCustomSpeedButton)
165 protected
GetDrawDetailsnull166 function GetDrawDetails: TThemedElementDetails; override;
167 procedure CalculatePreferredSize(var PreferredWidth,
168 PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override;
169 end;
170
171
172 { TAnchorDockHeader
173 The panel of a TAnchorDockHostSite containing the close button and the
174 caption when the form is docked. The header can be shown at any of the four
175 sides, shows a hint for long captions, starts dragging and shows the popup
176 menu of the dockmaster.
177 Hiding and aligning is done by its Parent, which is a TAnchorDockHostSite }
178
179 THeaderStyleName=string;
180
181 TADHeaderStyleDesc=record
182 NeedDrawHeaderAfterText,NeedHighlightText:boolean;
183 Name:THeaderStyleName;
184 end;
185
186 TDrawADHeaderProc= procedure (Canvas: TCanvas; Style: TADHeaderStyleDesc; r: TRect;
187 Horizontal: boolean; Focused: boolean);
188
189 TADHeaderStyle=record
190 StyleDesc:TADHeaderStyleDesc;
191 DrawProc:TDrawADHeaderProc;
192 end;
193
194 THeaderStyleName2ADHeaderStylesMap=specialize TFPGMap<THeaderStyleName, TADHeaderStyle>;
195
196 type
197
198 TAnchorDockHeader = class(TCustomPanel)
199 private
200 FCloseButton: TCustomSpeedButton;
201 FMinimizeButton: TCustomSpeedButton;
202 FHeaderPosition: TADLHeaderPosition;
203 FFocused: Boolean;
204 FUseTimer: Boolean;
205 FMouseTimeStartX,FMouseTimeStartY:Integer;
206 procedure CloseButtonClick(Sender: TObject);
207 procedure MinimizeButtonClick(Sender: TObject);
208 procedure HeaderPositionItemClick(Sender: TObject);
209 procedure UndockButtonClick(Sender: TObject);
210 procedure MergeButtonClick(Sender: TObject);
211 procedure EnlargeSideClick(Sender: TObject);
212 procedure SetHeaderPosition(const AValue: TADLHeaderPosition);
213 protected
214 procedure Paint; override;
215 procedure Draw(HeaderStyle:TADHeaderStyle);
216 procedure CalculatePreferredSize(var PreferredWidth,
217 PreferredHeight: integer; WithThemeSpace: Boolean); override;
218 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,
219 Y: Integer); override;
220 procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
221 procedure MouseLeave; override;
222 procedure StartMouseNoMoveTimer;
223 procedure StopMouseNoMoveTimer;
224 procedure DoMouseNoMoveTimer(Sender: TObject);
225 procedure UpdateHeaderControls;
226 procedure SetAlign(Value: TAlign); override;
227 procedure DoOnShowHint(HintInfo: PHintInfo); override;
228 procedure PopupMenuPopup(Sender: TObject); virtual;
229 public
230 constructor Create(TheOwner: TComponent); override;
231 property CloseButton: TCustomSpeedButton read FCloseButton;
232 property MinimizeButton: TCustomSpeedButton read FMinimizeButton;
233 property HeaderPosition: TADLHeaderPosition read FHeaderPosition write SetHeaderPosition;
234 property BevelOuter default bvNone;
235 end;
236 TAnchorDockHeaderClass = class of TAnchorDockHeader;
237
238 { TAnchorDockSplitter
239 A TSplitter used on a TAnchorDockHostSite with SiteType=adhstLayout.
240 It can store DockBounds, used by its parent to scale. Scaling works by
241 moving the splitters. All other controls are fully anchored to these
242 splitters or their parent. }
243
244 TAnchorDockSplitter = class(TCustomSplitter)
245 private
246 FAsyncUpdateDockBounds: boolean;
247 FCustomWidth: Boolean;
248 FDockBounds: TRect;
249 FDockParentClientSize: TSize;
250 FDockRestoreBounds: TRect;
251 FPercentPosition: Single;
252 procedure SetAsyncUpdateDockBounds(const AValue: boolean);
253 procedure UpdatePercentPosition;
254 protected
255 procedure OnAsyncUpdateDockBounds({%H-}Data: PtrInt);
256 procedure SetResizeAnchor(const AValue: TAnchorKind); override;
257 procedure SetParent(NewParent: TWinControl); override;
258 procedure PopupMenuPopup(Sender: TObject); virtual;
259 procedure Paint; override;
260 public
261 procedure MoveSplitter(Offset: integer); override;
262 public
263 constructor Create(TheOwner: TComponent); override;
264 destructor Destroy; override;
265 property DockBounds: TRect read FDockBounds;
266 property DockParentClientSize: TSize read FDockParentClientSize;
267 procedure UpdateDockBounds;
268 property AsyncUpdateDockBounds: boolean read FAsyncUpdateDockBounds write SetAsyncUpdateDockBounds;
269 procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; // any normal movement sets the DockBounds
270 procedure SetBoundsPercentually;
271 procedure SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer); // movement for scaling keeps the DockBounds
SideAnchoredControlCountnull272 function SideAnchoredControlCount(Side: TAnchorKind): integer;
HasAnchoredControlsnull273 function HasAnchoredControls: boolean;
GetSpliterBoundsWithUnminimizedDockSitesnull274 function GetSpliterBoundsWithUnminimizedDockSites:TRect;
275 procedure SaveLayout(LayoutNode: TAnchorDockLayoutTreeNode);
HasOnlyOneSiblingnull276 function HasOnlyOneSibling(Side: TAnchorKind; MinPos, MaxPos: integer): TControl;
277 property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds;
278 property CustomWidth: Boolean read FCustomWidth write FCustomWidth;
279 // Increase visibility of TCustomSplitter events:
280 property OnMouseWheel;
281 property OnMouseWheelDown;
282 property OnMouseWheelUp;
283 end;
284 TAnchorDockSplitterClass = class of TAnchorDockSplitter;
285
286 TAnchorDockPageControl = class;
287 { TAnchorDockPage
288 A page of a TAnchorDockPageControl. }
289
290 TAnchorDockPage = class(TCustomPage)
291 public
292 procedure UpdateDockCaption(Exclude: TControl = nil); override;
293 procedure InsertControl(AControl: TControl; Index: integer); override;
294 procedure RemoveControl(AControl: TControl); override;
GetSitenull295 function GetSite: TAnchorDockHostSite;
296 end;
297 TAnchorDockPageClass = class of TAnchorDockPage;
298
299 { TAnchorDockPageControl
300 Used for page docking.
301 The parent is always a TAnchorDockHostSite with SiteType=adhstPages.
302 Its children are all TAnchorDockPage.
303 It shows the DockMaster popup menu and starts dragging. }
304
305 TAnchorDockPageControl = class(TCustomTabControl)
306 private
GetDockPagesnull307 function GetDockPages(Index: integer): TAnchorDockPage;
308 protected
309 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
310 procedure PopupMenuPopup(Sender: TObject); virtual;
311 procedure CloseButtonClick(Sender: TObject); virtual;
312 procedure MoveLeftButtonClick(Sender: TObject); virtual;
313 procedure MoveLeftMostButtonClick(Sender: TObject); virtual;
314 procedure MoveRightButtonClick(Sender: TObject); virtual;
315 procedure MoveRightMostButtonClick(Sender: TObject); virtual;
316 procedure TabPositionClick(Sender: TObject); virtual;
GetPageClassnull317 function GetPageClass: TCustomPageClass;override;
318 public
319 constructor Create(TheOwner: TComponent); override;
320 procedure UpdateDockCaption(Exclude: TControl = nil); override;
321 property DockPages[Index: integer]: TAnchorDockPage read GetDockPages;
322 procedure RemoveControl(AControl: TControl); override;
GetActiveSitenull323 function GetActiveSite: TAnchorDockHostSite;
324 end;
325 TAnchorDockPageControlClass = class of TAnchorDockPageControl;
326
327
328 TAnchorDockOverlappingForm = class(TCustomForm)
329 public
330 AnchorDockHostSite:TAnchorDockHostSite;
331 Panel:TPanel;
332 constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
333 end;
334
335 { TAnchorDockHostSite
336 This form is the dockhostsite for all controls.
337 When docked together they build a tree structure with the docked controls
338 as leaf nodes.
339 A TAnchorDockHostSite has four modes: TAnchorDockHostSiteType }
340
341 TAnchorDockHostSiteType = (
342 adhstNone, // fresh created, no control docked
343 adhstOneControl, // a control and the "Header" (TAnchorDockHeader)
344 adhstLayout, // several controls/TAnchorDockHostSite separated by TAnchorDockSplitters
345 adhstPages // the "Pages" (TAnchorDockPageControl) with several pages
346 );
347
348 TAnchorDockHostSite = class(TCustomForm)
349 private
350 FDockRestoreBounds: TRect;
351 FHeader: TAnchorDockHeader;
352 FHeaderSide: TAnchorKind;
353 FPages: TAnchorDockPageControl;
354 FSiteType: TAnchorDockHostSiteType;
355 FBoundSplitter: TAnchorDockSplitter;
356 FUpdateLayout: Integer;
357 FMinimizedControl: TControl;
358 procedure CheckFormStyle;
359 procedure FirstShow(Sender: TObject);
GetMinimizednull360 function GetMinimized: Boolean;
361 procedure SetHeaderSide(const AValue: TAnchorKind);
362 protected
363 procedure DoEnter; override;
364 procedure DoExit; override;
365 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
DoDockClientMsgnull366 function DoDockClientMsg(DragDockObject: TDragDockObject;
367 aPosition: TPoint): boolean; override;
ExecuteDocknull368 function ExecuteDock(NewControl, DropOnControl: TControl; DockAlign: TAlign): boolean; virtual;
DockFirstControlnull369 function DockFirstControl(NewControl: TControl): boolean; virtual;
DockSecondControlnull370 function DockSecondControl(NewControl: TControl; DockAlign: TAlign;
371 Inside: boolean): boolean; virtual;
DockAnotherControlnull372 function DockAnotherControl(Sibling, NewControl: TControl; DockAlign: TAlign;
373 Inside: boolean): boolean; virtual;
374 procedure ChildVisibleChanged(Sender: TObject); virtual;
375 procedure CreatePages; virtual;
376 procedure FreePages; virtual;
DockSecondPagenull377 function DockSecondPage(NewControl: TControl): boolean; virtual;
DockAnotherPagenull378 function DockAnotherPage(NewControl: TControl; InFrontOf: TControl): boolean; virtual;
379 procedure AddCleanControl(AControl: TControl; TheAlign: TAlign = alNone);
380 procedure RemoveControlFromLayout(AControl: TControl);
381 procedure RemoveMinimizedControl;
382 procedure RemoveSpiralSplitter(AControl: TControl);
383 procedure ClearChildControlAnchorSides(AControl: TControl);
384 procedure Simplify;
385 procedure SimplifyPages;
386 procedure SimplifyOneControl;
GetOneControlnull387 function GetOneControl: TControl;
GetSiteCountnull388 function GetSiteCount: integer;
IsOneSiteLayoutnull389 function IsOneSiteLayout(out Site: TAnchorDockHostSite): boolean;
IsTwoSiteLayoutnull390 function IsTwoSiteLayout(out Site1, Site2: TAnchorDockHostSite): boolean;
GetUniqueSplitterNamenull391 function GetUniqueSplitterName: string;
MakeSitenull392 function MakeSite(AControl: TControl): TAnchorDockHostSite;
393 procedure MoveAllControls(dx, dy: integer);
394 procedure AlignControls(AControl: TControl; var ARect: TRect); override;
CheckIfOneControlHiddennull395 function CheckIfOneControlHidden: boolean;
396 procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); override;
397 procedure SetParent(NewParent: TWinControl); override;
HeaderNeedsShowingnull398 function HeaderNeedsShowing: boolean;
399 procedure DoClose(var CloseAction: TCloseAction); override;
CanUndocknull400 function CanUndock: boolean;
401 procedure Undock;
CanMergenull402 function CanMerge: boolean;
403 procedure Merge;
EnlargeSidenull404 function EnlargeSide(Side: TAnchorKind;
405 OnlyCheckIfPossible: boolean): boolean;
EnlargeSideResizeTwoSplittersnull406 function EnlargeSideResizeTwoSplitters(ShrinkSplitterSide,
407 EnlargeSpitterSide: TAnchorKind;
408 OnlyCheckIfPossible: boolean): boolean;
EnlargeSideRotateSplitternull409 function EnlargeSideRotateSplitter(Side: TAnchorKind;
410 OnlyCheckIfPossible: boolean): boolean;
411 procedure CreateBoundSplitter(Disabled: boolean=false);
412 procedure PositionBoundSplitter;
413 public
414 constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
415 destructor Destroy; override;
CloseQuerynull416 function CloseQuery: boolean; override;
CloseSitenull417 function CloseSite: boolean; virtual;
418 procedure MinimizeSite; virtual;
419 procedure AsyncMinimizeSite({%H-}Data: PtrInt);
420 procedure ShowMinimizedControl;
421 procedure HideMinimizedControl;
422 procedure RemoveControl(AControl: TControl); override;
423 procedure InsertControl(AControl: TControl; Index: integer); override;
424 procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
425 MousePos: TPoint; var CanDock: Boolean); override;
GetPageAreanull426 function GetPageArea: TRect;
427 procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer;
428 KeepBase: boolean); override;
429 procedure UpdateDockCaption(Exclude: TControl = nil); override;
430 procedure UpdateHeaderAlign;
431 procedure UpdateHeaderShowing;
CanBeMinimizednull432 function CanBeMinimized(out Splitter: TAnchorDockSplitter; out SplitterAnchorKind:TAnchorKind):boolean;
433 procedure BeginUpdateLayout;
434 procedure EndUpdateLayout;
UpdatingLayoutnull435 function UpdatingLayout: boolean;
436
437 // save/restore layout
438 procedure SaveLayout(LayoutTree: TAnchorDockLayoutTree;
439 LayoutNode: TAnchorDockLayoutTreeNode);
440 property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds;
GetDockEdgenull441 function GetDockEdge(const MousePos: TPoint): TAlign; override;
442
443 property HeaderSide: TAnchorKind read FHeaderSide write SetHeaderSide;
444 property Header: TAnchorDockHeader read FHeader;
445 property Minimized: Boolean read GetMinimized;
446 property MinimizedControl: TControl read FMinimizedControl;
447 property Pages: TAnchorDockPageControl read FPages;
448 property SiteType: TAnchorDockHostSiteType read FSiteType;
449 property BoundSplitter: TAnchorDockSplitter read FBoundSplitter;
450 end;
451 TAnchorDockHostSiteClass = class of TAnchorDockHostSite;
452
453 TADMResizePolicy = (
454 admrpNone,
455 admrpChild // resize child
456 );
457
458 { TAnchorDockManager
459 A TDockManager is the LCL connector to catch various docking events for a
460 TControl. Every TAnchorDockHostSite and every custom dock site gets one
461 TAnchorDockManager. The LCL frees it automatically when the Site is freed. }
462
463 TAnchorDockManager = class(TDockManager)
464 private
465 FDockableSites: TAnchors;
466 FDockSite: TAnchorDockHostSite;
467 FInsideDockingAllowed: boolean;
468 FPreferredSiteSizeAsSiteMinimum: boolean;
469 FResizePolicy: TADMResizePolicy;
470 FStoredConstraints: TRect;
471 FSite: TWinControl;
472 FSiteClientRect: TRect;
473 procedure SetPreferredSiteSizeAsSiteMinimum(const AValue: boolean);
474 public
475 constructor Create(ADockSite: TWinControl); override;
476 procedure GetControlBounds(Control: TControl; out AControlBounds: TRect);
477 override;
478 procedure InsertControl(Control: TControl; InsertAt: TAlign;
479 DropCtl: TControl); override; overload;
480 procedure InsertControl(ADockObject: TDragDockObject); override; overload;
481 procedure LoadFromStream(Stream: TStream); override;
482 procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
483 var DockRect: TRect); override; overload;
484 procedure RemoveControl(Control: TControl); override;
485 procedure ResetBounds(Force: Boolean); override;
486 procedure SaveToStream(Stream: TStream); override;
GetDockEdgenull487 function GetDockEdge(ADockObject: TDragDockObject): boolean; override;
488 procedure RestoreSite(SplitterPos: integer);
489 procedure StoreConstraints;
GetSitePreferredClientSizenull490 function GetSitePreferredClientSize: TPoint;
IsEnabledControlnull491 function IsEnabledControl(Control: TControl):Boolean; override;
492
493 property Site: TWinControl read FSite; // the associated TControl (a TAnchorDockHostSite or a custom dock site)
494 property DockSite: TAnchorDockHostSite read FDockSite; // if Site is a TAnchorDockHostSite, this is it
495 property DockableSites: TAnchors read FDockableSites write FDockableSites; // at which sides can be docked
496 property InsideDockingAllowed: boolean read FInsideDockingAllowed write FInsideDockingAllowed; // if true allow to put a site into the custom dock site
GetChildSitenull497 function GetChildSite: TAnchorDockHostSite; // get first child TAnchorDockHostSite
498 property ResizePolicy: TADMResizePolicy read FResizePolicy write FResizePolicy;
499 property StoredConstraints: TRect read FStoredConstraints write FStoredConstraints;
StoredConstraintsValidnull500 function StoredConstraintsValid: boolean;
501 property PreferredSiteSizeAsSiteMinimum: boolean read FPreferredSiteSizeAsSiteMinimum write SetPreferredSiteSizeAsSiteMinimum;
502 end;
503 TAnchorDockManagerClass = class of TAnchorDockManager;
504
505 { TAnchorDockSettings }
506
507 type
508 TAnchorDockSettings = class
509 private
510 FAllowDragging: boolean;
511 FChangeStamp: integer;
512 FDockOutsideMargin: integer;
513 FDockParentMargin: integer;
514 FDragTreshold: integer;
515 FFloatingWindowsOnTop: boolean;
516 FHeaderAlignLeft: integer;
517 FHeaderAlignTop: integer;
518 FHeaderHint: string;
519 FHeaderStyle: THeaderStyleName;
520 FHeaderFlatten: boolean;
521 FHeaderFilled: boolean;
522 FHeaderHighlightFocused: boolean;
523 FHideHeaderCaptionFloatingControl: boolean;
524 FMultiLinePages: boolean;
525 FPageAreaInPercent: integer;
526 FScaleOnResize: boolean;
527 FShowHeader: boolean;
528 FShowHeaderCaption: boolean;
529 FSplitterWidth: integer;
530 FDockSitesCanBeMinimized: boolean;
531 procedure SetAllowDragging(AValue: boolean);
532 procedure SetDockOutsideMargin(AValue: integer);
533 procedure SetDockParentMargin(AValue: integer);
534 procedure SetDragTreshold(AValue: integer);
535 procedure SetFloatingWindowsOnTop(AValue: boolean);
536 procedure SetHeaderAlignLeft(AValue: integer);
537 procedure SetHeaderAlignTop(AValue: integer);
538 procedure SetHeaderHint(AValue: string);
539 procedure SetHeaderStyle(AValue: THeaderStyleName);
540 procedure SetHideHeaderCaptionFloatingControl(AValue: boolean);
541 procedure SetMultiLinePages(AValue: boolean);
542 procedure SetPageAreaInPercent(AValue: integer);
543 procedure SetScaleOnResize(AValue: boolean);
544 procedure SetShowHeader(AValue: boolean);
545 procedure SetShowHeaderCaption(AValue: boolean);
546 procedure SetSplitterWidth(AValue: integer);
547 procedure SetHeaderFlatten(AValue: boolean);
548 procedure SetHeaderFilled(AValue: boolean);
549 procedure SetHeaderHighlightFocused(AValue: boolean);
550 procedure SetDockSitesCanBeMinimized(AValue: boolean);
551 public
552 property DragTreshold: integer read FDragTreshold write SetDragTreshold;
553 property DockOutsideMargin: integer read FDockOutsideMargin write SetDockOutsideMargin;
554 property DockParentMargin: integer read FDockParentMargin write SetDockParentMargin;
555 property PageAreaInPercent: integer read FPageAreaInPercent write SetPageAreaInPercent;
556 property HeaderAlignTop: integer read FHeaderAlignTop write SetHeaderAlignTop;
557 property HeaderAlignLeft: integer read FHeaderAlignLeft write SetHeaderAlignLeft;
558 property HeaderHint: string read FHeaderHint write SetHeaderHint;
559 property SplitterWidth: integer read FSplitterWidth write SetSplitterWidth;
560 property ScaleOnResize: boolean read FScaleOnResize write SetScaleOnResize;
561 property ShowHeader: boolean read FShowHeader write SetShowHeader;
562 property ShowHeaderCaption: boolean read FShowHeaderCaption write SetShowHeaderCaption;
563 property HideHeaderCaptionFloatingControl: boolean read FHideHeaderCaptionFloatingControl write SetHideHeaderCaptionFloatingControl;
564 property AllowDragging: boolean read FAllowDragging write SetAllowDragging;
565 property HeaderStyle: THeaderStyleName read FHeaderStyle write SetHeaderStyle;
566 property HeaderFlatten: boolean read FHeaderFlatten write SetHeaderFlatten;
567 property HeaderFilled: boolean read FHeaderFilled write SetHeaderFilled;
568 property HeaderHighlightFocused: boolean read FHeaderHighlightFocused write SetHeaderHighlightFocused;
569 property DockSitesCanBeMinimized: boolean read FDockSitesCanBeMinimized write SetDockSitesCanBeMinimized;
570 property FloatingWindowsOnTop: boolean read FFloatingWindowsOnTop write SetFloatingWindowsOnTop;
571 property MultiLinePages: boolean read FMultiLinePages write SetMultiLinePages;
572 procedure IncreaseChangeStamp; inline;
573 property ChangeStamp: integer read FChangeStamp;
574 procedure LoadFromConfig(Config: TConfigStorage); overload;
575 procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload;
576 procedure SaveToConfig(Config: TConfigStorage); overload;
577 procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload;
IsEqualnull578 function IsEqual(Settings: TAnchorDockSettings): boolean; reintroduce;
579 procedure Assign(Source: TAnchorDockSettings);
580 end;
581
582 TMapMinimizedControls = specialize TFPGMap <Pointer, Pointer>;
583
584 TAnchorDockMaster = class;
585
586 { TAnchorDockMaster
587 The central instance that connects all sites and manages all global
588 settings. Its global variable is the DockMaster.
589 Applications only need to talk to the DockMaster. }
590
591 TADCreateControlEvent = procedure(Sender: TObject; aName: string;
592 var AControl: TControl; DoDisableAutoSizing: boolean) of object;
DockMasternull593 TADShowDockMasterOptionsEvent = function(aDockMaster: TAnchorDockMaster): TModalResult;
594
595 { TStyleOfForm }
596
597 TStyleOfForm = record
598 Form: TCustomForm;
599 FormStyle: TFormStyle;
600 class operator = (Item1, Item2: TStyleOfForm): Boolean;
601 end;
602
603 { TFormStyles }
604
605 TFormStyles = class(specialize TFPGList<TStyleOfForm>)
606 public
607 procedure AddForm(const AForm: TCustomForm);
IndexOfFormnull608 function IndexOfForm(const AForm: TCustomForm): Integer;
609 procedure RemoveForm(const AForm: TCustomForm);
610 end;
611
612 TAnchorDockMaster = class(TComponent)
613 private
614 FAllowDragging: boolean;
615 FControls: TFPList; // list of TControl, custom host sites and docked controls, not helper controls (e.g. TAnchorDock*)
616 FDockOutsideMargin: integer;
617 FDockParentMargin: integer;
618 FDragTreshold: integer;
619 FFloatingWindowsOnTop: boolean;
620 FFormStyles: TFormStyles;
621 FHeaderAlignLeft: integer;
622 FHeaderAlignTop: integer;
623 FHeaderClass: TAnchorDockHeaderClass;
624 FHeaderHint: string;
625 FHeaderStyle: THeaderStyleName;
626 FHeaderFlatten: boolean;
627 FHeaderFilled: boolean;
628 FHeaderHighlightFocused: boolean;
629 FDockSitesCanBeMinimized: boolean;
630 FIdleConnected: Boolean;
631 FManagerClass: TAnchorDockManagerClass;
632 FMainDockForm: TCustomForm;
633 FMultiLinePages: boolean;
634 FOnCreateControl: TADCreateControlEvent;
635 FOnOptionsChanged: TNotifyEvent;
636 FOnShowOptions: TADShowDockMasterOptionsEvent;
637 FOptionsChangeStamp: int64;
638 FPageAreaInPercent: integer;
639 FPageClass: TAnchorDockPageClass;
640 FPageControlClass: TAnchorDockPageControlClass;
641 FQueueSimplify: Boolean;
642 FRestoreLayouts: TAnchorDockRestoreLayouts;
643 FRestoring: boolean;
644 FScaleOnResize: boolean;
645 FShowHeader: boolean;
646 FShowHeaderCaption: boolean;
647 FHideHeaderCaptionFloatingControl: boolean;
648 FShowMenuItemShowHeader: boolean;
649 FSiteClass: TAnchorDockHostSiteClass;
650 FSplitterClass: TAnchorDockSplitterClass;
651 FSplitterWidth: integer;
652 FMapMinimizedControls: TMapMinimizedControls; // minimized controls and previous parent
653 fNeedSimplify: TFPList; // list of TControl
654 fNeedFree: TFPList; // list of TControl
655 fSimplifying: boolean;
656 FAllClosing: Boolean;
657 fUpdateCount: integer;
658 fDisabledAutosizing: TFPList; // list of TControl
659 fTreeNameToDocker: TADNameToControl; // TAnchorDockHostSite, TAnchorDockSplitter or custom docksite
660 fPopupMenu: TPopupMenu;
661 // Used by RestoreLayout:
662 WorkArea, SrcWorkArea: TRect;
663 FOverlappingForm:TAnchorDockOverlappingForm;
664 CurrentADHeaderStyle:TADHeaderStyle;
665 FHeaderStyleName2ADHeaderStyle:THeaderStyleName2ADHeaderStylesMap;
666
667 procedure FormFirstShow(Sender: TObject);
GetControlsnull668 function GetControls(Index: integer): TControl;
GetLocalizedHeaderHintnull669 function GetLocalizedHeaderHint: string;
GetMainDockFormnull670 function GetMainDockForm: TCustomForm;
671 procedure MarkCorrectlyLocatedControl(Tree: TAnchorDockLayoutTree);
CloseUnneededAndWronglyLocatedControlsnull672 function CloseUnneededAndWronglyLocatedControls(Tree: TAnchorDockLayoutTree): boolean;
CreateNeededControlsnull673 function CreateNeededControls(Tree: TAnchorDockLayoutTree;
674 DisableAutoSizing: boolean; ControlNames: TStrings): boolean;
GetNodeSitenull675 function GetNodeSite(Node: TAnchorDockLayoutTreeNode): TAnchorDockHostSite;
676 procedure MapTreeToControls(Tree: TAnchorDockLayoutTree);
RestoreLayoutnull677 function RestoreLayout(Tree: TAnchorDockLayoutTree; Scale: boolean): boolean;
678 procedure ScreenFormAdded(Sender: TObject; Form: TCustomForm);
679 procedure ScreenRemoveForm(Sender: TObject; Form: TCustomForm);
680 procedure SetMainDockForm(AValue: TCustomForm);
681 procedure SetMinimizedState(Tree: TAnchorDockLayoutTree);
682 procedure UpdateHeaders;
683 procedure SetNodeMinimizedState(ANode: TAnchorDockLayoutTreeNode);
684 procedure EnableAllAutoSizing;
685 procedure ClearLayoutProperties(AControl: TControl; NewAlign: TAlign = alClient);
686 procedure PopupMenuPopup(Sender: TObject);
687 procedure ChangeLockButtonClick(Sender: TObject);
688 procedure RefreshFloatingWindowsOnTop;
ScaleBoundsRectnull689 function ScaleBoundsRect(ARect: TRect; FromDPI, ToDPI: integer): TRect;
ScaleChildXnull690 function ScaleChildX(p: integer): integer;
ScaleChildYnull691 function ScaleChildY(p: integer): integer;
ScaleTopLvlXnull692 function ScaleTopLvlX(p: integer): integer;
ScaleTopLvlYnull693 function ScaleTopLvlY(p: integer): integer;
694 procedure SetAllowDragging(AValue: boolean);
695 procedure SetDockOutsideMargin(AValue: integer);
696 procedure SetDockParentMargin(AValue: integer);
697 procedure SetDragTreshold(AValue: integer);
698 procedure SetHeaderHint(AValue: string);
699 procedure SetHeaderStyle(AValue: THeaderStyleName);
700 procedure SetPageAreaInPercent(AValue: integer);
701 procedure SetScaleOnResize(AValue: boolean);
702
703 procedure SetHeaderFlatten(AValue: boolean);
704 procedure SetHeaderFilled(AValue: boolean);
705 procedure SetHeaderHighlightFocused(AValue: boolean);
706 procedure SetDockSitesCanBeMinimized(AValue: boolean);
707 procedure SetFloatingWindowsOnTop(AValue: boolean);
708 procedure SetMultiLinePages(AValue: boolean);
709
710 procedure SetShowMenuItemShowHeader(AValue: boolean);
711 procedure SetupSite(Site: TWinControl; ANode: TAnchorDockLayoutTreeNode;
712 AParent: TWinControl);
713 procedure ShowHeadersButtonClick(Sender: TObject);
714 procedure OptionsClick(Sender: TObject);
715 procedure SetIdleConnected(const AValue: Boolean);
716 procedure SetQueueSimplify(const AValue: Boolean);
717 procedure SetRestoring(const AValue: boolean);
718 procedure OptionsChanged;
719 protected
DoCreateControlnull720 function DoCreateControl(aName: string; DisableAutoSizing: boolean): TControl;
721 procedure AutoSizeAllHeaders(EnableAutoSizing: boolean);
722 procedure DisableControlAutoSizing(AControl: TControl);
723 procedure InvalidateHeaders;
724 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
725 procedure SetHeaderAlignLeft(const AValue: integer);
726 procedure SetHeaderAlignTop(const AValue: integer);
727 procedure SetShowHeader(AValue: boolean);
728 procedure SetShowHeaderCaption(const AValue: boolean);
729 procedure SetHideHeaderCaptionFloatingControl(const AValue: boolean);
730 procedure SetSplitterWidth(const AValue: integer);
731 procedure OnIdle(Sender: TObject; var Done: Boolean);
732 procedure StartHideOverlappingTimer;
733 procedure StopHideOverlappingTimer;
734 procedure AsyncSimplify({%H-}Data: PtrInt);
735 public
736 procedure RegisterHeaderStyle(StyleName: THeaderStyleName; DrawProc:TDrawADHeaderProc; NeedDrawHeaderAfterText,NeedHighlightText: boolean);
737 procedure ShowOverlappingForm;
738 procedure HideOverlappingForm(Sender: TObject);
739 constructor Create(AOwner: TComponent); override;
740 destructor Destroy; override;
FullRestoreLayoutnull741 function FullRestoreLayout(Tree: TAnchorDockLayoutTree; Scale: Boolean): Boolean;
ControlCountnull742 function ControlCount: integer;
743 property Controls[Index: integer]: TControl read GetControls;
IndexOfControlnull744 function IndexOfControl(const aName: string): integer;
FindControlnull745 function FindControl(const aName: string): TControl;
IsMinimizedControlnull746 function IsMinimizedControl(AControl: TControl; out Site: TAnchorDockHostSite): Boolean;
IsSitenull747 function IsSite(AControl: TControl): boolean;
IsAnchorSitenull748 function IsAnchorSite(AControl: TControl): boolean;
IsCustomSitenull749 function IsCustomSite(AControl: TControl): boolean;
GetSitenull750 function GetSite(AControl: TControl): TCustomForm;
GetAnchorSitenull751 function GetAnchorSite(AControl: TControl): TAnchorDockHostSite;
GetControlnull752 function GetControl(Site: TControl): TControl;
IsFloatingnull753 function IsFloating(AControl: TControl): Boolean;
GetPopupMenunull754 function GetPopupMenu: TPopupMenu;
AddPopupMenuItemnull755 function AddPopupMenuItem(AName, ACaption: string;
756 const OnClickEvent: TNotifyEvent; AParent: TMenuItem = nil): TMenuItem; virtual;
AddRemovePopupMenuItemnull757 function AddRemovePopupMenuItem(Add: boolean; AName, ACaption: string;
758 const OnClickEvent: TNotifyEvent; AParent: TMenuItem = nil): TMenuItem; virtual;
759
760 // show / make a control dockable
761 procedure MakeDockable(AControl: TControl; Show: boolean = true;
762 BringToFront: boolean = false;
763 AddDockHeader: boolean = true);
764 procedure MakeDockSite(AForm: TCustomForm; Sites: TAnchors;
765 ResizePolicy: TADMResizePolicy;
766 AllowInside: boolean = false);
767 procedure MakeDockPanel(APanel: TAnchorDockPanel;
768 ResizePolicy: TADMResizePolicy);
769 procedure MakeVisible(AControl: TControl; SwitchPages: boolean);
ShowControlnull770 function ShowControl(ControlName: string; BringToFront: boolean = false): TControl;
771 procedure CloseAll;
772
773 // save/restore layouts
774 procedure SaveLayoutToConfig(Config: TConfigStorage);
775 procedure SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree);
776 procedure SaveSiteLayoutToTree(AControl: TWinControl;
777 LayoutTree: TAnchorDockLayoutTree);
CreateRestoreLayoutnull778 function CreateRestoreLayout(AControl: TControl): TAnchorDockRestoreLayout;
ConfigIsEmptynull779 function ConfigIsEmpty(Config: TConfigStorage): boolean;
LoadLayoutFromConfignull780 function LoadLayoutFromConfig(Config: TConfigStorage; Scale: Boolean): boolean;
781 // layout information for restoring hidden forms
782 property RestoreLayouts: TAnchorDockRestoreLayouts read FRestoreLayouts
783 write FRestoreLayouts;
784 property Restoring: boolean read FRestoring write SetRestoring;
785 property IdleConnected: Boolean read FIdleConnected write SetIdleConnected;
786 procedure LoadSettingsFromConfig(Config: TConfigStorage);
787 procedure SaveSettingsToConfig(Config: TConfigStorage);
788 procedure LoadSettings(Settings: TAnchorDockSettings);
789 procedure SaveSettings(Settings: TAnchorDockSettings);
SettingsAreEqualnull790 function SettingsAreEqual(Settings: TAnchorDockSettings): boolean;
791 procedure ResetSplitters;
792
793 // manual docking
794 procedure ManualFloat(AControl: TControl);
795 procedure ManualDock(SrcSite: TAnchorDockHostSite; TargetSite: TCustomForm;
796 Align: TAlign; TargetControl: TControl = nil); overload;
797 procedure ManualDock(SrcSite: TAnchorDockHostSite; TargetPanel: TAnchorDockPanel;
798 Align: TAlign; TargetControl: TControl = nil); overload;
ManualEnlargenull799 function ManualEnlarge(Site: TAnchorDockHostSite; Side: TAnchorKind;
800 OnlyCheckIfPossible: boolean): boolean;
801
802 // simplification/garbage collection
803 procedure BeginUpdate;
804 procedure EndUpdate;
IsReleasingnull805 function IsReleasing(AControl: TControl): Boolean;
806 procedure NeedSimplify(AControl: TControl);
807 procedure NeedFree(AControl: TControl);
808 procedure SimplifyPendingLayouts;
AutoFreedIfControlIsRemovednull809 function AutoFreedIfControlIsRemoved(AControl, RemovedControl: TControl): boolean;
CreateSitenull810 function CreateSite(NamePrefix: string = '';
811 DisableAutoSizing: boolean = true): TAnchorDockHostSite;
CreateSplitternull812 function CreateSplitter(NamePrefix: string = ''): TAnchorDockSplitter;
813 property QueueSimplify: Boolean read FQueueSimplify write SetQueueSimplify;
814
815 property OnCreateControl: TADCreateControlEvent read FOnCreateControl write FOnCreateControl;
816
817 // options
818 property OnShowOptions: TADShowDockMasterOptionsEvent read FOnShowOptions write FOnShowOptions;
819 property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged;
820 property DragTreshold: integer read FDragTreshold write SetDragTreshold default 4;
821 property DockOutsideMargin: integer read FDockOutsideMargin write SetDockOutsideMargin default 10; // max distance for outside mouse snapping
822 property DockParentMargin: integer read FDockParentMargin write SetDockParentMargin default 10; // max distance for snap to parent
823 property FloatingWindowsOnTop: boolean read FFloatingWindowsOnTop write SetFloatingWindowsOnTop default false;
824 property PageAreaInPercent: integer read FPageAreaInPercent write SetPageAreaInPercent default 40; // size of inner mouse snapping area for page docking
825 property ShowHeader: boolean read FShowHeader write SetShowHeader default true; // set to false to hide all headers
826 property ShowMenuItemShowHeader: boolean read FShowMenuItemShowHeader write SetShowMenuItemShowHeader default false;
827 property ShowHeaderCaption: boolean read FShowHeaderCaption write SetShowHeaderCaption default true; // set to false to remove the text in the headers
828 property HideHeaderCaptionFloatingControl: boolean read FHideHeaderCaptionFloatingControl
829 write SetHideHeaderCaptionFloatingControl default true; // disables ShowHeaderCaption for floating controls
830 property HeaderAlignTop: integer read FHeaderAlignTop write SetHeaderAlignTop default 80; // move header to top, when (width/height)*100<=HeaderAlignTop
831 property HeaderAlignLeft: integer read FHeaderAlignLeft write SetHeaderAlignLeft default 120; // move header to left, when (width/height)*100>=HeaderAlignLeft
832 property HeaderHint: string read FHeaderHint write SetHeaderHint; // if empty it uses resourcestring adrsDragAndDockC
833 property HeaderStyle: THeaderStyleName read FHeaderStyle write SetHeaderStyle;
834 property HeaderFlatten: boolean read FHeaderFlatten write SetHeaderFlatten default true;
835 property HeaderFilled: boolean read FHeaderFilled write SetHeaderFilled default true;
836 property HeaderHighlightFocused: boolean read FHeaderHighlightFocused write SetHeaderHighlightFocused default false;
837 property DockSitesCanBeMinimized: boolean read FDockSitesCanBeMinimized write SetDockSitesCanBeMinimized default false;
838
839 property SplitterWidth: integer read FSplitterWidth write SetSplitterWidth default 4;
840 property ScaleOnResize: boolean read FScaleOnResize write SetScaleOnResize default true; // scale children when resizing a site
841 property AllowDragging: boolean read FAllowDragging write SetAllowDragging default true;
842 property MultiLinePages: boolean read FMultiLinePages write SetMultiLinePages default false;
843 property OptionsChangeStamp: int64 read FOptionsChangeStamp;
844 procedure IncreaseOptionsChangeStamp; inline;
845
846 // for descendants
847 property SplitterClass: TAnchorDockSplitterClass read FSplitterClass write FSplitterClass;
848 property SiteClass: TAnchorDockHostSiteClass read FSiteClass write FSiteClass;
849 property ManagerClass: TAnchorDockManagerClass read FManagerClass write FManagerClass;
850 property HeaderClass: TAnchorDockHeaderClass read FHeaderClass write FHeaderClass;
851 property PageControlClass: TAnchorDockPageControlClass read FPageControlClass write FPageControlClass;
852 property PageClass: TAnchorDockPageClass read FPageClass write FPageClass;
853 property HeaderStyleName2ADHeaderStyle:THeaderStyleName2ADHeaderStylesMap read FHeaderStyleName2ADHeaderStyle;
854
855 // for floating windows on top
856 property MainDockForm: TCustomForm read GetMainDockForm write SetMainDockForm;
857 end;
858
859 var
860 DockMaster: TAnchorDockMaster = nil;
861 DockTimer: TTimer = nil;
862
863 PreferredButtonWidth:integer=-1;
864 PreferredButtonHeight:integer=-1;
865
866
867 const
868 HardcodedButtonSize:integer=13;
869
dbgsnull870 function dbgs(SiteType: TAnchorDockHostSiteType): string; overload;
871
872
873 procedure CopyAnchorBounds(Source, Target: TControl);
874 procedure AnchorAndChangeBounds(AControl: TControl; Side: TAnchorKind;
875 Target: TControl);
ControlsLeftTopOnScreennull876 function ControlsLeftTopOnScreen(AControl: TControl): TPoint;
877
878 type
879 TAnchorControlsRect = array[TAnchorKind] of TControl;
880
DockedControlIsVisiblenull881 function DockedControlIsVisible(Control: TControl): boolean;
GetDockSplitternull882 function GetDockSplitter(Control: TControl; Side: TAnchorKind;
883 out Splitter: TAnchorDockSplitter): boolean;
GetDockSplitterOrParentnull884 function GetDockSplitterOrParent(Control: TControl; Side: TAnchorKind;
885 out AnchorControl: TControl): boolean;
CountAnchoredControlsnull886 function CountAnchoredControls(Control: TControl; Side: TAnchorKind): Integer;
NeighbourCanBeShrinkednull887 function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl;
888 Side: TAnchorKind): boolean;
ControlIsAnchoredIndirectlynull889 function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind;
890 DestControl: TControl): boolean;
891 procedure GetAnchorControlsRect(Control: TControl; out ARect: TAnchorControlsRect);
GetEnclosingControlRectnull892 function GetEnclosingControlRect(ControlList: TFPlist;
893 out ARect: TAnchorControlsRect): boolean;
GetEnclosedControlsnull894 function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList;
895
896 implementation
897
dbgsnull898 function dbgs(SiteType: TAnchorDockHostSiteType): string; overload;
899 begin
900 case SiteType of
901 adhstNone: Result:='None';
902 adhstOneControl: Result:='OneControl';
903 adhstLayout: Result:='Layout';
904 adhstPages: Result:='Pages';
905 else Result:='?';
906 end;
907 end;
908
909 procedure CopyAnchorBounds(Source, Target: TControl);
910 var
911 a: TAnchorKind;
912 begin
913 Target.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('CopyAnchorBounds'){$ENDIF};
914 try
915 Target.BoundsRect:=Source.BoundsRect;
916 Target.Anchors:=Source.Anchors;
917 Target.Align:=Source.Align;
918 for a:=low(TAnchorKind) to high(TAnchorKind) do
919 Target.AnchorSide[a].Assign(Source.AnchorSide[a]);
920 finally
921 Target.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('CopyAnchorBounds'){$ENDIF};
922 end;
923 end;
924
925 procedure AnchorAndChangeBounds(AControl: TControl; Side: TAnchorKind;
926 Target: TControl);
927 begin
928 if Target=AControl.Parent then begin
929 AControl.AnchorParallel(Side,0,Target);
930 case Side of
931 akTop: AControl.Top:=0;
932 akLeft: AControl.Left:=0;
933 akRight: AControl.Width:=AControl.Parent.ClientWidth-AControl.Left;
934 akBottom: AControl.Height:=AControl.Parent.ClientHeight-AControl.Top;
935 end;
936 end else begin
937 AControl.AnchorToNeighbour(Side,0,Target);
938 case Side of
939 akTop: AControl.Top:=Target.Top+Target.Height;
940 akLeft: AControl.Left:=Target.Left+Target.Width;
941 akRight: AControl.Width:=Target.Left-AControl.Width;
942 akBottom: AControl.Height:=Target.Top-AControl.Height;
943 end;
944 end;
945 end;
946
ControlsLeftTopOnScreennull947 function ControlsLeftTopOnScreen(AControl: TControl): TPoint;
948 begin
949 if AControl.Parent<>nil then begin
950 Result:=AControl.Parent.ClientOrigin;
951 inc(Result.X,AControl.Left);
952 inc(Result.Y,AControl.Top);
953 end else begin
954 Result:=AControl.Parent.ClientOrigin;
955 end;
956 end;
957
DockedControlIsVisiblenull958 function DockedControlIsVisible(Control: TControl): boolean;
959 begin
960 while Control<>nil do begin
961 if (not Control.IsControlVisible)
962 and (not (Control is TAnchorDockPage)) then
963 exit(false);
964 Control:=Control.Parent;
965 end;
966 Result:=true;
967 end;
968
GetDockSplitternull969 function GetDockSplitter(Control: TControl; Side: TAnchorKind; out
970 Splitter: TAnchorDockSplitter): boolean;
971 begin
972 Result:=false;
973 Splitter:=nil;
974 if not Assigned(Control) or not (Side in Control.Anchors) then exit;
975 Splitter:=TAnchorDockSplitter(Control.AnchorSide[Side].Control);
976 if not (Splitter is TAnchorDockSplitter) then begin
977 Splitter:=nil;
978 exit;
979 end;
980 if Splitter.Parent<>Control.Parent then exit;
981 Result:=true;
982 end;
983
GetDockSplitterOrParentnull984 function GetDockSplitterOrParent(Control: TControl; Side: TAnchorKind; out
985 AnchorControl: TControl): boolean;
986 begin
987 Result:=false;
988 AnchorControl:=nil;
989 if not (Side in Control.Anchors) then exit;
990 AnchorControl:=Control.AnchorSide[Side].Control;
991 if (AnchorControl is TAnchorDockSplitter)
992 and (AnchorControl.Parent=Control.Parent)
993 then
994 Result:=true
995 else if AnchorControl=Control.Parent then
996 Result:=true;
997 end;
998
CountAnchoredControlsnull999 function CountAnchoredControls(Control: TControl; Side: TAnchorKind): Integer;
1000 { return the number of siblings, that are anchored on Side of Control
1001 For example: if Side=akLeft it will return the number of controls, which
1002 right side is anchored to the left of Control }
1003 var
1004 i: Integer;
1005 Neighbour: TControl;
1006 begin
1007 Result:=0;
1008 for i:=0 to Control.AnchoredControlCount-1 do begin
1009 Neighbour:=Control.AnchoredControls[i];
1010 if (OppositeAnchor[Side] in Neighbour.Anchors)
1011 and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then
1012 inc(Result);
1013 end;
1014 end;
1015
CountAndReturnOnlyOneMinimizedAnchoredControlsnull1016 function CountAndReturnOnlyOneMinimizedAnchoredControls(Control: TControl; Side: TAnchorKind): TAnchorDockHostSite;
1017 var
1018 i,Counter: Integer;
1019 Neighbour: TControl;
1020 begin
1021 Counter:=0;
1022 for i:=0 to Control.AnchoredControlCount-1 do begin
1023 Neighbour:=Control.AnchoredControls[i];
1024 if Neighbour.Visible then
1025 if Neighbour is TAnchorDockHostSite then
1026 if (OppositeAnchor[Side] in Neighbour.Anchors)
1027 and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then begin
1028 inc(Counter);
1029 result:=TAnchorDockHostSite(Neighbour);
1030 end;
1031 end;
1032 if (Counter=1) and (result is TAnchorDockHostSite) and ((result as TAnchorDockHostSite).Minimized) then
1033 else
1034 result:=Nil;
1035 end;
1036
ReturnAnchoredControlsSizenull1037 function ReturnAnchoredControlsSize(Control: TControl; Side: TAnchorKind): integer;
1038 var
1039 i: Integer;
1040 Neighbour: TControl;
1041 begin
1042 result:=high(integer);
1043 for i:=0 to Control.AnchoredControlCount-1 do begin
1044 Neighbour:=Control.AnchoredControls[i];
1045 if Neighbour.Visible then
1046 if Neighbour is TAnchorDockHostSite then
1047 if (OppositeAnchor[Side] in Neighbour.Anchors)
1048 and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then begin
1049 case Side of
1050 akTop,akBottom: if Neighbour.ClientHeight<result then
1051 result:=Neighbour.ClientHeight;
1052 akLeft,akRight: if Neighbour.ClientWidth<result then
1053 result:=Neighbour.ClientWidth;
1054 end;
1055 end;
1056 end;
1057 end;
1058
NeighbourCanBeShrinkednull1059 function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl;
1060 Side: TAnchorKind): boolean;
1061 { returns true if Neighbour can be shrinked on the opposite side of Side
1062 }
1063 const
1064 MinControlSize = 20;
1065 var
1066 Splitter: TAnchorDockSplitter;
1067 begin
1068 Result:=false;
1069 if not GetDockSplitter(EnlargeControl,OppositeAnchor[Side],Splitter) then
1070 exit;
1071 case Side of
1072 akLeft: // check if left side of Neighbour can be moved
1073 Result:=Neighbour.Left+Neighbour.Width
1074 >EnlargeControl.Left+EnlargeControl.Width+Splitter.Width+MinControlSize;
1075 akRight: // check if right side of Neighbour can be moved
1076 Result:=Neighbour.Left+MinControlSize+Splitter.Width<EnlargeControl.Left;
1077 akTop: // check if top side of Neighbour can be moved
1078 Result:=Neighbour.Top+Neighbour.Height
1079 >EnlargeControl.Top+EnlargeControl.Height+Splitter.Height+MinControlSize;
1080 akBottom: // check if bottom side of Neighbour can be moved
1081 Result:=Neighbour.Top+MinControlSize+Splitter.Height<EnlargeControl.Top;
1082 end;
1083 end;
1084
ControlIsAnchoredIndirectlynull1085 function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind;
1086 DestControl: TControl): boolean;
1087 { true if there is an Anchor way from StartControl to DestControl over Side.
1088 For example:
1089
1090 +-+|+-+
1091 |A|||B|
1092 +-+|+-+
1093
1094 A is akLeft to B.
1095 B is akRight to A.
1096 The splitter is akLeft to B.
1097 The splitter is akRight to A.
1098 All other are false.
1099 }
1100 var
1101 Checked: array of Boolean;
1102 Parent: TWinControl;
1103
Checknull1104 function Check(ControlIndex: integer): boolean;
1105 var
1106 AControl: TControl;
1107 SideControl: TControl;
1108 i: Integer;
1109 begin
1110 if Checked[ControlIndex] then
1111 exit(false);
1112 Checked[ControlIndex]:=true;
1113 AControl:=Parent.Controls[ControlIndex];
1114 if AControl=DestControl then exit(true);
1115
1116 if (Side in AControl.Anchors) then begin
1117 SideControl:=AControl.AnchorSide[Side].Control;
1118 if (SideControl<>nil) and Check(Parent.GetControlIndex(SideControl)) then
1119 exit(true);
1120 end;
1121 for i:=0 to AControl.AnchoredControlCount-1 do begin
1122 if Checked[i] then continue;
1123 SideControl:=AControl.AnchoredControls[i];
1124 if OppositeAnchor[Side] in SideControl.Anchors then begin
1125 if (SideControl.AnchorSide[OppositeAnchor[Side]].Control=AControl)
1126 and Check(i) then
1127 exit(true);
1128 end;
1129 end;
1130 Result:=false;
1131 end;
1132
1133 var
1134 i: Integer;
1135 begin
1136 if (StartControl=nil) or (DestControl=nil)
1137 or (StartControl.Parent=nil)
1138 or (StartControl.Parent<>DestControl.Parent)
1139 or (StartControl=DestControl) then
1140 exit(false);
1141 Parent:=StartControl.Parent;
1142 SetLength(Checked,Parent.ControlCount);
1143 for i:=0 to length(Checked)-1 do Checked[i]:=false;
1144 Result:=Check(Parent.GetControlIndex(StartControl));
1145 end;
1146
1147 procedure GetAnchorControlsRect(Control: TControl; out ARect: TAnchorControlsRect);
1148 var
1149 a: TAnchorKind;
1150 begin
1151 for a:=Low(TAnchorKind) to High(TAnchorKind) do
1152 ARect[a]:=Control.AnchorSide[a].Control;
1153 end;
1154
GetEnclosingControlRectnull1155 function GetEnclosingControlRect(ControlList: TFPlist; out
1156 ARect: TAnchorControlsRect): boolean;
1157 { ARect will be the minimum TAnchorControlsRect around the controls in the list
1158 returns true, if there is such a TAnchorControlsRect.
1159
1160 The controls in ARect will either be the Parent or a TLazDockSplitter
1161 }
1162 var
1163 Parent: TWinControl;
1164
ControlIsValidAnchornull1165 function ControlIsValidAnchor(Control: TControl; Side: TAnchorKind): boolean;
1166 var
1167 i: Integer;
1168 begin
1169 Result:=false;
1170 if (Control=ARect[Side]) then exit(true);// this allows Parent at the beginning
1171
1172 if not (Control is TAnchorDockSplitter) then
1173 exit;// not a splitter
1174 if (TAnchorDockSplitter(Control).ResizeAnchor in [akLeft,akRight])
1175 <>(Side in [akLeft,akRight]) then
1176 exit;// wrong alignment
1177 if ControlList.IndexOf(Control)>=0 then
1178 exit;// is an inner control
1179 if ControlIsAnchoredIndirectly(Control,Side,ARect[Side]) then
1180 exit; // this anchor would be worse than the current maximum
1181 for i:=0 to ControlList.Count-1 do begin
1182 if not ControlIsAnchoredIndirectly(Control,Side,TControl(ControlList[i]))
1183 then begin
1184 // this anchor is not above (below, ...) the inner controls
1185 exit;
1186 end;
1187 end;
1188 Result:=true;
1189 end;
1190
1191 var
1192 TopIndex: Integer;
1193 TopControl: TControl;
1194 RightIndex: Integer;
1195 RightControl: TControl;
1196 BottomIndex: Integer;
1197 BottomControl: TControl;
1198 LeftIndex: Integer;
1199 LeftControl: TControl;
1200 Candidates: TFPList;
1201 i: Integer;
1202 a: TAnchorKind;
1203 begin
1204 Result:=false;
1205 if (ControlList=nil) or (ControlList.Count=0) then exit;
1206
1207 // get Parent
1208 Parent:=TControl(ControlList[0]).Parent;
1209 if Parent=nil then exit;
1210 for i:=0 to ControlList.Count-1 do
1211 if TControl(ControlList[i]).Parent<>Parent then exit;
1212
1213 // set the default rect: the Parent
1214 Result:=true;
1215 for a:=Low(TAnchorKind) to High(TAnchorKind) do
1216 ARect[a]:=Parent;
1217
1218 // find all possible Candidates
1219 Candidates:=TFPList.Create;
1220 try
1221 Candidates.Add(Parent);
1222 for i:=0 to Parent.ControlCount-1 do
1223 if Parent.Controls[i] is TAnchorDockSplitter then
1224 Candidates.Add(Parent.Controls[i]);
1225
1226 // now check every possible rectangle
1227 // Note: four loops seems to be dog slow, but the checks
1228 // avoid most possibilities early
1229 for TopIndex:=0 to Candidates.Count-1 do begin
1230 TopControl:=TControl(Candidates[TopIndex]);
1231 if not ControlIsValidAnchor(TopControl,akTop) then continue;
1232
1233 for RightIndex:=0 to Candidates.Count-1 do begin
1234 RightControl:=TControl(Candidates[RightIndex]);
1235 if (TopControl.AnchorSide[akRight].Control<>RightControl)
1236 and (RightControl.AnchorSide[akTop].Control<>TopControl) then
1237 continue; // not touching / not a corner
1238 if not ControlIsValidAnchor(RightControl,akRight) then continue;
1239
1240 for BottomIndex:=0 to Candidates.Count-1 do begin
1241 BottomControl:=TControl(Candidates[BottomIndex]);
1242 if (RightControl.AnchorSide[akBottom].Control<>BottomControl)
1243 and (BottomControl.AnchorSide[akRight].Control<>RightControl) then
1244 continue; // not touching / not a corner
1245 if not ControlIsValidAnchor(BottomControl,akBottom) then continue;
1246
1247 for LeftIndex:=0 to Candidates.Count-1 do begin
1248 LeftControl:=TControl(Candidates[LeftIndex]);
1249 if (BottomControl.AnchorSide[akLeft].Control<>LeftControl)
1250 and (LeftControl.AnchorSide[akBottom].Control<>BottomControl) then
1251 continue; // not touching / not a corner
1252 if (TopControl.AnchorSide[akLeft].Control<>LeftControl)
1253 and (LeftControl.AnchorSide[akTop].Control<>LeftControl) then
1254 continue; // not touching / not a corner
1255 if not ControlIsValidAnchor(LeftControl,akLeft) then continue;
1256
1257 // found a better rectangle
1258 ARect[akLeft] :=LeftControl;
1259 ARect[akRight] :=RightControl;
1260 ARect[akTop] :=TopControl;
1261 ARect[akBottom]:=BottomControl;
1262 end;
1263 end;
1264 end;
1265 end;
1266 finally
1267 Candidates.Free;
1268 end;
1269 end;
1270
GetEnclosedControlsnull1271 function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList;
1272 { return a list of all controls bounded by the anchors in ARect }
1273 var
1274 Parent: TWinControl;
1275
1276 procedure Fill(AControl: TControl);
1277 var
1278 a: TAnchorKind;
1279 SideControl: TControl;
1280 i: Integer;
1281 begin
1282 if AControl=nil then exit;
1283 if AControl=Parent then exit;// do not add Parent
1284 for a:=Low(TAnchorKind) to High(TAnchorKind) do
1285 if ARect[a]=AControl then exit;// do not add boundary
1286
1287 if Result.IndexOf(AControl)>=0 then exit;// already added
1288 Result.Add(AControl);
1289
1290 for a:=Low(TAnchorKind) to High(TAnchorKind) do
1291 Fill(AControl.AnchorSide[a].Control);
1292 for i:=0 to Parent.ControlCount-1 do begin
1293 SideControl:=Parent.Controls[i];
1294 for a:=Low(TAnchorKind) to High(TAnchorKind) do
1295 if SideControl.AnchorSide[a].Control=AControl then
1296 Fill(SideControl);
1297 end;
1298 end;
1299
1300 var
1301 i: Integer;
1302 AControl: TControl;
1303 LeftTopControl: TControl;
1304 begin
1305 Result:=TFPList.Create;
1306
1307 // find the Parent
1308 if (ARect[akLeft]=ARect[akRight]) and (ARect[akLeft] is TWinControl) then
1309 Parent:=TWinControl(ARect[akLeft])
1310 else
1311 Parent:=ARect[akLeft].Parent;
1312
1313 // find the left, top most control
1314 for i:=0 to Parent.ControlCount-1 do begin
1315 AControl:=Parent.Controls[i];
1316 if (AControl.AnchorSide[akLeft].Control=ARect[akLeft])
1317 and (AControl.AnchorSide[akTop].Control=ARect[akTop]) then begin
1318 LeftTopControl:=AControl;
1319 break;
1320 end;
1321 end;
1322 if Result.Count=0 then exit;
1323
1324 // use flood fill to find the rest
1325 Fill(LeftTopControl);
1326 end;
1327
1328 { TAnchorDockSettings }
1329
1330 procedure TAnchorDockSettings.SetAllowDragging(AValue: boolean);
1331 begin
1332 if FAllowDragging=AValue then Exit;
1333 FAllowDragging:=AValue;
1334 IncreaseChangeStamp;
1335 end;
1336
1337 procedure TAnchorDockSettings.SetDockOutsideMargin(AValue: integer);
1338 begin
1339 if FDockOutsideMargin=AValue then Exit;
1340 FDockOutsideMargin:=AValue;
1341 IncreaseChangeStamp;
1342 end;
1343
1344 procedure TAnchorDockSettings.SetDockParentMargin(AValue: integer);
1345 begin
1346 if FDockParentMargin=AValue then Exit;
1347 FDockParentMargin:=AValue;
1348 IncreaseChangeStamp;
1349 end;
1350
1351 procedure TAnchorDockSettings.SetDragTreshold(AValue: integer);
1352 begin
1353 if FDragTreshold=AValue then Exit;
1354 FDragTreshold:=AValue;
1355 IncreaseChangeStamp;
1356 end;
1357
1358 procedure TAnchorDockSettings.SetFloatingWindowsOnTop(AValue: boolean);
1359 begin
1360 if FFloatingWindowsOnTop=AValue then Exit;
1361 FFloatingWindowsOnTop:=AValue;
1362 IncreaseChangeStamp;
1363 end;
1364
1365 procedure TAnchorDockSettings.SetHeaderAlignLeft(AValue: integer);
1366 begin
1367 if FHeaderAlignLeft=AValue then Exit;
1368 FHeaderAlignLeft:=AValue;
1369 IncreaseChangeStamp;
1370 end;
1371
1372 procedure TAnchorDockSettings.SetHeaderAlignTop(AValue: integer);
1373 begin
1374 if FHeaderAlignTop=AValue then Exit;
1375 FHeaderAlignTop:=AValue;
1376 IncreaseChangeStamp;
1377 end;
1378
1379 procedure TAnchorDockSettings.SetHeaderHint(AValue: string);
1380 begin
1381 if FHeaderHint=AValue then Exit;
1382 FHeaderHint:=AValue;
1383 IncreaseChangeStamp;
1384 end;
1385
1386 procedure TAnchorDockSettings.SetHeaderStyle(AValue: THeaderStyleName);
1387 begin
1388 if FHeaderStyle=AValue then Exit;
1389
1390 // the next two lines can be removed in Lazarus 2.4.0 upwards - there should no old
1391 // environmentoptions.xml be out there anymore - see https://bugs.freepascal.org/view.php?id=38960
1392 if AValue='Themed caption' then AValue:='ThemedCaption';
1393 if AValue='Themed button' then AValue:='ThemedButton';
1394
1395 FHeaderStyle:=AValue;
1396 IncreaseChangeStamp;
1397 end;
1398
1399 procedure TAnchorDockSettings.SetHideHeaderCaptionFloatingControl(
1400 AValue: boolean);
1401 begin
1402 if FHideHeaderCaptionFloatingControl=AValue then Exit;
1403 FHideHeaderCaptionFloatingControl:=AValue;
1404 IncreaseChangeStamp;
1405 end;
1406
1407 procedure TAnchorDockSettings.SetMultiLinePages(AValue: boolean);
1408 begin
1409 if FMultiLinePages = AValue then Exit;
1410 FMultiLinePages := AValue;
1411 IncreaseChangeStamp;
1412 end;
1413
1414 procedure TAnchorDockSettings.SetPageAreaInPercent(AValue: integer);
1415 begin
1416 if FPageAreaInPercent=AValue then Exit;
1417 FPageAreaInPercent:=AValue;
1418 IncreaseChangeStamp;
1419 end;
1420
1421 procedure TAnchorDockSettings.SetScaleOnResize(AValue: boolean);
1422 begin
1423 if FScaleOnResize=AValue then Exit;
1424 FScaleOnResize:=AValue;
1425 IncreaseChangeStamp;
1426 end;
1427
1428 procedure TAnchorDockSettings.SetHeaderFlatten(AValue: boolean);
1429 begin
1430 if FHeaderFlatten=AValue then Exit;
1431 FHeaderFlatten:=AValue;
1432 IncreaseChangeStamp;
1433 end;
1434
1435 procedure TAnchorDockSettings.SetHeaderFilled(AValue: boolean);
1436 begin
1437 if FHeaderFilled=AValue then Exit;
1438 FHeaderFilled:=AValue;
1439 IncreaseChangeStamp;
1440 end;
1441
1442 procedure TAnchorDockSettings.SetHeaderHighlightFocused(AValue: boolean);
1443 begin
1444 if FHeaderHighlightFocused=AValue then Exit;
1445 FHeaderHighlightFocused:=AValue;
1446 IncreaseChangeStamp;
1447 end;
1448
1449 procedure TAnchorDockSettings.SetShowHeader(AValue: boolean);
1450 begin
1451 if FShowHeader=AValue then Exit;
1452 FShowHeader:=AValue;
1453 IncreaseChangeStamp;
1454 end;
1455
1456 procedure TAnchorDockSettings.SetShowHeaderCaption(AValue: boolean);
1457 begin
1458 if FShowHeaderCaption=AValue then Exit;
1459 FShowHeaderCaption:=AValue;
1460 IncreaseChangeStamp;
1461 end;
1462
1463 procedure TAnchorDockSettings.SetSplitterWidth(AValue: integer);
1464 begin
1465 if FSplitterWidth=AValue then Exit;
1466 FSplitterWidth:=AValue;
1467 IncreaseChangeStamp;
1468 end;
1469
1470 procedure TAnchorDockSettings.SetDockSitesCanBeMinimized(AValue: boolean);
1471 begin
1472 if FDockSitesCanBeMinimized=AValue then Exit;
1473 FDockSitesCanBeMinimized:=AValue;
1474 IncreaseChangeStamp;
1475 end;
1476
1477 procedure TAnchorDockSettings.Assign(Source: TAnchorDockSettings);
1478 begin
1479 FChangeStamp := Source.FChangeStamp;
1480
1481 FAllowDragging := Source.FAllowDragging;
1482 FDockOutsideMargin := Source.FDockOutsideMargin;
1483 FDockParentMargin := Source.FDockParentMargin;
1484 FDockSitesCanBeMinimized := Source.FDockSitesCanBeMinimized;
1485 FDragTreshold := Source.FDragTreshold;
1486 FFloatingWindowsOnTop := Source.FFloatingWindowsOnTop;
1487 FHeaderAlignLeft := Source.FHeaderAlignLeft;
1488 FHeaderAlignTop := Source.FHeaderAlignTop;
1489 FHeaderFilled := Source.FHeaderFilled;
1490 FHeaderFlatten := Source.FHeaderFlatten;
1491 FHeaderHighlightFocused := Source.FHeaderHighlightFocused;
1492 FHeaderHint := Source.FHeaderHint;
1493 FHeaderStyle := Source.FHeaderStyle;
1494 FHideHeaderCaptionFloatingControl := Source.FHideHeaderCaptionFloatingControl;
1495 FMultiLinePages := Source.FMultiLinePages;
1496 FPageAreaInPercent := Source.FPageAreaInPercent;
1497 FScaleOnResize := Source.FScaleOnResize;
1498 FShowHeader := Source.FShowHeader;
1499 FShowHeaderCaption := Source.FShowHeaderCaption;
1500 FSplitterWidth := Source.FSplitterWidth;
1501 end;
1502
1503 procedure TAnchorDockSettings.IncreaseChangeStamp;
1504 begin
1505 LUIncreaseChangeStamp(fChangeStamp);
1506 end;
1507
1508 procedure TAnchorDockSettings.LoadFromConfig(Config: TConfigStorage);
1509 begin
1510 Config.AppendBasePath('Settings/');
1511 AllowDragging := Config.GetValue('AllowDragging',true);
1512 DockOutsideMargin := Config.GetValue('DockOutsideMargin',10);
1513 DockParentMargin := Config.GetValue('DockParentMargin',10);
1514 DockSitesCanBeMinimized := Config.GetValue('DockSitesCanBeMinimized',False);
1515 DragTreshold := Config.GetValue('DragThreshold',4);
1516 FloatingWindowsOnTop := Config.GetValue('FloatingWindowsOnTop',false);
1517 HeaderAlignLeft := Config.GetValue('HeaderAlignLeft',120);
1518 HeaderAlignTop := Config.GetValue('HeaderAlignTop',80);
1519 HeaderFilled := Config.GetValue('HeaderFilled',true);
1520 HeaderFlatten := Config.GetValue('HeaderFlatten',true);
1521 HeaderHighlightFocused := Config.GetValue('HeaderHighlightFocused',False);
1522 HeaderStyle := Config.GetValue('HeaderStyle','Frame3D');
1523 HideHeaderCaptionFloatingControl := Config.GetValue('HideHeaderCaptionFloatingControl',true);
1524 MultiLinePages := Config.GetValue('MultiLinePages',false);
1525 PageAreaInPercent := Config.GetValue('PageAreaInPercent',40);
1526 ScaleOnResize := Config.GetValue('ScaleOnResize',true);
1527 ShowHeader := Config.GetValue('ShowHeader',true);
1528 ShowHeaderCaption := Config.GetValue('ShowHeaderCaption',true);
1529 SplitterWidth := Config.GetValue('SplitterWidth',4);
1530 Config.UndoAppendBasePath;
1531 end;
1532
1533 procedure TAnchorDockSettings.SaveToConfig(Path: string; Config: TRttiXMLConfig);
1534 begin
1535 Config.SetDeleteValue(Path+'AllowDragging',AllowDragging,true);
1536 Config.SetDeleteValue(Path+'DockOutsideMargin',DockOutsideMargin,10);
1537 Config.SetDeleteValue(Path+'DockParentMargin',DockParentMargin,10);
1538 Config.SetDeleteValue(Path+'DockSitesCanBeMinimized',DockSitesCanBeMinimized,False);
1539 Config.SetDeleteValue(Path+'DragThreshold',DragTreshold,4);
1540 Config.SetDeleteValue(Path+'FloatingWindowsOnTop',FloatingWindowsOnTop,false);
1541 Config.SetDeleteValue(Path+'HeaderAlignLeft',HeaderAlignLeft,120);
1542 Config.SetDeleteValue(Path+'HeaderAlignTop',HeaderAlignTop,80);
1543 Config.SetDeleteValue(Path+'HeaderFilled',HeaderFilled,true);
1544 Config.SetDeleteValue(Path+'HeaderFlatten',HeaderFlatten,true);
1545 Config.SetDeleteValue(Path+'HeaderHighlightFocused',HeaderHighlightFocused,False);
1546 Config.SetDeleteValue(Path+'HeaderStyle',HeaderStyle,'Frame3D');
1547 Config.SetDeleteValue(Path+'HideHeaderCaptionFloatingControl',HideHeaderCaptionFloatingControl,true);
1548 Config.SetDeleteValue(Path+'MultiLinePages',MultiLinePages,false);
1549 Config.SetDeleteValue(Path+'PageAreaInPercent',PageAreaInPercent,40);
1550 Config.SetDeleteValue(Path+'ScaleOnResize',ScaleOnResize,true);
1551 Config.SetDeleteValue(Path+'ShowHeader',ShowHeader,true);
1552 Config.SetDeleteValue(Path+'ShowHeaderCaption',ShowHeaderCaption,true);
1553 Config.SetDeleteValue(Path+'SplitterWidth',SplitterWidth,4);
1554 end;
1555
1556 procedure TAnchorDockSettings.SaveToConfig(Config: TConfigStorage);
1557 begin
1558 Config.AppendBasePath('Settings/');
1559 Config.SetDeleteValue('AllowDragging',AllowDragging,true);
1560 Config.SetDeleteValue('DockOutsideMargin',DockOutsideMargin,10);
1561 Config.SetDeleteValue('DockParentMargin',DockParentMargin,10);
1562 Config.SetDeleteValue('DockSitesCanBeMinimized',DockSitesCanBeMinimized,False);
1563 Config.SetDeleteValue('DragThreshold',DragTreshold,4);
1564 Config.SetDeleteValue('FloatingWindowsOnTop',FloatingWindowsOnTop,false);
1565 Config.SetDeleteValue('HeaderAlignLeft',HeaderAlignLeft,120);
1566 Config.SetDeleteValue('HeaderAlignTop',HeaderAlignTop,80);
1567 Config.SetDeleteValue('HeaderFilled',HeaderFilled,true);
1568 Config.SetDeleteValue('HeaderFlatten',HeaderFlatten,true);
1569 Config.SetDeleteValue('HeaderHighlightFocused',HeaderHighlightFocused,False);
1570 Config.SetDeleteValue('HeaderStyle',HeaderStyle,'Frame3D');
1571 Config.SetDeleteValue('HideHeaderCaptionFloatingControl',HideHeaderCaptionFloatingControl,true);
1572 Config.SetDeleteValue('MultiLinePages',MultiLinePages,false);
1573 Config.SetDeleteValue('PageAreaInPercent',PageAreaInPercent,40);
1574 Config.SetDeleteValue('ScaleOnResize',ScaleOnResize,true);
1575 Config.SetDeleteValue('ShowHeader',ShowHeader,true);
1576 Config.SetDeleteValue('ShowHeaderCaption',ShowHeaderCaption,true);
1577 Config.SetDeleteValue('SplitterWidth',SplitterWidth,4);
1578 Config.UndoAppendBasePath;
1579 end;
1580
TAnchorDockSettings.IsEqualnull1581 function TAnchorDockSettings.IsEqual(Settings: TAnchorDockSettings): boolean;
1582 begin
1583 Result:=(AllowDragging=Settings.AllowDragging)
1584 and (DockOutsideMargin=Settings.DockOutsideMargin)
1585 and (DockParentMargin=Settings.DockParentMargin)
1586 and (DockSitesCanBeMinimized=Settings.DockSitesCanBeMinimized)
1587 and (DragTreshold=Settings.DragTreshold)
1588 and (FloatingWindowsOnTop=Settings.FloatingWindowsOnTop)
1589 and (HeaderAlignLeft=Settings.HeaderAlignLeft)
1590 and (HeaderAlignTop=Settings.HeaderAlignTop)
1591 and (HeaderFilled=Settings.HeaderFilled)
1592 and (HeaderFlatten=Settings.HeaderFlatten)
1593 and (HeaderHighlightFocused=Settings.HeaderHighlightFocused)
1594 and (HeaderHint=Settings.HeaderHint)
1595 and (HeaderStyle=Settings.HeaderStyle)
1596 and (HideHeaderCaptionFloatingControl=Settings.HideHeaderCaptionFloatingControl)
1597 and (MultiLinePages=Settings.MultiLinePages)
1598 and (PageAreaInPercent=Settings.PageAreaInPercent)
1599 and (ScaleOnResize=Settings.ScaleOnResize)
1600 and (ShowHeader=Settings.ShowHeader)
1601 and (ShowHeaderCaption=Settings.ShowHeaderCaption)
1602 and (SplitterWidth=Settings.SplitterWidth)
1603 ;
1604 end;
1605
1606 procedure TAnchorDockSettings.LoadFromConfig(Path: string;
1607 Config: TRttiXMLConfig);
1608 begin
1609 AllowDragging := Config.GetValue(Path+'AllowDragging',true);
1610 DockOutsideMargin := Config.GetValue(Path+'DockOutsideMargin',10);
1611 DockParentMargin := Config.GetValue(Path+'DockParentMargin',10);
1612 DockSitesCanBeMinimized := Config.GetValue(Path+'DockSitesCanBeMinimized',false);
1613 DragTreshold := Config.GetValue(Path+'DragThreshold',4);
1614 FloatingWindowsOnTop := Config.GetValue(Path+'FloatingWindowsOnTop',false); ;
1615 HeaderAlignLeft := Config.GetValue(Path+'HeaderAlignLeft',120);
1616 HeaderAlignTop := Config.GetValue(Path+'HeaderAlignTop',80);
1617 HeaderFilled := Config.GetValue(Path+'HeaderFilled',true);
1618 HeaderFlatten := Config.GetValue(Path+'HeaderFlatten',true);
1619 HeaderHighlightFocused := Config.GetValue(Path+'HeaderHighlightFocused',false);
1620 HeaderStyle := Config.GetValue(Path+'HeaderStyle','Frame3D');
1621 HideHeaderCaptionFloatingControl := Config.GetValue(Path+'HideHeaderCaptionFloatingControl',true);
1622 MultiLinePages := Config.GetValue(Path+'MultiLinePages',false);
1623 PageAreaInPercent := Config.GetValue(Path+'PageAreaInPercent',40);
1624 ScaleOnResize := Config.GetValue(Path+'ScaleOnResize',true);
1625 ShowHeader := Config.GetValue(Path+'ShowHeader',true);
1626 ShowHeaderCaption := Config.GetValue(Path+'ShowHeaderCaption',true);
1627 SplitterWidth := Config.GetValue(Path+'SplitterWidth',4);
1628 end;
1629
1630 { TStyleOfForm }
1631
1632 class operator TStyleOfForm. = (Item1, Item2: TStyleOfForm): Boolean;
1633 begin
1634 Result := (Item1.Form = Item2.Form) and
1635 (Item1.FormStyle = Item2.FormStyle);
1636 end;
1637
1638 { TFormStyles }
1639
1640 procedure TFormStyles.AddForm(const AForm: TCustomForm);
1641 var
1642 AStyleOfForm: TStyleOfForm;
1643 begin
1644 if not Assigned(AForm) then Exit;
1645 if IndexOfForm(AForm) >= 0 then Exit;
1646 AStyleOfForm.Form := AForm;
1647 AStyleOfForm.FormStyle := AForm.FormStyle;
1648 Add(AStyleOfForm);
1649 end;
1650
IndexOfFormnull1651 function TFormStyles.IndexOfForm(const AForm: TCustomForm): Integer;
1652 var
1653 i: Integer;
1654 begin
1655 for i := 0 to Count - 1 do
1656 if Self[i].Form = AForm then Exit(i);
1657 Result := -1;
1658 end;
1659
1660 procedure TFormStyles.RemoveForm(const AForm: TCustomForm);
1661 var
1662 AIndex: Integer;
1663 begin
1664 AIndex := IndexOfForm(AForm);
1665 if AIndex < 0 then Exit;
1666 Delete(AIndex);
1667 end;
1668
1669 { TAnchorDockMaster }
1670
GetControlsnull1671 function TAnchorDockMaster.GetControls(Index: integer): TControl;
1672 begin
1673 Result:=TControl(FControls[Index]);
1674 end;
1675
1676 procedure TAnchorDockMaster.FormFirstShow(Sender: TObject);
1677 var
1678 AForm: TCustomForm absolute Sender;
1679 IsMainDockForm: Boolean;
1680 begin
1681 if not (Sender is TCustomForm) then Exit;
1682 if fsModal in AForm.FormState then Exit;
1683 if AForm.FormStyle in fsAllStayOnTop then Exit;
1684 if not FloatingWindowsOnTop then Exit;
1685 IsMainDockForm := (AForm = MainDockForm)
1686 or (AForm.IsParentOf(MainDockForm))
1687 or (GetParentForm(AForm) = MainDockForm);
1688 if IsMainDockForm then
1689 AForm.FormStyle := fsNormal
1690 else
1691 AForm.FormStyle := fsStayOnTop;
1692 {$IFDEF VerboseADFloatingWindowsOnTop}
1693 DebugLn('TAnchorDockMaster.FormFirstShow ', DbgSName(AForm), ': ', DbgS(AForm.FormStyle));
1694 {$ENDIF}
1695 end;
1696
TAnchorDockMaster.GetLocalizedHeaderHintnull1697 function TAnchorDockMaster.GetLocalizedHeaderHint: string;
1698 begin
1699 if HeaderHint<>'' then
1700 Result:=HeaderHint
1701 else
1702 Result:=adrsDragAndDockC;
1703 end;
1704
TAnchorDockMaster.GetMainDockFormnull1705 function TAnchorDockMaster.GetMainDockForm: TCustomForm;
1706 begin
1707 if not Assigned(FMainDockForm) then
1708 FMainDockForm := Application.MainForm;
1709 // Workaround: if FloatingWindowsOnTop is loaded on MainForm.Create
1710 // Application.MainForm is not set now, but already in Screen.Forms
1711 // see https://bugs.freepascal.org/view.php?id=19272
1712 if not Assigned(FMainDockForm) and (Screen.FormCount > 0) then
1713 FMainDockForm := Screen.Forms[0];
1714 Result := FMainDockForm;
1715 end;
1716
1717 procedure TAnchorDockMaster.SetHeaderAlignLeft(const AValue: integer);
1718 begin
1719 if FHeaderAlignLeft=AValue then exit;
1720 FHeaderAlignLeft:=AValue;
1721 FHeaderAlignTop:=Min(FHeaderAlignLeft-1,FHeaderAlignTop);
1722 OptionsChanged;
1723 end;
1724
1725 procedure TAnchorDockMaster.SetHeaderAlignTop(const AValue: integer);
1726 begin
1727 if FHeaderAlignTop=AValue then exit;
1728 FHeaderAlignTop:=AValue;
1729 FHeaderAlignLeft:=Max(FHeaderAlignTop+1,FHeaderAlignLeft);
1730 OptionsChanged;
1731 end;
1732
1733 procedure TAnchorDockMaster.MarkCorrectlyLocatedControl(Tree: TAnchorDockLayoutTree);
1734 var
1735 Counter:integer;
1736
GetRealParentnull1737 function GetRealParent(Node:TAnchorDockLayoutTreeNode):TAnchorDockLayoutTreeNode;
1738 begin
1739 result := Node;
1740 while Assigned(result.Parent) do begin
1741 result := result.Parent;
1742 fTreeNameToDocker[Node.Name];
1743 if result.NodeType in [adltnControl,adltnCustomSite] then exit
1744 end;
1745 end;
1746
GetDockParentnull1747 function GetDockParent(Control: TControl): TControl;
1748 begin
1749 Control := Control.Parent;
1750 while (Control <> nil) and (Control.Parent <> nil) do
1751 begin
1752 if not (Control is TAnchorDockHostSite) then
1753 Break;
1754 Control := Control.Parent;
1755 end;
1756 Result := Control;
1757 end;
1758
1759 procedure RealChildrenCount(AWinControl:twincontrol;var realsubcontrolcoun:integer);
1760 var
1761 i:integer;
1762 ACountedControl:tcontrol;
1763 begin
1764 for i:=0 to AWinControl.ControlCount-1 do
1765 begin
1766 ACountedControl:=AWinControl.Controls[i];
1767 if not (ACountedControl is TAnchorDockHostSite) then
1768 if not (ACountedControl is TAnchorDockHeader) then
1769 if not (ACountedControl is TAnchorDockPageControl) then
1770 if ACountedControl.IsVisible then
1771 inc(realsubcontrolcoun);
1772 if ACountedControl is TAnchorDockHostSite then
1773 if ACountedControl.IsVisible then
1774 RealChildrenCount(ACountedControl as TWinControl, realsubcontrolcoun);
1775 end;
1776 end;
1777
CheckNodenull1778 function CheckNode(Node: TAnchorDockLayoutTreeNode; var ControlsCount: integer):TADLControlLocation;
1779 var
1780 i: Integer;
1781 AControl,AParent: TControl;
1782 SubControlsCount,realsubcontrolcoun: integer;
1783 begin
1784 if Node.IsSplitter then begin
1785 inc(ControlsCount);
1786 exit(adlclCorrect);
1787 end
1788 else if Node=Tree.Root then begin
1789 result:=adlclCorrect;
1790 AControl:=nil;
1791 AParent:=nil;
1792 end
1793 else begin
1794 AControl:=FindControl(Node.Name);
1795 AParent:=FindControl(GetRealParent(Node).Name);
1796 if Node.NodeType=adltnLayout then result:=adlclCorrect
1797 else if AControl is TAnchorDockPanel then result:=adlclCorrect
1798 else if AControl=nil then result:=adlclWrongly
1799 else if GetDockParent(AControl)<>AParent then result:=adlclWrongly
1800 else
1801 begin
1802 end;
1803 end;
1804 if AControl<>nil then
1805 if not (AControl is TAnchorDockHostSite) then
1806 inc(ControlsCount);
1807 if result=adlclWrongly then exit;
1808 if AControl=nil then AControl:=AParent;
1809 SubControlsCount:=0;
1810 for i:=0 to Node.Count-1 do
1811 begin
1812 result:=CheckNode(Node[i],SubControlsCount);
1813 if result=adlclWrongly then exit;
1814 end;
1815 realsubcontrolcoun:=0;
1816 if (AControl is TAnchorDockHostSite) or (AControl is TAnchorDockPanel) then
1817 begin
1818 RealChildrenCount(AControl as TWinControl,realsubcontrolcoun);
1819 if SubControlsCount<>realsubcontrolcoun then Exit(adlclWrongly);
1820 end;
1821 ControlsCount:=ControlsCount+SubControlsCount;
1822 if result=adlclWrongly then exit;
1823 for i:=0 to Node.Count-1 do
1824 begin
1825 Node[i].ControlLocation:=adlclCorrect;
1826 end;
1827 end;
1828
1829 begin
1830 //We need compare dock tree and fact controls placement
1831 //and mark controls which location is coincides with tree
1832 //these controls can be not closrd in CloseUnneededAndWronglyLocatedControls
1833 Counter:=0;
1834 Tree.Root.ControlLocation:=CheckNode(Tree.Root,Counter);
1835 end;
1836
CloseUnneededAndWronglyLocatedControlsnull1837 function TAnchorDockMaster.CloseUnneededAndWronglyLocatedControls(Tree: TAnchorDockLayoutTree
1838 ): boolean;
1839
GetParentAnchorDockPageControlnull1840 function GetParentAnchorDockPageControl(thisControl: TControl):TAnchorDockPageControl;
1841 begin
1842 while thisControl<>nil do
1843 begin
1844 if thisControl is TAnchorDockPageControl then
1845 exit(thisControl as TAnchorDockPageControl);
1846 thisControl:=thisControl.Parent;
1847 end;
1848 result:=nil;
1849 end;
1850
1851 var
1852 i: Integer;
1853 AControl: TControl;
1854 TreeNodeControl: TAnchorDockLayoutTreeNode;
1855 ParentAnchorDockPageControl:TAnchorDockPageControl;
1856 begin
1857 i:=ControlCount-1;
1858 while i>=0 do begin
1859 AControl:=Controls[i];
1860 TreeNodeControl:=Tree.Root.FindChildNode(AControl.Name,true);
1861 if DockedControlIsVisible(AControl)
1862 and (Application.MainForm<>AControl)
1863 and (not(AControl is TAnchorDockPanel))
1864 and ((Tree.Root.FindChildNode(AControl.Name,true)=nil)
1865 or (TreeNodeControl.ControlLocation=adlclWrongly)) then begin
1866 ParentAnchorDockPageControl:=GetParentAnchorDockPageControl(AControl);
1867 DisableControlAutoSizing(AControl);
1868 // AControl is currently on a visible site, but not in the Tree
1869 // => close site
1870 if AControl.HostDockSite <> nil then
1871 begin
1872 {$IFDEF VerboseAnchorDocking}
1873 debugln(['TAnchorDockMaster.CloseUnneededControls Control=',DbgSName(AControl),' Site=',AControl.HostDockSite.Name]);
1874 {$ENDIF}
1875 if AControl.HostDockSite is TAnchorDockHostSite then begin
1876 if not TAnchorDockHostSite(AControl.HostDockSite).CloseSite then begin
1877 if FControls.IndexOf(AControl)<0 then
1878 AControl:=nil;
1879 {$IFDEF VerboseAnchorDocking}
1880 debugln(['TAnchorDockMaster.CloseUnneededControls CloseSite failed Control=',DbgSName(AControl)]);
1881 {$ENDIF}
1882 exit(false);
1883 end;
1884 end;
1885 end;
1886 if FControls.IndexOf(AControl)>=0 then begin
1887 // the control is still there
1888 if AControl.HostDockSite<>nil then begin
1889 AControl.HostDockSite.Visible:=false;
1890 AControl.HostDockSite.Parent:=nil;
1891 end else begin
1892 AControl.Visible:=False;
1893 AControl.Parent:=nil;
1894 end;
1895 end;
1896 if ParentAnchorDockPageControl<>nil then
1897 if ParentAnchorDockPageControl.Parent<>nil then
1898 ParentAnchorDockPageControl.Parent.Free;
1899 end;
1900 i:=Min(i,ControlCount)-1;
1901 end;
1902 Result:=true;
1903 end;
1904
CreateNeededControlsnull1905 function TAnchorDockMaster.CreateNeededControls(Tree: TAnchorDockLayoutTree;
1906 DisableAutoSizing: boolean; ControlNames: TStrings): boolean;
1907
1908 procedure CreateControlsForNode(Node: TAnchorDockLayoutTreeNode);
1909 var
1910 i: Integer;
1911 AControl: TControl;
1912 begin
1913 if (Node.NodeType in [adltnControl,adltnCustomSite])
1914 and (Node.Name<>'') then begin
1915 AControl:=FindControl(Node.Name);
1916 if AControl<>nil then begin
1917 //debugln(['CreateControlsForNode ',Node.Name,' already exists']);
1918 if DisableAutoSizing then
1919 DisableControlAutoSizing(AControl);
1920 end else begin
1921 //debugln(['CreateControlsForNode ',Node.Name,' needs creation']);
1922 AControl:=DoCreateControl(Node.Name,true);
1923 if AControl<>nil then begin
1924 try
1925 if DisableAutoSizing and (fDisabledAutosizing.IndexOf(AControl)<0)
1926 then begin
1927 fDisabledAutosizing.Add(AControl);
1928 AControl.FreeNotification(Self);
1929 end;
1930 if Node.NodeType=adltnControl then
1931 MakeDockable(AControl,false)
1932 else if not IsCustomSite(AControl) then
1933 raise EAnchorDockLayoutError.Create('not a docksite: '+DbgSName(AControl));
1934 finally
1935 if not DisableAutoSizing then
1936 AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF};
1937 end;
1938 end else begin
1939 debugln(['CreateControlsForNode ',Node.Name,' failed to create']);
1940 end;
1941 end;
1942 if AControl<>nil then
1943 ControlNames.Add(AControl.Name);
1944 end;
1945 for i:=0 to Node.Count-1 do
1946 CreateControlsForNode(Node[i]);
1947 end;
1948
1949 begin
1950 Result:=false;
1951 CreateControlsForNode(Tree.Root);
1952 Result:=true;
1953 end;
1954
1955 procedure TAnchorDockMaster.MapTreeToControls(Tree: TAnchorDockLayoutTree);
1956
1957 procedure MapHostDockSites(Node: TAnchorDockLayoutTreeNode);
1958 // map in TreeNameToDocker each control name to its HostDockSite or custom dock site
1959 var
1960 i: Integer;
1961 AControl: TControl;
1962 begin
1963 if Node.IsSplitter then exit;
1964 if (Node.NodeType=adltnControl) then begin
1965 AControl:=FindControl(Node.Name);
1966 if (AControl<>nil) and (AControl.HostDockSite is TAnchorDockHostSite) then
1967 fTreeNameToDocker[Node.Name]:=AControl.HostDockSite;
1968 // ignore kids
1969 exit;
1970 end;
1971 if (Node.NodeType=adltnCustomSite) then begin
1972 AControl:=FindControl(Node.Name);
1973 if IsCustomSite(AControl) or (AControl is TAnchorDockPanel) then
1974 fTreeNameToDocker[Node.Name]:=AControl;
1975 end;
1976 for i:=0 to Node.Count-1 do
1977 MapHostDockSites(Node[i]); // recursive
1978 end;
1979
1980 procedure MapTopLevelSites(Node: TAnchorDockLayoutTreeNode);
1981 // map in TreeNameToDocker each RootWindow node name to a site with a
1982 // corresponding control
1983 // For example: if there is control on a complex site (SiteA), and the control
1984 // has a node in the Tree, then the root node of the tree node is mapped to
1985 // the SiteA. This way the corresponding root forms are kept which reduces
1986 // flickering.
1987
FindMappedControlnull1988 function FindMappedControl(ChildNode: TAnchorDockLayoutTreeNode): TCustomForm;
1989 var
1990 i: Integer;
1991 begin
1992 if ChildNode.NodeType in [adltnControl,adltnCustomSite] then
1993 Result:=TCustomForm(fTreeNameToDocker[ChildNode.Name])
1994 else
1995 for i:=0 to ChildNode.Count-1 do begin
1996 Result:=FindMappedControl(ChildNode[i]); // search recursive
1997 if Result<>nil then exit;
1998 end;
1999 end;
2000
2001 var
2002 i: Integer;
2003 RootSite: TCustomForm;
2004 Site: TCustomForm;
2005 begin
2006 if Node.IsSplitter then exit;
2007 if Node.IsRootWindow then begin
2008 if Node.Name='' then exit;
2009 if Node.NodeType=adltnControl then exit;
2010 // Node is a complex site
2011 if fTreeNameToDocker[Node.Name]<>nil then exit;
2012 // and not yet mapped to a site
2013 Site:=FindMappedControl(Node);
2014 if Site=nil then exit;
2015 // and there is sub node mapped to a site (anchor or custom)
2016 RootSite:=GetParentForm(Site);
2017 if not (RootSite is TAnchorDockHostSite) then exit;
2018 // and the mapped site has a root site
2019 if fTreeNameToDocker.ControlToName(RootSite)<>'' then exit;
2020 // and the root site is not yet mapped
2021 // => map the root node to the root site
2022 fTreeNameToDocker[Node.Name]:=RootSite;
2023 end else
2024 for i:=0 to Node.Count-1 do
2025 MapTopLevelSites(Node[i]); // recursive
2026 end;
2027
2028 procedure MapBottomUp(Node: TAnchorDockLayoutTreeNode);
2029 { map the other nodes to existing sites
2030 The heuristic works like this:
2031 if a child node was mapped to a site and the site has a parent site then
2032 map this node to this parent site.
2033 }
2034 var
2035 i: Integer;
2036 BestSite: TControl;
2037 begin
2038 if Node.IsSplitter then exit;
2039 BestSite:=fTreeNameToDocker[Node.Name];
2040 for i:=0 to Node.Count-1 do begin
2041 MapBottomUp(Node[i]); // recursive
2042 if BestSite=nil then
2043 BestSite:=fTreeNameToDocker[Node[i].Name];
2044 end;
2045 if (fTreeNameToDocker[Node.Name]=nil) and (BestSite<>nil) then begin
2046 // search the parent site of a child site
2047 repeat
2048 if BestSite is TAnchorDockPanel then begin
2049 if fTreeNameToDocker.ControlToName(BestSite)='' then
2050 fTreeNameToDocker[Node.Name]:=BestSite;
2051 break;
2052 end;
2053 BestSite:=BestSite.Parent;
2054 if BestSite is TAnchorDockHostSite then begin
2055 if fTreeNameToDocker.ControlToName(BestSite)='' then
2056 fTreeNameToDocker[Node.Name]:=BestSite;
2057 break;
2058 end;
2059 until (BestSite=nil);
2060 end;
2061 end;
2062
2063 procedure MapSplitters(Node: TAnchorDockLayoutTreeNode);
2064 { map the splitter nodes to existing splitters
2065 The heuristic works like this:
2066 If a node is mapped to a site and the node is at Side anchored to a
2067 splitter node and the site is anchored at Side to a splitter
2068 then map the splitter node to the splitter.
2069 }
2070 var
2071 i: Integer;
2072 Side: TAnchorKind;
2073 Site: TControl;
2074 SplitterNode: TAnchorDockLayoutTreeNode;
2075 Splitter: TControl;
2076 begin
2077 if Node.IsSplitter then exit;
2078 for i:=0 to Node.Count-1 do
2079 MapSplitters(Node[i]); // recursive
2080
2081 if Node.Parent=nil then exit;
2082 // node is a child node
2083 Site:=fTreeNameToDocker[Node.Name];
2084 if Site=nil then exit;
2085 // node is mapped to a site
2086 // check each side
2087 for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin
2088 if Node.Anchors[Side]='' then continue;
2089 Splitter:=Site.AnchorSide[Side].Control;
2090 if (not (Splitter is TAnchorDockSplitter))
2091 or (Splitter.Parent<>Site.Parent) then continue;
2092 SplitterNode:=Node.Parent.FindChildNode(Node.Anchors[Side],false);
2093 if (SplitterNode=nil) then continue;
2094 // this Side of node is anchored to a splitter node
2095 if fTreeNameToDocker[SplitterNode.Name]<>nil then continue;
2096 // the SplitterNode is not yet mapped
2097 if fTreeNameToDocker.ControlToName(Splitter)<>'' then continue;
2098 // there is an unmapped splitter anchored to the Site
2099 // => map the splitter to the splitter node
2100 // Note: Splitter.Name can be different from SplitterNode.Name !
2101 fTreeNameToDocker[SplitterNode.Name]:=Splitter;
2102 end;
2103 end;
2104
2105 begin
2106 MapHostDockSites(Tree.Root);
2107 MapTopLevelSites(Tree.Root);
2108 MapBottomUp(Tree.Root);
2109 MapSplitters(Tree.Root);
2110 end;
2111
SrcRectValidnull2112 function SrcRectValid(const r: TRect): boolean;
2113 begin
2114 Result:=(r.Left<r.Right) and (r.Top<r.Bottom);
2115 end;
2116
TAnchorDockMaster.ScaleTopLvlXnull2117 function TAnchorDockMaster.ScaleTopLvlX(p: integer): integer;
2118 begin
2119 Result:=p;
2120 if SrcRectValid(SrcWorkArea) and SrcRectValid(WorkArea) then
2121 Result:=((p-SrcWorkArea.Left)*(WorkArea.Right-WorkArea.Left))
2122 div (SrcWorkArea.Right-SrcWorkArea.Left)
2123 +WorkArea.Left;
2124 end;
2125
TAnchorDockMaster.ScaleTopLvlYnull2126 function TAnchorDockMaster.ScaleTopLvlY(p: integer): integer;
2127 begin
2128 Result:=p;
2129 if SrcRectValid(SrcWorkArea) and SrcRectValid(WorkArea) then
2130 Result:=((p-SrcWorkArea.Top)*(WorkArea.Bottom-WorkArea.Top))
2131 div (SrcWorkArea.Bottom-SrcWorkArea.Top)
2132 +WorkArea.Top;
2133 end;
2134
TAnchorDockMaster.ScaleChildXnull2135 function TAnchorDockMaster.ScaleChildX(p: integer): integer;
2136 begin
2137 Result:=p;
2138 if SrcRectValid(SrcWorkArea) and SrcRectValid(WorkArea) then
2139 Result:=p*(WorkArea.Right-WorkArea.Left)
2140 div (SrcWorkArea.Right-SrcWorkArea.Left);
2141 end;
2142
TAnchorDockMaster.ScaleChildYnull2143 function TAnchorDockMaster.ScaleChildY(p: integer): integer;
2144 begin
2145 Result:=p;
2146 if SrcRectValid(SrcWorkArea) and SrcRectValid(WorkArea) then
2147 Result:=p*(WorkArea.Bottom-WorkArea.Top)
2148 div (SrcWorkArea.Bottom-SrcWorkArea.Top);
2149 end;
2150
2151 procedure TAnchorDockMaster.SetupSite(Site: TWinControl;
2152 ANode: TAnchorDockLayoutTreeNode; AParent: TWinControl);
2153 var
2154 aManager: TAnchorDockManager;
2155 NewBounds: TRect;
2156 aMonitor: TMonitor;
2157 aHostSite: TAnchorDockHostSite;
2158 ParentForm: TCustomForm;
2159 begin
2160 if Site is TCustomForm then begin
2161 Site.Align:=alNone;
2162 TCustomForm(Site).PixelsPerInch:=Screen.PixelsPerInch;
2163 if AParent=nil then
2164 TCustomForm(Site).WindowState:=ANode.WindowState
2165 else
2166 TCustomForm(Site).WindowState:=wsNormal;
2167 end else begin
2168 ParentForm:=GetParentForm(Site);
2169 ParentForm.WindowState:=ANode.WindowState;
2170 ParentForm.PixelsPerInch:=Screen.PixelsPerInch;
2171 end;
2172 if Site is TAnchorDockPanel then
2173 ParentForm.BoundsRect:=ScaleBoundsRect(ANode.BoundsRect,ANode.PixelsPerInch,Screen.PixelsPerInch)
2174 else begin
2175 if AParent=nil then begin
2176 if (ANode.Monitor>=0) and (ANode.Monitor<Screen.MonitorCount) then
2177 aMonitor:=Screen.Monitors[ANode.Monitor]
2178 else begin
2179 if Site is TCustomForm then
2180 aMonitor:=TCustomForm(Site).Monitor
2181 else
2182 aMonitor:=ParentForm.Monitor;
2183 end;
2184 WorkArea:=aMonitor.WorkareaRect;
2185 {$IFDEF VerboseAnchorDockRestore}
2186 debugln(['TAnchorDockMaster.RestoreLayout.SetupSite WorkArea=',dbgs(WorkArea)]);
2187 {$ENDIF}
2188 end;
2189 end;
2190 if IsCustomSite(Site) then begin
2191 aManager:=TAnchorDockManager(Site.DockManager);
2192 if ANode.Count>0 then begin
2193 // this custom dock site gets a child => store and clear constraints
2194 aManager.StoreConstraints;
2195 end;
2196 end;
2197 Site.Constraints.MaxWidth:=0;
2198 Site.Constraints.MaxHeight:=0;
2199 NewBounds:=ScaleBoundsRect(ANode.BoundsRect,ANode.PixelsPerInch,Screen.PixelsPerInch);
2200 if AParent=nil then begin
2201 NewBounds:=Rect(ScaleTopLvlX(NewBounds.Left),ScaleTopLvlY(NewBounds.Top),
2202 ScaleTopLvlX(NewBounds.Right),ScaleTopLvlY(NewBounds.Bottom));
2203 end else begin
2204 if AParent is TAnchorDockPanel then
2205 begin
2206 NewBounds:=Rect(0,0,AParent.ClientWidth,AParent.ClientHeight);
2207 Site.Align:=alClient;
2208 end
2209 else
2210 NewBounds:=Rect(ScaleChildX(NewBounds.Left), ScaleChildY(NewBounds.Top),
2211 ScaleChildX(NewBounds.Right),ScaleChildY(NewBounds.Bottom));
2212 end;
2213 {$IFDEF VerboseAnchorDockRestore}
2214 //if Scale then
2215 debugln(['TAnchorDockMaster.RestoreLayout.SetupSite scale Site=',DbgSName(Site),' Caption="',Site.Caption,'" OldWorkArea=',dbgs(SrcWorkArea),' CurWorkArea=',dbgs(WorkArea),' OldBounds=',dbgs(aNode.BoundsRect),' NewBounds=',dbgs(NewBounds)]);
2216 {$ENDIF}
2217 Site.Visible:=true;
2218 if not (Site is TAnchorDockPanel) then
2219 begin
2220 Site.BoundsRect:=NewBounds;
2221 Site.Parent:=AParent;
2222 end;
2223 if IsCustomSite(AParent) then begin
2224 aManager:=TAnchorDockManager(AParent.DockManager);
2225 Site.Align:=ANode.Align;
2226 {$IFDEF VerboseAnchorDockRestore}
2227 debugln(['TAnchorDockMaster.RestoreLayout.SetupSite custom Site=',DbgSName(Site),' Site.Bounds=',dbgs(Site.BoundsRect),' BoundSplitterPos=',aNode.BoundSplitterPos]);
2228 {$ENDIF}
2229 if Application.Scaled then
2230 aManager.RestoreSite(MulDiv(ANode.BoundSplitterPos,Screen.PixelsPerInch,ANode.PixelsPerInch))
2231 else
2232 aManager.RestoreSite(ANode.BoundSplitterPos);
2233 Site.HostDockSite:=AParent;
2234 end;
2235 if Site is TAnchorDockHostSite then begin
2236 aHostSite:=TAnchorDockHostSite(Site);
2237 aHostSite.Header.HeaderPosition:=ANode.HeaderPosition;
2238 aHostSite.DockRestoreBounds:=NewBounds;
2239 //aHostSite.FMinimized:=ANode.Minimized;
2240 //we update aHostSite.FMinimized in TAnchorDockMaster.SetMinimizedState
2241 if (ANode.NodeType<>adltnPages) and (aHostSite.Pages<>nil) then
2242 aHostSite.FreePages;
2243 end;
2244 end;
2245
TAnchorDockMaster.GetNodeSitenull2246 function TAnchorDockMaster.GetNodeSite(Node: TAnchorDockLayoutTreeNode): TAnchorDockHostSite;
2247 var
2248 Site: TControl;
2249 begin
2250 Site:=fTreeNameToDocker[Node.Name];
2251 if Site is TAnchorDockHostSite then
2252 exit(TAnchorDockHostSite(Site));
2253 if Site<>nil then
2254 exit(nil);
2255 Result:=CreateSite;
2256 fDisabledAutosizing.Add(Result);
2257 fTreeNameToDocker[Node.Name]:=Result;
2258 end;
2259
2260 procedure TAnchorDockMaster.SetNodeMinimizedState(ANode: TAnchorDockLayoutTreeNode);
2261 var
2262 HostSite:TAnchorDockHostSite;
2263 i:integer;
2264 begin
2265 HostSite:=GetNodeSite(ANode);
2266 if Assigned(HostSite) then
2267 if HostSite.Minimized<>ANode.Minimized then
2268 Application.QueueAsyncCall(@HostSite.AsyncMinimizeSite,0);
2269 //HostSite.MinimizeSite;
2270 for i:=0 to ANode.Count-1 do
2271 SetNodeMinimizedState(ANode.Nodes[i]);
2272 end;
2273
2274 procedure TAnchorDockMaster.SetMinimizedState(Tree: TAnchorDockLayoutTree);
2275 begin
2276 SetNodeMinimizedState(Tree.Root);
2277 end;
2278
RestoreLayoutnull2279 function TAnchorDockMaster.RestoreLayout(Tree: TAnchorDockLayoutTree;
2280 Scale: boolean): boolean;
2281
Restorenull2282 function Restore(ANode: TAnchorDockLayoutTreeNode; AParent: TWinControl): TControl;
2283 var
2284 AControl: TControl;
2285 Site: TAnchorDockHostSite;
2286 Splitter: TAnchorDockSplitter;
2287 i, j: Integer;
2288 Side: TAnchorKind;
2289 AnchorControl: TControl;
2290 ChildNode: TAnchorDockLayoutTreeNode;
2291 NewBounds: TRect;
2292 aPageName: String;
2293 aPage: TCustomPage;
2294 begin
2295 Result:=nil;
2296 if Scale and SrcRectValid(ANode.WorkAreaRect) then
2297 SrcWorkArea:=ANode.WorkAreaRect;
2298 {$IFDEF VerboseAnchorDockRestore}
2299 debugln(['TAnchorDockMaster.RestoreLayout.Restore Node="',aNode.Name,'" ',dbgs(aNode.NodeType),' Bounds=',dbgs(aNode.BoundsRect),' Parent=',DbgSName(aParent),' ']);
2300 {$ENDIF}
2301 AControl:=nil;
2302 if ANode.NodeType in [adltnControl, adltnCustomSite] then
2303 begin
2304 AControl:=FindControl(ANode.Name);
2305 if AControl=nil then begin
2306 debugln(['TAnchorDockMaster.RestoreLayout.Restore WARNING: can not find control ',ANode.Name,
2307 ', NodeType=', ANode.NodeType]);
2308 exit;
2309 end;
2310 end;
2311 if ANode.NodeType=adltnControl then begin
2312 // restore control
2313 // the control was already created => dock it
2314 DisableControlAutoSizing(AControl);
2315 if AControl.HostDockSite=nil then
2316 MakeDockable(AControl,false)
2317 else
2318 ClearLayoutProperties(AControl);
2319 {$IFDEF VerboseAnchorDockRestore}
2320 debugln(['TAnchorDockMaster.RestoreLayout.Restore Control Node.Name=',aNode.Name,
2321 ' Control=',DbgSName(AControl),' Site=',DbgSName(AControl.HostDockSite)]);
2322 {$ENDIF}
2323 AControl.Visible:=true;
2324 SetupSite(AControl.HostDockSite,ANode,AParent);
2325 Result:=AControl.HostDockSite;
2326 end
2327 else if ANode.NodeType=adltnCustomSite then begin
2328 // restore custom dock site
2329 // the control was already created => position it
2330 if not (IsCustomSite(AControl) or (AControl is TAnchorDockPanel)) then begin
2331 debugln(['TAnchorDockMaster.RestoreLayout.Restore WARNING: ',ANode.Name,' is not a custom dock site ',DbgSName(AControl)]);
2332 exit;
2333 end;
2334 DisableControlAutoSizing(AControl);
2335 SetupSite(TCustomForm(AControl),ANode,nil);
2336 Result:=AControl;
2337 // restore docked site
2338 if ANode.Count>0 then
2339 Restore(ANode[0],TCustomForm(AControl));
2340 end
2341 else if ANode.IsSplitter then begin
2342 // restore splitter
2343 Splitter:=TAnchorDockSplitter(fTreeNameToDocker[ANode.Name]);
2344 if Splitter=nil then begin
2345 Splitter:=CreateSplitter;
2346 fTreeNameToDocker[ANode.Name]:=Splitter;
2347 end;
2348 {$IFDEF VerboseAnchorDockRestore}
2349 debugln(['TAnchorDockMaster.RestoreLayout.Restore Splitter Node.Name=',aNode.Name,' ',dbgs(aNode.NodeType),' Splitter=',DbgSName(Splitter)]);
2350 {$ENDIF}
2351 Splitter.Parent:=AParent;
2352 NewBounds:=ScaleBoundsRect(ANode.BoundsRect,ANode.PixelsPerInch,Screen.PixelsPerInch);
2353 if SrcRectValid(SrcWorkArea) then
2354 NewBounds:=Rect(ScaleChildX(NewBounds.Left),ScaleChildY(NewBounds.Top),
2355 ScaleChildX(NewBounds.Right),ScaleChildY(NewBounds.Bottom));
2356 Splitter.DockRestoreBounds:=NewBounds;
2357 Splitter.BoundsRect:=NewBounds;
2358 if ANode.NodeType=adltnSplitterVertical then begin
2359 Splitter.ResizeAnchor:=akLeft;
2360 Splitter.AnchorSide[akLeft].Control:=nil;
2361 Splitter.AnchorSide[akRight].Control:=nil;
2362 end else begin
2363 Splitter.ResizeAnchor:=akTop;
2364 Splitter.AnchorSide[akTop].Control:=nil;
2365 Splitter.AnchorSide[akBottom].Control:=nil;
2366 end;
2367 Result:=Splitter;
2368 Splitter.AsyncUpdateDockBounds:=true;
2369 end else if ANode.NodeType=adltnLayout then begin
2370 // restore layout
2371 Site:=GetNodeSite(ANode);
2372 {$IFDEF VerboseAnchorDockRestore}
2373 debugln(['TAnchorDockMaster.RestoreLayout.Restore Layout Node.Name=',aNode.Name,' ChildCount=',aNode.Count]);
2374 {$ENDIF}
2375 Site.BeginUpdateLayout;
2376 try
2377 SetupSite(Site,ANode,AParent);
2378 Site.FSiteType:=adhstLayout;
2379 Site.Header.Parent:=nil;
2380 // create children
2381 for i:=0 to ANode.Count-1 do
2382 Restore(ANode[i],Site);
2383 // anchor children
2384 for i:=0 to ANode.Count-1 do begin
2385 ChildNode:=ANode[i];
2386 AControl:=fTreeNameToDocker[ChildNode.Name];
2387 {$IFDEF VerboseAnchorDockRestore}
2388 debugln([' Restore layout child anchors Site=',DbgSName(Site),' ChildNode.Name=',ChildNode.Name,' Control=',DbgSName(AControl)]);
2389 {$ENDIF}
2390 if AControl=nil then continue;
2391 for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin
2392 if ((ChildNode.NodeType=adltnSplitterHorizontal)
2393 and (Side in [akTop,akBottom]))
2394 or ((ChildNode.NodeType=adltnSplitterVertical)
2395 and (Side in [akLeft,akRight]))
2396 then continue;
2397 AnchorControl:=nil;
2398 if ChildNode.Anchors[Side]<>'' then begin
2399 AnchorControl:=fTreeNameToDocker[ChildNode.Anchors[Side]];
2400 if AnchorControl=nil then
2401 debugln(['WARNING: TAnchorDockMaster.RestoreLayout.Restore: Node=',ChildNode.Name,' Anchor[',dbgs(Side),']=',ChildNode.Anchors[Side],' not found']);
2402 end;
2403 if AnchorControl<>nil then
2404 AControl.AnchorToNeighbour(Side,0,AnchorControl)
2405 else
2406 AControl.AnchorParallel(Side,0,Site);
2407 end;
2408 end;
2409 // free unneeded helper controls (e.g. splitters)
2410 for i:=Site.ControlCount-1 downto 0 do begin
2411 AControl:=Site.Controls[i];
2412 if fTreeNameToDocker.ControlToName(AControl)<>'' then continue;
2413 if AControl is TAnchorDockSplitter then begin
2414 AControl.Free;
2415 end;
2416 end;
2417 finally
2418 Site.EndUpdateLayout;
2419 end;
2420 Result:=Site;
2421 end else if ANode.NodeType=adltnPages then begin
2422 // restore pages
2423 Site:=GetNodeSite(ANode);
2424 {$IFDEF VerboseAnchorDockRestore}
2425 debugln(['TAnchorDockMaster.RestoreLayout.Restore Pages Node.Name=',aNode.Name,' ChildCount=',aNode.Count]);
2426 {$ENDIF}
2427 Site.BeginUpdateLayout;
2428 j:=0;
2429 try
2430 SetupSite(Site,ANode,AParent);
2431 Site.FSiteType:=adhstPages;
2432 //Site.Header.Parent:=nil;
2433 if Site.Pages=nil then
2434 Site.CreatePages;
2435 Site.Pages.TabPosition:=ANode.TabPosition;
2436 for i:=0 to ANode.Count-1 do begin
2437 aPageName:=ANode[i].Name;
2438 if j>=Site.Pages.PageCount then
2439 Site.Pages.Pages.Add(aPageName);
2440 aPage:=Site.Pages.Page[j];
2441 inc(j);
2442 AControl:=Restore(ANode[i],aPage);
2443 if AControl=nil then continue;
2444 AControl.Align:=alClient;
2445 for Side:=Low(TAnchorKind) to high(TAnchorKind) do
2446 AControl.AnchorSide[Side].Control:=nil;
2447 end;
2448 Site.Pages.PageIndex:=ANode.PageIndex;
2449 finally
2450 while Site.Pages.PageCount>j do
2451 Site.Pages.Page[Site.Pages.PageCount-1].Free;
2452 Site.SimplifyPages;
2453 Site.EndUpdateLayout;
2454 end;
2455 Result:=Site;
2456 end else begin
2457 // create children
2458 for i:=0 to ANode.Count-1 do
2459 Restore(ANode[i],AParent);
2460 end;
2461 end;
2462
2463 begin
2464 Result:=true;
2465 WorkArea:=Rect(0,0,0,0);
2466 SrcWorkArea:=WorkArea;
2467 Restore(Tree.Root,nil);
2468 Restoring:=true;
2469 end;
2470
2471 procedure TAnchorDockMaster.ScreenFormAdded(Sender: TObject; Form: TCustomForm);
2472 begin
2473 FFormStyles.AddForm(Form);
2474 Form.AddHandlerFirstShow(@FormFirstShow);
2475 end;
2476
2477 procedure TAnchorDockMaster.ScreenRemoveForm(Sender: TObject; Form: TCustomForm);
2478 begin
2479 FFormStyles.RemoveForm(Form);
2480 end;
2481
2482 procedure TAnchorDockMaster.SetMainDockForm(AValue: TCustomForm);
2483 begin
2484 if FMainDockForm = AValue then Exit;
2485 FMainDockForm := AValue;
2486 RefreshFloatingWindowsOnTop;
2487 end;
2488
TAnchorDockMaster.DoCreateControlnull2489 function TAnchorDockMaster.DoCreateControl(aName: string;
2490 DisableAutoSizing: boolean): TControl;
2491 begin
2492 Result:=nil;
2493 OnCreateControl(Self,aName,Result,DisableAutoSizing);
2494 if Result=nil then
2495 debugln(['TAnchorDockMaster.DoCreateControl WARNING: control not found: "',aName,'"']);
2496 if (Result<>nil) and (Result.Name<>aName) then
2497 raise Exception.Create('TAnchorDockMaster.DoCreateControl'+Format(
2498 adrsRequestedButCreated, [aName, Result.Name]));
2499 end;
2500
2501 procedure TAnchorDockMaster.DisableControlAutoSizing(AControl: TControl);
2502 begin
2503 if fDisabledAutosizing.IndexOf(AControl)>=0 then exit;
2504 //debugln(['TAnchorDockMaster.DisableControlAutoSizing ',DbgSName(AControl)]);
2505 fDisabledAutosizing.Add(AControl);
2506 AControl.FreeNotification(Self);
2507 AControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF};
2508 end;
2509
2510 procedure TAnchorDockMaster.EnableAllAutoSizing;
2511 var
2512 i: Integer;
2513 AControl: TControl;
2514 begin
2515 i:=fDisabledAutosizing.Count-1;
2516 while (i>=0) do begin
2517 AControl:=TControl(fDisabledAutosizing[i]);
2518 //debugln(['TAnchorDockMaster.EnableAllAutoSizing ',DbgSName(AControl)]);
2519 fDisabledAutosizing.Delete(i);
2520 AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF};
2521 i:=Min(i,fDisabledAutosizing.Count)-1;
2522 end;
2523 end;
2524
2525 procedure TAnchorDockMaster.ClearLayoutProperties(AControl: TControl;
2526 NewAlign: TAlign);
2527 var
2528 a: TAnchorKind;
2529 begin
2530 AControl.AutoSize:=false;
2531 AControl.Align:=NewAlign;
2532 AControl.BorderSpacing.Around:=0;
2533 AControl.BorderSpacing.Left:=0;
2534 AControl.BorderSpacing.Top:=0;
2535 AControl.BorderSpacing.Right:=0;
2536 AControl.BorderSpacing.Bottom:=0;
2537 AControl.BorderSpacing.InnerBorder:=0;
2538 for a:=Low(TAnchorKind) to High(TAnchorKind) do
2539 AControl.AnchorSide[a].Control:=nil;
2540 end;
2541
2542 procedure TAnchorDockMaster.PopupMenuPopup(Sender: TObject);
2543 var
2544 Popup: TPopupMenu;
2545 ChangeLockItem: TMenuItem;
2546 ShowHeadersItem: TMenuItem;
2547 begin
2548 if not (Sender is TPopupMenu) then exit;
2549 Popup:=TPopupMenu(Sender);
2550 Popup.Items.Clear;
2551
2552 // top popup menu item can be clicked by accident, so use something simple:
2553 // lock/unlock
2554 ChangeLockItem:=AddPopupMenuItem('AnchorDockMasterChangeLockMenuItem',
2555 adrsLocked,@ChangeLockButtonClick);
2556 ChangeLockItem.Checked:=not AllowDragging;
2557 ChangeLockItem.ShowAlwaysCheckable:=true;
2558
2559 if Popup.PopupComponent is TAnchorDockHeader then
2560 TAnchorDockHeader(Popup.PopupComponent).PopupMenuPopup(Sender)
2561 else if Popup.PopupComponent is TAnchorDockPageControl then
2562 TAnchorDockPageControl(Popup.PopupComponent).PopupMenuPopup(Sender)
2563 else if Popup.PopupComponent is TAnchorDockSplitter then
2564 TAnchorDockSplitter(Popup.PopupComponent).PopupMenuPopup(Sender);
2565
2566 if ShowMenuItemShowHeader or (not ShowHeader) then begin
2567 ShowHeadersItem:=AddPopupMenuItem('AnchorDockMasterShowHeaderMenuItem',
2568 adrsShowHeaders, @ShowHeadersButtonClick);
2569 ShowHeadersItem.Checked:=ShowHeader;
2570 ShowHeadersItem.ShowAlwaysCheckable:=true;
2571 end;
2572
2573 if Assigned(OnShowOptions) then
2574 AddPopupMenuItem('OptionsMenuItem', adrsDockingOptions, @OptionsClick);
2575 end;
2576
2577 procedure TAnchorDockMaster.ResetSplitters;
2578 var
2579 I: Integer;
2580 S: TAnchorDockSplitter;
2581 begin
2582 for I := 0 to ComponentCount-1 do
2583 if Components[I] is TAnchorDockSplitter then
2584 begin
2585 S := TAnchorDockSplitter(Components[I]);
2586 S.UpdateDockBounds;
2587 S.UpdatePercentPosition;
2588 end;
2589 end;
2590
FullRestoreLayoutnull2591 function TAnchorDockMaster.FullRestoreLayout(Tree: TAnchorDockLayoutTree;
2592 Scale: Boolean): Boolean;
2593 var
2594 ControlNames: TStringListUTF8Fast;
2595 begin
2596 Result:=false;
2597 ControlNames:=TStringListUTF8Fast.Create;
2598 fTreeNameToDocker:=TADNameToControl.Create;
2599 try
2600
2601 // close all unneeded and wrongly allocated forms/controls (not helper controls like splitters)
2602 MarkCorrectlyLocatedControl(Tree);
2603 if not CloseUnneededAndWronglyLocatedControls(Tree) then exit;
2604
2605 BeginUpdate;
2606 try
2607 // create all needed forms/controls (not helper controls like splitters)
2608 if not CreateNeededControls(Tree,true,ControlNames) then exit;
2609
2610 // simplify layouts
2611 ControlNames.Sort;
2612 {$IFDEF VerboseAnchorDockRestore}
2613 debugln(['TAnchorDockMaster.FullRestoreLayout controls: ']);
2614 debugln(ControlNames.Text);
2615 {$ENDIF}
2616 // if some forms/controls could not be created the layout needs to be adapted
2617 Tree.Root.Simplify(ControlNames,false);
2618
2619 // reuse existing sites to reduce flickering
2620 MapTreeToControls(Tree);
2621 {$IFDEF VerboseAnchorDockRestore}
2622 fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.FullRestoreLayout Map');
2623 {$ENDIF}
2624
2625 // create sites, move controls
2626 RestoreLayout(Tree,Scale);
2627 SetMinimizedState(Tree);
2628 finally
2629 EndUpdate;
2630 end;
2631 finally
2632 // clean up
2633 FreeAndNil(fTreeNameToDocker);
2634 ControlNames.Free;
2635 // commit (this can raise an exception, when it triggers events)
2636 EnableAllAutoSizing;
2637 end;
2638 ResetSplitters; // reset splitters' DockBounds after EnableAllAutoSizing. fixes issue #18538
2639 {$IFDEF VerboseAnchorDockRestore}
2640 DebugWriteChildAnchors(Application.MainForm,true,false);
2641 {$ENDIF}
2642 Result:=true;
2643 end;
2644
2645 procedure TAnchorDockMaster.SetHideHeaderCaptionFloatingControl(
2646 const AValue: boolean);
2647 var
2648 Site: TAnchorDockHostSite;
2649 i: Integer;
2650 begin
2651 if AValue=HideHeaderCaptionFloatingControl then exit;
2652 fHideHeaderCaptionFloatingControl:=AValue;
2653 for i:=0 to ComponentCount-1 do begin
2654 Site:=TAnchorDockHostSite(Components[i]);
2655 if not (Site is TAnchorDockHostSite) then continue;
2656 Site.UpdateDockCaption;
2657 end;
2658 OptionsChanged;
2659 end;
2660
2661 procedure TAnchorDockMaster.SetSplitterWidth(const AValue: integer);
2662 var
2663 i: Integer;
2664 Splitter: TAnchorDockSplitter;
2665 begin
2666 if (AValue<1) or (AValue=SplitterWidth) then exit;
2667 FSplitterWidth:=AValue;
2668 for i:=0 to ComponentCount-1 do begin
2669 Splitter:=TAnchorDockSplitter(Components[i]);
2670 if not (Splitter is TAnchorDockSplitter) then continue;
2671 if not Splitter.CustomWidth then
2672 begin
2673 if Splitter.ResizeAnchor in [akLeft,akRight] then
2674 Splitter.Width:=SplitterWidth
2675 else
2676 Splitter.Height:=SplitterWidth;
2677 end;
2678 end;
2679 OptionsChanged;
2680 end;
2681
2682 procedure TAnchorDockMaster.StartHideOverlappingTimer;
2683 begin
2684 if not DockTimer.Enabled then begin
2685 DockTimer.Interval:=HideOverlappingFormByMouseLoseTime;
2686 DockTimer.OnTimer:=@HideOverlappingForm;
2687 DockTimer.Enabled:=true;
2688 end;
2689 end;
2690
2691 procedure TAnchorDockMaster.StopHideOverlappingTimer;
2692 begin
2693 DockTimer.Enabled:=False;
2694 DockTimer.Interval:=0;
2695 DockTimer.OnTimer:=nil;
2696 end;
2697
2698 function IsParentControl(aParent, aControl: TControl): boolean;
2699 begin
2700 while (aControl <> nil) and (aControl.Parent <> nil) do
2701 begin
2702 if (aControl=aParent) then
2703 exit(true);
2704 aControl := aControl.Parent;
2705 end;
2706 result:=aControl=aParent;
2707 end;
2708
2709
2710 procedure TAnchorDockMaster.OnIdle(Sender: TObject; var Done: Boolean);
2711 var
2712 MousePos: TPoint;
2713 Bounds:Trect;
2714 begin
2715 if Done then ;
2716 Restoring:=false;
2717 if FOverlappingForm=nil then
2718 IdleConnected:=false
2719 else begin
2720 MousePos:=Point(0, 0);
2721 GetCursorPos(MousePos);
2722 Bounds.TopLeft:=FOverlappingForm.ClientToScreen(point(0,0));
2723 Bounds.BottomRight:=FOverlappingForm.ClientToScreen(point(FOverlappingForm.Width,FOverlappingForm.Height));
2724 if not IsParentControl(FOverlappingForm, GetCaptureControl) then begin
2725 if not PtInRect(Bounds,MousePos) then
2726 StartHideOverlappingTimer
2727 else
2728 StopHideOverlappingTimer;
2729 end;
2730 end;
2731 end;
2732
2733 procedure TAnchorDockMaster.AsyncSimplify(Data: PtrInt);
2734 begin
2735 FQueueSimplify:=false;
2736 SimplifyPendingLayouts;
2737 end;
2738
2739 procedure TAnchorDockMaster.ChangeLockButtonClick(Sender: TObject);
2740 begin
2741 AllowDragging:=not AllowDragging;
2742 end;
2743
2744 procedure TAnchorDockMaster.RefreshFloatingWindowsOnTop;
2745 var
2746 i, AIndex: Integer;
2747 AForm, ParentForm: TCustomForm;
2748 IsMainDockForm: Boolean;
2749 AFormStyle: TFormStyle;
2750 begin
2751 for i := 0 to Screen.FormCount - 1 do
2752 begin
2753 AForm := Screen.Forms[i];
2754 if AForm.FormStyle = fsSplash then continue;
2755 ParentForm := GetParentForm(AForm);
2756 if FFloatingWindowsOnTop then
2757 begin
2758 IsMainDockForm := (AForm = MainDockForm)
2759 or (AForm.IsParentOf(MainDockForm))
2760 or (ParentForm = MainDockForm);
2761 if IsMainDockForm then
2762 AFormStyle := fsNormal
2763 else
2764 AFormStyle := fsStayOnTop;
2765 end else begin
2766 AIndex := FFormStyles.IndexOfForm(AForm);
2767 if AIndex >= 0 then
2768 AFormStyle := FFormStyles[AIndex].FormStyle
2769 else
2770 AFormStyle := fsNormal;
2771 end;
2772 if ParentForm is TAnchorDockHostSite then
2773 begin
2774 ParentForm.FormStyle := AFormStyle;
2775 {$IFDEF VerboseADFloatingWindowsOnTop}
2776 DebugLn('TAnchorDockMaster.RefreshFloatingWindowsOnTop ',
2777 DbgSName(ParentForm), '(', DbgSName(AForm), '): ', DbgS(AFormStyle));
2778 {$ENDIF}
2779 end else begin
2780 AForm.FormStyle := AFormStyle;
2781 {$IFDEF VerboseADFloatingWindowsOnTop}
2782 DebugLn('TAnchorDockMaster.RefreshFloatingWindowsOnTop ',
2783 DbgSName(AForm), ': ', DbgS(AFormStyle));
2784 {$ENDIF}
2785 end;
2786 end;
2787 end;
2788
ScaleBoundsRectnull2789 function TAnchorDockMaster.ScaleBoundsRect(ARect: TRect; FromDPI, ToDPI: integer): TRect;
2790 begin
2791 if not Application.Scaled or (FromDPI <= 0) or (ToDPI <= 0) then
2792 Result := ARect
2793 else begin
2794 Result.Left :=MulDiv(ARect.Left ,ToDPI,FromDPI);
2795 Result.Top :=MulDiv(ARect.Top ,ToDPI,FromDPI);
2796 Result.Width :=MulDiv(ARect.Width ,ToDPI,FromDPI);
2797 Result.Height:=MulDiv(ARect.Height,ToDPI,FromDPI);
2798 end;
2799 {$IFDEF VerboseAnchorDockRestore}
2800 debugln(['TAnchorDockMaster.ScaleBoundsRect FromDPI=',FromDPI,' ToDPI=',ToDPI,' FromRect[',dbgs(ARect),'] ToRect[',dbgs(Result),']']);
2801 {$ENDIF}
2802 end;
2803
2804 procedure TAnchorDockMaster.SetAllowDragging(AValue: boolean);
2805 begin
2806 if FAllowDragging=AValue then Exit;
2807 FAllowDragging:=AValue;
2808 OptionsChanged;
2809 end;
2810
2811 procedure TAnchorDockMaster.SetDockOutsideMargin(AValue: integer);
2812 begin
2813 if FDockOutsideMargin=AValue then Exit;
2814 FDockOutsideMargin:=AValue;
2815 OptionsChanged;
2816 end;
2817
2818 procedure TAnchorDockMaster.SetDockParentMargin(AValue: integer);
2819 begin
2820 if FDockParentMargin=AValue then Exit;
2821 FDockParentMargin:=AValue;
2822 OptionsChanged;
2823 end;
2824
2825 procedure TAnchorDockMaster.SetDragTreshold(AValue: integer);
2826 begin
2827 if FDragTreshold=AValue then Exit;
2828 FDragTreshold:=AValue;
2829 OptionsChanged;
2830 end;
2831
2832 procedure TAnchorDockMaster.SetHeaderHint(AValue: string);
2833 begin
2834 if FHeaderHint=AValue then Exit;
2835 FHeaderHint:=AValue;
2836 OptionsChanged;
2837 end;
2838
2839 procedure TAnchorDockMaster.SetHeaderStyle(AValue: THeaderStyleName);
2840 begin
2841 if FHeaderStyle=AValue then Exit;
2842 FHeaderStyle:=AValue;
2843 FHeaderStyleName2ADHeaderStyle.TryGetData(uppercase(AValue),CurrentADHeaderStyle);
2844 OptionsChanged;
2845 InvalidateHeaders;
2846 end;
2847
2848 procedure TAnchorDockMaster.SetPageAreaInPercent(AValue: integer);
2849 begin
2850 if FPageAreaInPercent=AValue then Exit;
2851 FPageAreaInPercent:=AValue;
2852 OptionsChanged;
2853 end;
2854
2855 procedure TAnchorDockMaster.SetScaleOnResize(AValue: boolean);
2856 begin
2857 if FScaleOnResize=AValue then Exit;
2858 FScaleOnResize:=AValue;
2859 OptionsChanged;
2860 end;
2861
2862 procedure TAnchorDockMaster.SetHeaderFlatten(AValue: boolean);
2863 begin
2864 if FHeaderFlatten=AValue then Exit;
2865 FHeaderFlatten:=AValue;
2866 OptionsChanged;
2867 InvalidateHeaders;
2868 end;
2869
2870 procedure TAnchorDockMaster.SetHeaderFilled(AValue: boolean);
2871 begin
2872 if FHeaderFilled=AValue then Exit;
2873 FHeaderFilled:=AValue;
2874 OptionsChanged;
2875 InvalidateHeaders;
2876 end;
2877
2878 procedure TAnchorDockMaster.SetHeaderHighlightFocused(AValue: boolean);
2879 begin
2880 if FHeaderHighlightFocused=AValue then Exit;
2881 FHeaderHighlightFocused:=AValue;
2882 OptionsChanged;
2883 InvalidateHeaders;
2884 end;
2885
2886 procedure TAnchorDockMaster.SetDockSitesCanBeMinimized(AValue: boolean);
2887 begin
2888 if FDockSitesCanBeMinimized=AValue then Exit;
2889 FDockSitesCanBeMinimized:=AValue;
2890 UpdateHeaders;
2891 InvalidateHeaders;
2892 EnableAllAutoSizing;
2893 OptionsChanged;
2894 end;
2895
2896 procedure TAnchorDockMaster.SetFloatingWindowsOnTop(AValue: boolean);
2897 begin
2898 if FFloatingWindowsOnTop = AValue then Exit;
2899 FFloatingWindowsOnTop := AValue;
2900 RefreshFloatingWindowsOnTop;
2901 OptionsChanged;
2902 end;
2903
2904 procedure TAnchorDockMaster.SetMultiLinePages(AValue: boolean);
2905 var
2906 Site: TAnchorDockHostSite;
2907 i: Integer;
2908 begin
2909 if FMultiLinePages=AValue then Exit;
2910 FMultiLinePages:=AValue;
2911 for i:=0 to ComponentCount-1 do
2912 begin
2913 Site:=TAnchorDockHostSite(Components[i]);
2914 if not (Site is TAnchorDockHostSite) then continue;
2915 if Assigned(Site.Pages) then
2916 begin
2917 DisableControlAutoSizing(Site);
2918 Site.Pages.MultiLine:=AValue;
2919 end;
2920 end;
2921 EnableAllAutoSizing;
2922 OptionsChanged;
2923 end;
2924
2925 procedure TAnchorDockMaster.SetShowMenuItemShowHeader(AValue: boolean);
2926 begin
2927 if FShowMenuItemShowHeader=AValue then Exit;
2928 FShowMenuItemShowHeader:=AValue;
2929 OptionsChanged;
2930 end;
2931
2932 procedure TAnchorDockMaster.ShowHeadersButtonClick(Sender: TObject);
2933 begin
2934 ShowHeader:=not ShowHeader;
2935 end;
2936
2937 procedure TAnchorDockMaster.OptionsClick(Sender: TObject);
2938 begin
2939 if Assigned(OnShowOptions) then OnShowOptions(Self);
2940 end;
2941
2942 procedure TAnchorDockMaster.SetIdleConnected(const AValue: Boolean);
2943 begin
2944 if FIdleConnected=AValue then exit;
2945 FIdleConnected:=AValue;
2946 if IdleConnected then
2947 Application.AddOnIdleHandler(@OnIdle,true)
2948 else
2949 Application.RemoveOnIdleHandler(@OnIdle);
2950 end;
2951
2952 procedure TAnchorDockMaster.SetQueueSimplify(const AValue: Boolean);
2953 begin
2954 if FQueueSimplify=AValue then exit;
2955 FQueueSimplify:=AValue;
2956 if FQueueSimplify then
2957 Application.QueueAsyncCall(@AsyncSimplify,0)
2958 else
2959 Application.RemoveAsyncCalls(Self);
2960 end;
2961
2962 procedure TAnchorDockMaster.SetRestoring(const AValue: boolean);
2963 var
2964 AComponent: TComponent;
2965 i: Integer;
2966 begin
2967 if FRestoring=AValue then exit;
2968 FRestoring:=AValue;
2969 if FRestoring then begin
2970 IdleConnected:=true;
2971 end else begin
2972 for i:=0 to ComponentCount-1 do begin
2973 AComponent:=Components[i];
2974 if AComponent is TAnchorDockHostSite then
2975 TAnchorDockHostSite(AComponent).DockRestoreBounds:=Rect(0,0,0,0)
2976 else if AComponent is TAnchorDockSplitter then
2977 TAnchorDockSplitter(AComponent).DockRestoreBounds:=Rect(0,0,0,0)
2978 end;
2979 end;
2980 end;
2981
2982 procedure TAnchorDockMaster.OptionsChanged;
2983 begin
2984 IncreaseOptionsChangeStamp;
2985 if Assigned(OnOptionsChanged) then
2986 OnOptionsChanged(Self);
2987 end;
2988
2989 procedure TAnchorDockMaster.SetShowHeader(AValue: boolean);
2990 var
2991 i: Integer;
2992 Site: TAnchorDockHostSite;
2993 begin
2994 if FShowHeader=AValue then exit;
2995 FShowHeader:=AValue;
2996 for i:=0 to ComponentCount-1 do begin
2997 Site:=TAnchorDockHostSite(Components[i]);
2998 if not (Site is TAnchorDockHostSite) then continue;
2999 if (Site.Header<>nil) then begin
3000 DisableControlAutoSizing(Site);
3001 Site.UpdateHeaderShowing;
3002 if Site.Minimized then
3003 if not AValue then
3004 site.MinimizeSite;
3005 end;
3006 end;
3007 EnableAllAutoSizing;
3008 OptionsChanged;
3009 end;
3010
3011 procedure TAnchorDockMaster.SetShowHeaderCaption(const AValue: boolean);
3012 var
3013 i: Integer;
3014 Site: TAnchorDockHostSite;
3015 begin
3016 if FShowHeaderCaption=AValue then exit;
3017 FShowHeaderCaption:=AValue;
3018 for i:=0 to ComponentCount-1 do begin
3019 Site:=TAnchorDockHostSite(Components[i]);
3020 if not (Site is TAnchorDockHostSite) then continue;
3021 Site.UpdateDockCaption;
3022 end;
3023 OptionsChanged;
3024 end;
3025
3026 procedure TAnchorDockMaster.Notification(AComponent: TComponent;
3027 Operation: TOperation);
3028 var
3029 AControl: TControl;
3030 begin
3031 inherited Notification(AComponent, Operation);
3032 if Operation=opRemove then begin
3033 if AComponent is TControl then begin
3034 AControl:=TControl(AComponent);
3035 FControls.Remove(AControl);
3036 fNeedSimplify.Remove(AControl);
3037 fNeedFree.Remove(AControl);
3038 fDisabledAutosizing.Remove(AControl);
3039 if fTreeNameToDocker<>nil then
3040 fTreeNameToDocker.RemoveControl(AControl);
3041 end;
3042 end;
3043 end;
3044
3045 procedure TAnchorDockMaster.InvalidateHeaders;
3046 var
3047 i: Integer;
3048 Site: TAnchorDockHostSite;
3049 begin
3050 for i:=0 to ComponentCount-1 do begin
3051 Site:=TAnchorDockHostSite(Components[i]);
3052 if not (Site is TAnchorDockHostSite) then continue;
3053 if (Site.Header<>nil) and (Site.Header.Parent<>nil) then
3054 Site.Header.Invalidate;
3055 end;
3056 end;
3057
3058 procedure TAnchorDockMaster.AutoSizeAllHeaders(EnableAutoSizing: boolean);
3059 var
3060 i: Integer;
3061 Site: TAnchorDockHostSite;
3062 begin
3063 for i:=0 to ComponentCount-1 do begin
3064 Site:=TAnchorDockHostSite(Components[i]);
3065 if not (Site is TAnchorDockHostSite) then continue;
3066 if (Site.Header<>nil) and (Site.Header.Parent<>nil) then begin
3067 Site.Header.InvalidatePreferredSize;
3068 DisableControlAutoSizing(Site);
3069 end;
3070 end;
3071 if EnableAutoSizing then
3072 EnableAllAutoSizing;
3073 end;
3074
3075 procedure TAnchorDockMaster.RegisterHeaderStyle(StyleName: THeaderStyleName; DrawProc:TDrawADHeaderProc; NeedDrawHeaderAfterText,NeedHighlightText: boolean);
3076 var
3077 TempStyle:TADHeaderStyle;
3078 begin
3079 TempStyle.DrawProc:=DrawProc;
3080 TempStyle.StyleDesc.NeedDrawHeaderAfterText:=NeedDrawHeaderAfterText;
3081 TempStyle.StyleDesc.NeedHighlightText:=NeedHighlightText;
3082 TempStyle.StyleDesc.Name:=StyleName;
3083 FHeaderStyleName2ADHeaderStyle.AddOrSetData(uppercase(StyleName), TempStyle);
3084 if FHeaderStyleName2ADHeaderStyle.Count=1 then
3085 begin
3086 CurrentADHeaderStyle:=TempStyle;
3087 HeaderStyle:=StyleName;
3088 end;
3089 end;
3090
3091 procedure TAnchorDockMaster.ShowOverlappingForm;
3092 begin
3093 FOverlappingForm.Show;
3094 IdleConnected:=true;
3095 end;
3096
3097 procedure TAnchorDockMaster.HideOverlappingForm(Sender: TObject);
3098 begin
3099 StopHideOverlappingTimer;
3100 FOverlappingForm.Hide;
3101 FOverlappingForm.AnchorDockHostSite.HideMinimizedControl;
3102 IdleConnected:=false;
3103 end;
3104
3105 constructor TAnchorDockMaster.Create(AOwner: TComponent);
3106 begin
3107 inherited Create(AOwner);
3108 FFormStyles:=TFormStyles.Create;
3109 FMainDockForm:=nil;
3110 FControls:=TFPList.Create;
3111 FAllowDragging:=true;
3112 FDragTreshold:=4;
3113 FDockOutsideMargin:=10;
3114 FDockParentMargin:=10;
3115 FFloatingWindowsOnTop:=false;
3116 FPageAreaInPercent:=40;
3117 FHeaderAlignTop:=80;
3118 HeaderAlignLeft:=120;
3119 FHeaderHint:='';
3120 FMultiLinePages:=false;
3121 FShowHeader:=true;
3122 FShowHeaderCaption:=true;
3123 FHideHeaderCaptionFloatingControl:=true;
3124 FSplitterWidth:=4;
3125 FScaleOnResize:=true;
3126 FMapMinimizedControls:=TMapMinimizedControls.Create;
3127 fNeedSimplify:=TFPList.Create;
3128 fNeedFree:=TFPList.Create;
3129 fDisabledAutosizing:=TFPList.Create;
3130 FSplitterClass:=TAnchorDockSplitter;
3131 FSiteClass:=TAnchorDockHostSite;
3132 FManagerClass:=TAnchorDockManager;
3133 FHeaderClass:=TAnchorDockHeader;
3134 FHeaderFlatten:=true;
3135 FHeaderFilled:=true;
3136 FPageControlClass:=TAnchorDockPageControl;
3137 FPageClass:=TAnchorDockPage;
3138 FRestoreLayouts:=TAnchorDockRestoreLayouts.Create;
3139 FHeaderHighlightFocused:=false;
3140 FDockSitesCanBeMinimized:=false;
3141 FOverlappingForm:=nil;
3142 FAllClosing:=False;
3143 FHeaderStyleName2ADHeaderStyle:=THeaderStyleName2ADHeaderStylesMap.create;
3144 Screen.AddHandlerFormAdded(@ScreenFormAdded);
3145 Screen.AddHandlerRemoveForm(@ScreenRemoveForm);
3146 end;
3147
3148 destructor TAnchorDockMaster.Destroy;
3149 var
3150 AControl: TControl;
3151 i, j: Integer;
3152 begin
3153 Screen.RemoveHandlerFormAdded(@ScreenFormAdded);
3154 Screen.RemoveHandlerRemoveForm(@ScreenRemoveForm);
3155 QueueSimplify:=false;
3156 FreeAndNil(FRestoreLayouts);
3157 FreeAndNil(fPopupMenu);
3158 FreeAndNil(fTreeNameToDocker);
3159 if FControls.Count>0 then begin
3160 while ControlCount>0 do begin
3161 AControl:=Controls[ControlCount-1];
3162 debugln(['TAnchorDockMaster.Destroy: still in list: ',DbgSName(AControl),' Caption="',AControl.Caption,'"']);
3163 AControl.Free;
3164 end;
3165 end;
3166 FreeAndNil(fNeedSimplify);
3167 FreeAndNil(FControls);
3168 FreeAndNil(fNeedFree);
3169 FreeAndNil(FMapMinimizedControls);
3170 FreeAndNil(fDisabledAutosizing);
3171 {$IFDEF VerboseAnchorDocking}
3172 for i:=0 to ComponentCount-1 do begin
3173 debugln(['TAnchorDockMaster.Destroy ',i,'/',ComponentCount,' ',DbgSName(Components[i])]);
3174 end;
3175 {$ENDIF}
3176 for i:=0 to ComponentCount-1 do begin
3177 for j:=0 to ComponentCount-1 do begin
3178 if i<>j then
3179 TControl(Components[i]).RemoveAllHandlersOfObject(TControl(Components[j]));
3180 end;
3181 end;
3182 FreeAndNil(FHeaderStyleName2ADHeaderStyle);
3183 FreeAndNil(FFormStyles);
3184 inherited Destroy;
3185 end;
3186
ControlCountnull3187 function TAnchorDockMaster.ControlCount: integer;
3188 begin
3189 Result:=FControls.Count;
3190 end;
3191
IndexOfControlnull3192 function TAnchorDockMaster.IndexOfControl(const aName: string): integer;
3193 begin
3194 Result:=ControlCount-1;
3195 while (Result>=0) and (Controls[Result].Name<>aName) do dec(Result);
3196 end;
3197
FindControlnull3198 function TAnchorDockMaster.FindControl(const aName: string): TControl;
3199 var
3200 i: LongInt;
3201 begin
3202 i:=IndexOfControl(aName);
3203 if i>=0 then
3204 Result:=Controls[i]
3205 else
3206 Result:=nil;
3207 end;
3208
IsMinimizedControlnull3209 function TAnchorDockMaster.IsMinimizedControl(AControl: TControl; out
3210 Site: TAnchorDockHostSite): Boolean;
3211 var
3212 AIndex: Integer;
3213 begin
3214 AIndex:=FMapMinimizedControls.IndexOf(AControl);
3215 if AIndex<0 then begin
3216 Result:=False;
3217 Site:=nil;
3218 end else begin
3219 Result:=True;
3220 Site:=TAnchorDockHostSite(FMapMinimizedControls[AControl]);
3221 end;
3222 end;
3223
IsSitenull3224 function TAnchorDockMaster.IsSite(AControl: TControl): boolean;
3225 begin
3226 Result:=(AControl is TAnchorDockHostSite) or IsCustomSite(AControl);
3227 end;
3228
IsAnchorSitenull3229 function TAnchorDockMaster.IsAnchorSite(AControl: TControl): boolean;
3230 begin
3231 Result:=AControl is TAnchorDockHostSite;
3232 end;
3233
IsCustomSitenull3234 function TAnchorDockMaster.IsCustomSite(AControl: TControl): boolean;
3235 begin
3236 Result:=(AControl is TCustomForm) // also checks for nil
3237 and (AControl.Parent=nil)
3238 and (TCustomForm(AControl).DockManager is TAnchorDockManager);
3239 end;
3240
GetSitenull3241 function TAnchorDockMaster.GetSite(AControl: TControl): TCustomForm;
3242 begin
3243 Result:=nil;
3244 if AControl=nil then
3245 exit
3246 else if IsCustomSite(AControl) then
3247 Result:=TCustomForm(AControl)
3248 else if AControl is TAnchorDockHostSite then
3249 Result:=TAnchorDockHostSite(AControl)
3250 else if (AControl.HostDockSite is TAnchorDockHostSite) then
3251 Result:=TAnchorDockHostSite(AControl.HostDockSite);
3252 end;
3253
GetAnchorSitenull3254 function TAnchorDockMaster.GetAnchorSite(AControl: TControl): TAnchorDockHostSite;
3255 begin
3256 Result:=nil;
3257 if AControl=nil then
3258 Result:=nil
3259 else if AControl is TAnchorDockHostSite then
3260 Result:=TAnchorDockHostSite(AControl)
3261 else if (AControl.HostDockSite is TAnchorDockHostSite) then
3262 Result:=TAnchorDockHostSite(AControl.HostDockSite);
3263 end;
3264
GetControlnull3265 function TAnchorDockMaster.GetControl(Site: TControl): TControl;
3266 var
3267 AnchorSite: TAnchorDockHostSite;
3268 begin
3269 Result:=nil;
3270 if IsCustomSite(Site) then
3271 Result:=Site
3272 else if Site is TAnchorDockHostSite then begin
3273 AnchorSite:=TAnchorDockHostSite(Site);
3274 if AnchorSite.SiteType=adhstOneControl then
3275 Result:=AnchorSite.GetOneControl;
3276 end else if (Site<>nil) and (Site.HostDockSite is TAnchorDockHostSite)
3277 and (TAnchorDockHostSite(Site.HostDockSite).SiteType=adhstOneControl) then
3278 Result:=Site;
3279 end;
3280
IsFloatingnull3281 function TAnchorDockMaster.IsFloating(AControl: TControl): Boolean;
3282 begin
3283 if AControl is TAnchorDockHostSite then begin
3284 Result:=(TAnchorDockHostSite(AControl).SiteType=adhstOneControl)
3285 and (AControl.Parent=nil);
3286 end else if (AControl.HostDockSite is TAnchorDockHostSite) then begin
3287 Result:=(TAnchorDockHostSite(AControl.HostDockSite).SiteType=adhstOneControl)
3288 and (AControl.HostDockSite.Parent=nil);
3289 end else
3290 Result:=AControl.Parent=nil;
3291 end;
3292
GetPopupMenunull3293 function TAnchorDockMaster.GetPopupMenu: TPopupMenu;
3294 begin
3295 if fPopupMenu=nil then begin
3296 fPopupMenu:=TPopupMenu.Create(Self);
3297 fPopupMenu.OnPopup:=@PopupMenuPopup;
3298 end;
3299 Result:=fPopupMenu;
3300 end;
3301
AddPopupMenuItemnull3302 function TAnchorDockMaster.AddPopupMenuItem(AName, ACaption: string;
3303 const OnClickEvent: TNotifyEvent; AParent: TMenuItem): TMenuItem;
3304 begin
3305 Result:=TMenuItem(fPopupMenu.FindComponent(AName));
3306 if Result=nil then begin
3307 Result:=TMenuItem.Create(fPopupMenu);
3308 Result.Name:=AName;
3309 if AParent=nil then
3310 fPopupMenu.Items.Add(Result)
3311 else
3312 AParent.Add(Result);
3313 end;
3314 Result.Caption:=ACaption;
3315 Result.OnClick:=OnClickEvent;
3316 end;
3317
AddRemovePopupMenuItemnull3318 function TAnchorDockMaster.AddRemovePopupMenuItem(Add: boolean; AName,
3319 ACaption: string; const OnClickEvent: TNotifyEvent; AParent: TMenuItem
3320 ): TMenuItem;
3321 begin
3322 if Add then
3323 Result:=AddPopupMenuItem(AName,ACaption,OnClickEvent,AParent)
3324 else begin
3325 Result:=TMenuItem(fPopupMenu.FindComponent(AName));
3326 if Result<>nil then
3327 FreeAndNil(Result);
3328 end;
3329 end;
3330
3331 procedure TAnchorDockMaster.MakeDockable(AControl: TControl; Show: boolean;
3332 BringToFront: boolean; AddDockHeader: boolean);
3333 var
3334 Site: TAnchorDockHostSite;
3335 begin
3336 if AControl.Name='' then
3337 raise Exception.Create('TAnchorDockMaster.MakeDockable '+
3338 adrsMissingControlName);
3339 if (AControl is TCustomForm) and (fsModal in TCustomForm(AControl).FormState)
3340 then
3341 raise Exception.Create('TAnchorDockMaster.MakeDockable '+
3342 adrsModalFormsCanNotBeMadeDockable);
3343 if IsCustomSite(AControl) then
3344 raise Exception.Create('TAnchorDockMaster.MakeDockable '+
3345 adrsControlIsAlreadyADocksite);
3346 Site:=nil;
3347 AControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.DisableControlAutoSizing'){$ENDIF};
3348 try
3349 if AControl is TAnchorDockHostSite then begin
3350 // already a site
3351 Site:=TAnchorDockHostSite(AControl);
3352 end else if AControl.Parent=nil then
3353 if IsMinimizedControl(AControl, Site) then begin
3354 Site.AsyncMinimizeSite(0);
3355 end else begin
3356
3357 if FControls.IndexOf(AControl)<0 then begin
3358 FControls.Add(AControl);
3359 AControl.FreeNotification(Self);
3360 end;
3361
3362 // create docksite
3363 Site:=CreateSite;
3364 try
3365 try
3366 Site.BoundsRect:=AControl.BoundsRect;
3367 ClearLayoutProperties(AControl);
3368 // dock
3369 AControl.ManualDock(Site);
3370 AControl.Visible:=true;
3371 if not AddDockHeader then
3372 Site.Header.Parent:=nil;
3373 except
3374 FreeAndNil(Site);
3375 raise;
3376 end;
3377 finally
3378 if Site<>nil then
3379 Site.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF};
3380 end;
3381 end else if AControl.Parent is TAnchorDockHostSite then begin
3382 // AControl is already docked => show site
3383 Site:=TAnchorDockHostSite(AControl.Parent);
3384 AControl.Visible:=true;
3385 end else begin
3386 raise Exception.Create('TAnchorDockMaster.MakeDockable '+Format(
3387 adrsNotSupportedHasParent, [DbgSName(AControl), DbgSName(AControl)]));
3388 end;
3389 site.UpdateHeaderShowing;
3390 if (Site<>nil) and Show then
3391 MakeVisible(Site,BringToFront);
3392 finally
3393 AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.DisableControlAutoSizing'){$ENDIF};
3394 end;
3395 // BringToFront
3396 if Show and BringToFront and (Site<>nil) then begin
3397 GetParentForm(Site).BringToFront;
3398 Site.SetFocus;
3399 end;
3400 end;
3401
3402 procedure TAnchorDockMaster.MakeDockSite(AForm: TCustomForm; Sites: TAnchors;
3403 ResizePolicy: TADMResizePolicy; AllowInside: boolean);
3404 var
3405 AManager: TAnchorDockManager;
3406 begin
3407 if AForm.Name='' then
3408 raise Exception.Create('TAnchorDockMaster.MakeDockSite '+
3409 adrsMissingControlName);
3410 if AForm.DockManager<>nil then
3411 raise Exception.Create('TAnchorDockMaster.MakeDockSite DockManager<>nil');
3412 if AForm.Parent<>nil then
3413 raise Exception.Create('TAnchorDockMaster.MakeDockSite Parent='+DbgSName(AForm.Parent));
3414 if fsModal in AForm.FormState then
3415 raise Exception.Create('TAnchorDockMaster.MakeDockSite '+
3416 adrsModalFormsCanNotBeMadeDockable);
3417 if Sites=[] then
3418 raise Exception.Create('TAnchorDockMaster.MakeDockSite Sites=[]');
3419 AForm.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockSite'){$ENDIF};
3420 try
3421 if FControls.IndexOf(AForm)<0 then begin
3422 FControls.Add(AForm);
3423 AForm.FreeNotification(Self);
3424 end;
3425 AManager:=ManagerClass.Create(AForm);
3426 AManager.DockableSites:=Sites;
3427 AManager.InsideDockingAllowed:=AllowInside;
3428 AManager.ResizePolicy:=ResizePolicy;
3429 AForm.DockManager:=AManager;
3430 AForm.UseDockManager:=true;
3431 AForm.DockSite:=true;
3432 finally
3433 AForm.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockSite'){$ENDIF};
3434 end;
3435 end;
3436
3437 procedure TAnchorDockMaster.MakeDockPanel(APanel:TAnchorDockPanel;
3438 ResizePolicy: TADMResizePolicy);
3439 var
3440 AManager: TAnchorDockManager;
3441 begin
3442 if APanel.Name='' then
3443 raise Exception.Create('TAnchorDockMaster.MakeDockPanel '+
3444 adrsMissingControlName);
3445 if APanel.DockManager<>nil then
3446 raise Exception.Create('TAnchorDockMaster.MakeDockPanel DockManager<>nil');
3447 APanel.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockPanel'){$ENDIF};
3448 try
3449 if FControls.IndexOf(APanel)<0 then begin
3450 FControls.Add(APanel);
3451 APanel.FreeNotification(Self);
3452 end;
3453 AManager:=ManagerClass.Create(APanel);
3454 AManager.DockableSites:=[];
3455 AManager.InsideDockingAllowed:=true;
3456 AManager.ResizePolicy:=ResizePolicy;
3457 APanel.DockManager:=AManager;
3458 APanel.UseDockManager:=true;
3459 APanel.DockSite:=true;
3460 finally
3461 APanel.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockPanel'){$ENDIF};
3462 end;
3463 end;
3464
3465 procedure TAnchorDockMaster.MakeVisible(AControl: TControl; SwitchPages: boolean);
3466 begin
3467 while AControl<>nil do begin
3468 if FMapMinimizedControls.IndexOf(AControl)>=0 then begin
3469 AControl:=TAnchorDockHostSite(FMapMinimizedControls[AControl]);
3470 TAnchorDockHostSite(AControl).MinimizeSite;
3471 end;
3472 AControl.Visible:=true;
3473 if SwitchPages and (AControl is TAnchorDockPage) then
3474 TAnchorDockPageControl(AControl.Parent).PageIndex:=
3475 TAnchorDockPage(AControl).PageIndex;
3476 AControl:=AControl.Parent;
3477 end;
3478 end;
3479
ShowControlnull3480 function TAnchorDockMaster.ShowControl(ControlName: string;
3481 BringToFront: boolean): TControl;
3482 begin
3483 Result:=DoCreateControl(ControlName,false);
3484 if Result=nil then exit;
3485 MakeDockable(Result,true,BringToFront);
3486 end;
3487
3488 procedure TAnchorDockMaster.CloseAll;
3489 var
3490 i: Integer;
3491 AForm: TCustomForm;
3492 AControl: TWinControl;
3493 begin
3494 FAllClosing:=True;
3495 // hide all forms
3496 i:=Screen.CustomFormCount-1;
3497 while i>=0 do begin
3498 AForm:=GetParentForm(Screen.CustomForms[i]);
3499 if Assigned(AForm)then
3500 AForm.Hide;
3501 i:=Min(i,Screen.CustomFormCount)-1;
3502 end;
3503
3504 // close all forms except the MainForm
3505 i:=Screen.CustomFormCount-1;
3506 while i>=0 do begin
3507 AForm:=Screen.CustomForms[i];
3508 if (AForm<>Application.MainForm) and not AForm.IsParentOf(Application.MainForm)
3509 then begin
3510 AControl:=AForm;
3511 while (AControl.Parent<>nil)
3512 and (AControl.Parent<>Application.MainForm) do begin
3513 AControl:=AControl.Parent;
3514 if AControl is TCustomForm then AForm:=TCustomForm(AControl);
3515 end;
3516 AForm.Close;
3517 end;
3518 i:=Min(i,Screen.CustomFormCount)-1;
3519 end;
3520 FAllClosing:=False;
3521 end;
3522
3523 procedure TAnchorDockMaster.SaveLayoutToConfig(Config: TConfigStorage);
3524 var
3525 Tree: TAnchorDockLayoutTree;
3526 begin
3527 Tree:=TAnchorDockLayoutTree.Create;
3528 try
3529 Config.AppendBasePath('MainConfig/');
3530 SaveMainLayoutToTree(Tree);
3531 Tree.SaveToConfig(Config);
3532 Config.UndoAppendBasePath;
3533 Config.AppendBasePath('Restores/');
3534 RestoreLayouts.SaveToConfig(Config);
3535 Config.UndoAppendBasePath;
3536 {$IFDEF VerboseAnchorDocking}
3537 WriteDebugLayout('TAnchorDockMaster.SaveLayoutToConfig ',Tree.Root);
3538 {$ENDIF}
3539 //DebugWriteChildAnchors(Tree.Root);
3540 finally
3541 Tree.Free;
3542 end;
3543 end;
3544
3545 function GetParentFormOrDockPanel(Control: TControl; TopForm:Boolean=true): TCustomForm;
3546 var
3547 oldControl: TControl;
3548 begin
3549 oldControl:=Control;
3550 while (Control <> nil) and (Control.Parent <> nil) do
3551 begin
3552 if (Control is TAnchorDockPanel) then
3553 Break;
3554 Control := Control.Parent;
3555 end;
3556 if Control is TCustomForm then
3557 Result := TCustomForm(Control)
3558 else if Control is TAnchorDockPanel then
3559 Result := TCustomForm(Control)
3560 else
3561 Result := nil;
3562 if not TopForm then begin
3563 if Control is TAnchorDockPanel then
3564 exit;
3565 Control:=oldControl;
3566 while (Control <> nil) and (Control.Parent <> nil) do
3567 begin
3568 Control := Control.Parent;
3569 if (Control is TCustomForm) then
3570 Break;
3571 end;
3572 Result := TCustomForm(Control);
3573 end;
3574 end;
3575
3576 procedure TAnchorDockMaster.SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree);
3577 var
3578 i: Integer;
3579 AControl: TControl;
3580 Site: TAnchorDockHostSite;
3581 SavedSites: TFPList;
3582 LayoutNode: TAnchorDockLayoutTreeNode;
3583 AFormOrDockPanel: TWinControl;
3584 VisibleControls: TStringListUTF8Fast;
3585
3586 procedure SaveFormOrDockPanel(theFormOrDockPanel: TWinControl; SaveChildren: boolean; AMinimized:boolean);
3587 begin
3588 // custom dock site
3589 LayoutNode:=LayoutTree.NewNode(LayoutTree.Root);
3590 LayoutNode.NodeType:=adltnCustomSite;
3591 LayoutNode.Assign(theFormOrDockPanel,theFormOrDockPanel is TAnchorDockPanel,AMinimized);
3592 // can have one normal dock site
3593 if SaveChildren then
3594 begin
3595 Site:=TAnchorDockManager(theFormOrDockPanel.DockManager).GetChildSite;
3596 if Site<>nil then begin
3597 LayoutNode:=LayoutTree.NewNode(LayoutNode);
3598 Site.SaveLayout(LayoutTree,LayoutNode);
3599 {if Site.BoundSplitter<>nil then begin
3600 LayoutNode:=LayoutTree.NewNode(LayoutNode);
3601 Site.BoundSplitter.SaveLayout(LayoutNode);
3602 end;}
3603 end;
3604 end;
3605 end;
3606
3607 begin
3608 SavedSites:=TFPList.Create;
3609 VisibleControls:=TStringListUTF8Fast.Create;
3610 try
3611 for i:=0 to ControlCount-1 do begin
3612 AControl:=Controls[i];
3613 if not DockedControlIsVisible(AControl) then continue;
3614 VisibleControls.Add(AControl.Name);
3615 AFormOrDockPanel:=GetParentFormOrDockPanel(AControl);
3616 if AFormOrDockPanel=nil then continue;
3617 if SavedSites.IndexOf(AFormOrDockPanel)>=0 then continue;
3618 SavedSites.Add(AFormOrDockPanel);
3619 {$IFDEF VerboseAnchorDockRestore}
3620 debugln(['TAnchorDockMaster.SaveMainLayoutToTree AForm=',DbgSName(AFormOrDockPanel)]);
3621 DebugWriteChildAnchors(AFormOrDockPanel,true,true);
3622 {$ENDIF}
3623 if AFormOrDockPanel is TAnchorDockPanel then begin
3624 SaveFormOrDockPanel(GetParentFormOrDockPanel(AFormOrDockPanel),true,false);
3625 //LayoutNode:=LayoutTree.NewNode(LayoutTree.Root);
3626 //TAnchorDockPanel(AFormOrDockPanel).SaveLayout(LayoutTree,LayoutNode);
3627 end else if AFormOrDockPanel is TAnchorDockHostSite then begin
3628 Site:=TAnchorDockHostSite(AFormOrDockPanel);
3629 LayoutNode:=LayoutTree.NewNode(LayoutTree.Root);
3630 Site.SaveLayout(LayoutTree,LayoutNode);
3631 end else if IsCustomSite(AFormOrDockPanel) then begin
3632 SaveFormOrDockPanel(AFormOrDockPanel,true,false);
3633 end else
3634 raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl));
3635 end;
3636 // remove invisible controls
3637 LayoutTree.Root.Simplify(VisibleControls,false);
3638 finally
3639 VisibleControls.Free;
3640 SavedSites.Free;
3641 end;
3642 end;
3643
3644 procedure TAnchorDockMaster.SaveSiteLayoutToTree(AControl: TWinControl;
3645 LayoutTree: TAnchorDockLayoutTree);
3646 var
3647 LayoutNode: TAnchorDockLayoutTreeNode;
3648 Site: TAnchorDockHostSite;
3649 begin
3650 if AControl is TAnchorDockHostSite then begin
3651 Site:=TAnchorDockHostSite(AControl);
3652 Site.SaveLayout(LayoutTree,LayoutTree.Root);
3653 end else if AControl is TAnchorDockPanel then begin
3654 (AControl as TAnchorDockPanel).SaveLayout(LayoutTree,LayoutTree.Root);
3655 end else if IsCustomSite(AControl) then begin
3656 LayoutTree.Root.NodeType:=adltnCustomSite;
3657 LayoutTree.Root.Assign(AControl,false,false);
3658 // can have one normal dock site
3659 Site:=TAnchorDockManager(AControl.DockManager).GetChildSite;
3660 if Site<>nil then begin
3661 LayoutNode:=LayoutTree.NewNode(LayoutTree.Root);
3662 Site.SaveLayout(LayoutTree,LayoutNode);
3663 end;
3664 end else
3665 raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl));
3666 end;
3667
CreateRestoreLayoutnull3668 function TAnchorDockMaster.CreateRestoreLayout(AControl: TControl
3669 ): TAnchorDockRestoreLayout;
3670 { Create a restore layout for AControl and its child controls.
3671 It contains the whole parent structure so that the restore knows where to
3672 put AControl.
3673 }
3674
3675 procedure AddControlNames(SubControl: TControl;
3676 RestoreLayout: TAnchorDockRestoreLayout);
3677 var
3678 i: Integer;
3679 begin
3680 if (FControls.IndexOf(SubControl)>=0)
3681 and not RestoreLayout.HasControlName(SubControl.Name) then
3682 RestoreLayout.ControlNames.Add(SubControl.Name);
3683 if SubControl is TWinControl then
3684 for i:=0 to TWinControl(SubControl).ControlCount-1 do
3685 AddControlNames(TWinControl(SubControl).Controls[i],RestoreLayout);
3686 end;
3687
3688 var
3689 AForm: TCustomForm;
3690 begin
3691 if not IsSite(AControl) then
3692 raise Exception.Create('TAnchorDockMaster.CreateRestoreLayout: not a site '+DbgSName(AControl));
3693 AForm:=GetParentFormOrDockPanel(AControl);
3694 Result:=TAnchorDockRestoreLayout.Create(TAnchorDockLayoutTree.Create);
3695 if AForm=nil then exit;
3696 SaveSiteLayoutToTree(AForm,Result.Layout);
3697 AddControlNames(AControl,Result);
3698 end;
3699
ConfigIsEmptynull3700 function TAnchorDockMaster.ConfigIsEmpty(Config: TConfigStorage): boolean;
3701 begin
3702 Result:=Config.GetValue('MainConfig/Nodes/ChildCount',0)=0;
3703 end;
3704
LoadLayoutFromConfignull3705 function TAnchorDockMaster.LoadLayoutFromConfig(Config: TConfigStorage;
3706 Scale: Boolean): boolean;
3707 var
3708 Tree: TAnchorDockLayoutTree;
3709 ControlNames: TStringListUTF8Fast;
3710 begin
3711 Result:=false;
3712 ControlNames:=TStringListUTF8Fast.Create;
3713 fTreeNameToDocker:=TADNameToControl.Create;
3714 Tree:=TAnchorDockLayoutTree.Create;
3715 try
3716 // load layout
3717 Config.AppendBasePath('MainConfig/');
3718 try
3719 Tree.LoadFromConfig(Config);
3720 finally
3721 Config.UndoAppendBasePath;
3722 end;
3723 // load restore layouts for hidden forms
3724 Config.AppendBasePath('Restores/');
3725 try
3726 RestoreLayouts.LoadFromConfig(Config);
3727 finally
3728 Config.UndoAppendBasePath;
3729 end;
3730
3731 {$IFDEF VerboseAnchorDockRestore}
3732 WriteDebugLayout('TAnchorDockMaster.LoadLayoutFromConfig ',Tree.Root);
3733 DebugWriteChildAnchors(Tree.Root);
3734 {$ENDIF}
3735
3736 // close all unneeded and wrongly allocated forms/controls (not helper controls like splitters)
3737 MarkCorrectlyLocatedControl(Tree);
3738 if not CloseUnneededAndWronglyLocatedControls(Tree) then exit;
3739
3740 BeginUpdate;
3741 try
3742 // create all needed forms/controls (not helper controls like splitters)
3743 if not CreateNeededControls(Tree,true,ControlNames) then exit;
3744
3745 // simplify layouts
3746 ControlNames.Sort;
3747 {$IFDEF VerboseAnchorDockRestore}
3748 debugln(['TAnchorDockMaster.LoadLayoutFromConfig controls: ']);
3749 debugln(ControlNames.Text);
3750 {$ENDIF}
3751 // if some forms/controls could not be created the layout needs to be adapted
3752 Tree.Root.Simplify(ControlNames,false);
3753
3754 // reuse existing sites to reduce flickering
3755 MapTreeToControls(Tree);
3756 {$IFDEF VerboseAnchorDockRestore}
3757 fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.LoadLayoutFromConfig Map');
3758 {$ENDIF}
3759
3760 // create sites, move controls
3761 RestoreLayout(Tree,Scale);
3762 SetMinimizedState(Tree);
3763 finally
3764 EndUpdate;
3765 end;
3766 finally
3767 // clean up
3768 FreeAndNil(fTreeNameToDocker);
3769 ControlNames.Free;
3770 Tree.Free;
3771 // commit (this can raise an exception)
3772 EnableAllAutoSizing;
3773 end;
3774 {$IFDEF VerboseAnchorDockRestore}
3775 if Assigned(Application.MainForm) then
3776 DebugWriteChildAnchors(Application.MainForm,true,false)
3777 else
3778 if (ControlCount>0) and (Controls[0] is TWinControl) then
3779 DebugWriteChildAnchors(TWinControl(Controls[0]),true,false);
3780 {$ENDIF}
3781 Result:=true;
3782 end;
3783
3784 procedure TAnchorDockMaster.LoadSettingsFromConfig(Config: TConfigStorage);
3785 var
3786 Settings: TAnchorDockSettings;
3787 begin
3788 Settings:=TAnchorDockSettings.Create;
3789 try
3790 Settings.LoadFromConfig(Config);
3791 LoadSettings(Settings);
3792 finally
3793 Settings.Free;
3794 end;
3795 end;
3796
3797 procedure TAnchorDockMaster.SaveSettingsToConfig(Config: TConfigStorage);
3798 var
3799 Settings: TAnchorDockSettings;
3800 begin
3801 Settings:=TAnchorDockSettings.Create;
3802 try
3803 SaveSettings(Settings);
3804 Settings.SaveToConfig(Config);
3805 finally
3806 Settings.Free;
3807 end;
3808 end;
3809
3810 procedure TAnchorDockMaster.LoadSettings(Settings: TAnchorDockSettings);
3811 begin
3812 AllowDragging := Settings.AllowDragging;
3813 DockOutsideMargin := Settings.DockOutsideMargin;
3814 DockParentMargin := Settings.DockParentMargin;
3815 DockSitesCanBeMinimized := Settings.DockSitesCanBeMinimized;
3816 DragTreshold := Settings.DragTreshold;
3817 FloatingWindowsOnTop := Settings.FloatingWindowsOnTop;
3818 PageAreaInPercent := Settings.PageAreaInPercent;
3819 HeaderAlignLeft := Settings.HeaderAlignLeft;
3820 HeaderAlignTop := Settings.HeaderAlignTop;
3821 HeaderFilled := Settings.HeaderFilled;
3822 HeaderFlatten := Settings.HeaderFlatten;
3823 HeaderHighlightFocused := Settings.HeaderHighlightFocused;
3824 HeaderStyle := Settings.HeaderStyle;
3825 HideHeaderCaptionFloatingControl := Settings.HideHeaderCaptionFloatingControl;
3826 MultiLinePages := Settings.MultiLinePages;
3827 ScaleOnResize := Settings.ScaleOnResize;
3828 ShowHeader := Settings.ShowHeader;
3829 ShowHeaderCaption := Settings.ShowHeaderCaption;
3830 SplitterWidth := Settings.SplitterWidth;
3831 end;
3832
3833 procedure TAnchorDockMaster.SaveSettings(Settings: TAnchorDockSettings);
3834 begin
3835 Settings.AllowDragging := AllowDragging;
3836 Settings.DockOutsideMargin := DockOutsideMargin;
3837 Settings.DockParentMargin := DockParentMargin;
3838 Settings.DockSitesCanBeMinimized := DockSitesCanBeMinimized;
3839 Settings.DragTreshold := DragTreshold;
3840 Settings.FloatingWindowsOnTop := FloatingWindowsOnTop;
3841 Settings.PageAreaInPercent := PageAreaInPercent;
3842 Settings.HeaderAlignLeft := HeaderAlignLeft;
3843 Settings.HeaderAlignTop := HeaderAlignTop;
3844 Settings.HeaderFilled := HeaderFilled;
3845 Settings.HeaderFlatten := HeaderFlatten;
3846 Settings.HeaderHighlightFocused := HeaderHighlightFocused;
3847 Settings.HeaderStyle := HeaderStyle;
3848 Settings.HideHeaderCaptionFloatingControl := HideHeaderCaptionFloatingControl;
3849 Settings.MultiLinePages := MultiLinePages;
3850 Settings.ScaleOnResize := ScaleOnResize;
3851 Settings.ShowHeader := ShowHeader;
3852 Settings.ShowHeaderCaption := ShowHeaderCaption;
3853 Settings.SplitterWidth := SplitterWidth;
3854 end;
3855
SettingsAreEqualnull3856 function TAnchorDockMaster.SettingsAreEqual(Settings: TAnchorDockSettings
3857 ): boolean;
3858 var
3859 Cur: TAnchorDockSettings;
3860 begin
3861 Cur:=TAnchorDockSettings.Create;
3862 try
3863 SaveSettings(Cur);
3864 Result:=Cur.IsEqual(Settings);
3865 finally
3866 Cur.Free;
3867 end;
3868 end;
3869
3870 procedure TAnchorDockMaster.ManualFloat(AControl: TControl);
3871 var
3872 Site: TAnchorDockHostSite;
3873 begin
3874 Site:=GetAnchorSite(AControl);
3875 if Site=nil then exit;
3876 Site.Undock;
3877 end;
3878
3879 procedure TAnchorDockMaster.ManualDock(SrcSite: TAnchorDockHostSite;
3880 TargetSite: TCustomForm; Align: TAlign; TargetControl: TControl);
3881 var
3882 Site: TAnchorDockHostSite;
3883 aManager: TAnchorDockManager;
3884 DockObject: TDragDockObject;
3885 begin
3886 {$IFDEF VerboseAnchorDocking}
3887 debugln(['TAnchorDockMaster.ManualDock SrcSite=',DbgSName(SrcSite),' TargetSite=',DbgSName(TargetSite),' Align=',dbgs(Align),' TargetControl=',DbgSName(TargetControl)]);
3888 {$ENDIF}
3889 if SrcSite=TargetSite then exit;
3890 if SrcSite.IsParentOf(TargetSite) then
3891 raise Exception.Create('TAnchorDockMaster.ManualDock SrcSite.IsParentOf(TargetSite)');
3892 if TargetSite.IsParentOf(SrcSite) then
3893 raise Exception.Create('TAnchorDockMaster.ManualDock TargetSite.IsParentOf(SrcSite)');
3894
3895 if IsCustomSite(TargetSite) then begin
3896 aManager:=TAnchorDockManager(TargetSite.DockManager);
3897 Site:=aManager.GetChildSite;
3898 if Site=nil then begin
3899 // dock as first site into custom dock site
3900 {$IFDEF VerboseAnchorDocking}
3901 debugln(['TAnchorDockMaster.ManualDock dock as first site into custom dock site: SrcSite=',DbgSName(SrcSite),' TargetSite=',DbgSName(TargetSite),' Align=',dbgs(Align)]);
3902 {$ENDIF}
3903 BeginUpdate;
3904 try
3905 DockObject := TDragDockObject.Create(SrcSite);
3906 try
3907 DockObject.DropAlign:=Align;
3908 DockObject.DockRect:=SrcSite.BoundsRect;
3909 DockObject.Control.Dock(TargetSite, SrcSite.BoundsRect);
3910 aManager.InsertControl(DockObject);
3911 finally
3912 DockObject.Free;
3913 end;
3914 finally
3915 EndUpdate;
3916 end;
3917 exit;
3918 end;
3919 // else: dock into child site of custom dock site
3920 end else begin
3921 // dock to or into TargetSite
3922 if not (TargetSite is TAnchorDockHostSite) then
3923 raise Exception.Create('TAnchorDockMaster.ManualDock invalid TargetSite');
3924 Site:=TAnchorDockHostSite(TargetSite);
3925 end;
3926 if AutoFreedIfControlIsRemoved(Site,SrcSite) then
3927 raise Exception.Create('TAnchorDockMaster.ManualDock TargetSite depends on SrcSite');
3928 BeginUpdate;
3929 try
3930 Site.ExecuteDock(SrcSite,TargetControl,Align);
3931 finally
3932 EndUpdate;
3933 end;
3934 end;
3935
3936 procedure TAnchorDockMaster.ManualDock(SrcSite: TAnchorDockHostSite;
3937 TargetPanel: TAnchorDockPanel; Align: TAlign; TargetControl: TControl);
3938 var
3939 Site: TAnchorDockHostSite;
3940 aManager: TAnchorDockManager;
3941 DockObject: TDragDockObject;
3942 begin
3943 {$IFDEF VerboseAnchorDocking}
3944 debugln(['TAnchorDockMaster.ManualDock SrcSite=',DbgSName(SrcSite),' TargetPanel=',DbgSName(TargetPanel),' Align=',dbgs(Align),' TargetControl=',DbgSName(TargetControl)]);
3945 {$ENDIF}
3946 if SrcSite.IsParentOf(TargetPanel) then
3947 raise Exception.Create('TAnchorDockMaster.ManualDock SrcSite.IsParentOf(TargetSite)');
3948 if TargetPanel.IsParentOf(SrcSite) then
3949 raise Exception.Create('TAnchorDockMaster.ManualDock TargetSite.IsParentOf(SrcSite)');
3950
3951
3952 aManager:=TAnchorDockManager(TargetPanel.DockManager);
3953 Site:=aManager.GetChildSite;
3954 if Site=nil then begin
3955 // dock as first site into AnchorDockPanel
3956 {$IFDEF VerboseAnchorDocking}
3957 debugln(['TAnchorDockMaster.ManualDock dock as first site into AnchorDockPanel: SrcSite=',DbgSName(SrcSite),' TargetPanel=',DbgSName(TargetPanel),' Align=',dbgs(Align)]);
3958 {$ENDIF}
3959 BeginUpdate;
3960 try
3961 DockObject := TDragDockObject.Create(SrcSite);
3962 try
3963 DockObject.DropAlign:=alClient;
3964 DockObject.DockRect:=SrcSite.BoundsRect;
3965 DockObject.Control.Dock(TargetPanel, SrcSite.BoundsRect);
3966 aManager.InsertControl(DockObject);
3967 finally
3968 DockObject.Free;
3969 end;
3970 finally
3971 EndUpdate;
3972 end;
3973 exit;
3974 end;
3975
3976 if AutoFreedIfControlIsRemoved(Site,SrcSite) then
3977 raise Exception.Create('TAnchorDockMaster.ManualDock TargetPanel depends on SrcSite');
3978 BeginUpdate;
3979 try
3980 Site.ExecuteDock(SrcSite,TargetControl,Align);
3981 finally
3982 EndUpdate;
3983 end;
3984 end;
3985
ManualEnlargenull3986 function TAnchorDockMaster.ManualEnlarge(Site: TAnchorDockHostSite;
3987 Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean;
3988 begin
3989 Result:=(Site<>nil) and Site.EnlargeSide(Side,OnlyCheckIfPossible);
3990 end;
3991
3992 procedure TAnchorDockMaster.BeginUpdate;
3993 begin
3994 inc(fUpdateCount);
3995 end;
3996
3997 procedure TAnchorDockMaster.EndUpdate;
3998 begin
3999 if fUpdateCount<=0 then
4000 RaiseGDBException('');
4001 dec(fUpdateCount);
4002 if fUpdateCount=0 then begin
4003 SimplifyPendingLayouts;
4004 UpdateHeaders;
4005 InvalidateHeaders;
4006 end;
4007 end;
4008
IsReleasingnull4009 function TAnchorDockMaster.IsReleasing(AControl: TControl): Boolean;
4010 begin
4011 Result := fNeedFree.IndexOf(AControl) >= 0;
4012 end;
4013
4014 procedure TAnchorDockMaster.NeedSimplify(AControl: TControl);
4015 begin
4016 if Self=nil then exit;
4017 if csDestroying in ComponentState then exit;
4018 if csDestroying in AControl.ComponentState then exit;
4019 if fNeedSimplify=nil then exit;
4020 if fNeedSimplify.IndexOf(AControl)>=0 then exit;
4021 if not ((AControl is TAnchorDockHostSite)
4022 or (AControl is TAnchorDockPage))
4023 then
4024 exit;
4025 if Application.Terminated then exit;
4026 //debugln(['TAnchorDockMaster.NeedSimplify ',DbgSName(AControl),' Caption="',AControl.Caption,'"']);
4027 fNeedSimplify.Add(AControl);
4028 AControl.FreeNotification(Self);
4029 QueueSimplify:=true;
4030 end;
4031
4032 procedure TAnchorDockMaster.NeedFree(AControl: TControl);
4033 begin
4034 //debugln(['TAnchorDockMaster.NeedFree ',DbgSName(AControl),' ',csDestroying in AControl.ComponentState]);
4035 if IsReleasing(AControl) then exit;
4036 if csDestroying in AControl.ComponentState then exit;
4037 fNeedFree.Add(AControl);
4038 AControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF};
4039 AControl.Parent:=nil;
4040 AControl.Visible:=false;
4041 end;
4042
4043 procedure TAnchorDockMaster.SimplifyPendingLayouts;
4044 var
4045 AControl: TControl;
4046 Changed: Boolean;
4047 i: Integer;
4048 begin
4049 if fSimplifying or (fUpdateCount>0) then exit;
4050 fSimplifying:=true;
4051 try
4052 // simplify layout (do not free controls in this step, only mark them)
4053 repeat
4054 Changed:=false;
4055 i:=fNeedSimplify.Count-1;
4056 while i>=0 do begin
4057 AControl:=TControl(fNeedSimplify[i]);
4058 if (csDestroying in AControl.ComponentState)
4059 or IsReleasing(AControl) then begin
4060 fNeedSimplify.Delete(i);
4061 Changed:=true;
4062 end else if (AControl is TAnchorDockHostSite) then begin
4063 //debugln(['TAnchorDockMaster.SimplifyPendingLayouts ',DbgSName(AControl),' ',dbgs(TAnchorDockHostSite(AControl).SiteType),' UpdatingLayout=',TAnchorDockHostSite(AControl).UpdatingLayout]);
4064 if not TAnchorDockHostSite(AControl).UpdatingLayout then begin
4065 fNeedSimplify.Delete(i);
4066 Changed:=true;
4067 if TAnchorDockHostSite(AControl).SiteType=adhstNone then
4068 begin
4069 //debugln(['TAnchorDockMaster.SimplifyPendingLayouts free empty site: ',dbgs(pointer(AControl)),' Caption="',AControl.Caption,'"']);
4070 NeedFree(AControl);
4071 end else begin
4072 TAnchorDockHostSite(AControl).Simplify;
4073 end;
4074 end;
4075 end else if AControl is TAnchorDockPage then begin
4076 fNeedSimplify.Delete(i);
4077 Changed:=true;
4078 NeedFree(AControl);
4079 end else
4080 RaiseGDBException('TAnchorDockMaster.SimplifyPendingLayouts inconsistency');
4081 i:=Min(fNeedSimplify.Count,i)-1;
4082 end;
4083 until not Changed;
4084
4085 // free unneeded controls
4086 for i := fNeedFree.Count - 1 downto 0 do
4087 if not (csDestroying in TControl(fNeedFree[i]).ComponentState) then
4088 Application.ReleaseComponent(TComponent(fNeedFree[i]));
4089 fNeedFree.Clear;
4090 finally
4091 fSimplifying:=false;
4092 end;
4093 end;
4094
AutoFreedIfControlIsRemovednull4095 function TAnchorDockMaster.AutoFreedIfControlIsRemoved(AControl,
4096 RemovedControl: TControl): boolean;
4097 { returns true if the simplification algorithm will automatically free
4098 AControl when RemovedControl is removed
4099 Some sites are dummy sites that were autocreated. They will be auto freed
4100 if not needed anymore.
4101 1. A TAnchorDockPage has a TAnchorDockHostSite as child. If the child is freed
4102 the page will be freed.
4103 2. When a TAnchorDockPageControl has only one page left the content is moved
4104 up and the pagecontrol and page will be freed.
4105 3. When a adhstLayout site has only one child site left, the content is moved up
4106 and the child site will be freed.
4107 4. When the control of a adhstOneControl site is freed the site will be freed.
4108 }
4109 var
4110 ParentSite: TAnchorDockHostSite;
4111 Page: TAnchorDockPage;
4112 PageControl: TAnchorDockPageControl;
4113 OtherPage: TAnchorDockPage;
4114 Site, Site1, Site2: TAnchorDockHostSite;
4115 begin
4116 Result:=false;
4117 if (RemovedControl=nil) or (AControl=nil) then exit;
4118 while RemovedControl<>nil do begin
4119 if RemovedControl=AControl then exit(true);
4120 if RemovedControl is TAnchorDockPage then begin
4121 // a page will be removed
4122 Page:=TAnchorDockPage(RemovedControl);
4123 if not (Page.Parent is TAnchorDockPageControl) then exit;
4124 PageControl:=TAnchorDockPageControl(Page.Parent);
4125 if PageControl.PageCount>2 then exit;
4126 if PageControl.PageCount=2 then begin
4127 // this pagecontrol will be replaced by the content of the other page
4128 if PageControl=AControl then exit(true);
4129 if PageControl.Page[0]=Page then
4130 OtherPage:=PageControl.DockPages[1]
4131 else
4132 OtherPage:=PageControl.DockPages[0];
4133 // the other page will be removed (its content will be moved up)
4134 if OtherPage=AControl then exit(true);
4135 if (OtherPage.ControlCount>0) then begin
4136 if (OtherPage.Controls[0] is TAnchorDockHostSite)
4137 and (OtherPage.Controls[0]=RemovedControl) then
4138 exit(true); // the site of the other page will be removed (its content moved up)
4139 end;
4140 exit;
4141 end;
4142 // the last page of the pagecontrol is freed => the pagecontrol will be removed too
4143 end else if RemovedControl is TAnchorDockPageControl then begin
4144 // the pagecontrol will be removed
4145 if not (RemovedControl.Parent is TAnchorDockHostSite) then exit;
4146 // a pagecontrol is always the only child of a site
4147 // => the site will be removed too
4148 end else if RemovedControl is TAnchorDockHostSite then begin
4149 // a site will be removed
4150 Site:=TAnchorDockHostSite(RemovedControl);
4151 if Site.Parent is TAnchorDockPage then begin
4152 // a page has only one site
4153 // => the page will be removed too
4154 end else if Site.Parent is TAnchorDockHostSite then begin
4155 ParentSite:=TAnchorDockHostSite(Site.Parent);
4156 if (ParentSite.SiteType=adhstOneControl)
4157 or ParentSite.IsOneSiteLayout(Site) then begin
4158 // the control of a OneControl site is removed => the ParentSite is freed too
4159 end else if ParentSite.SiteType=adhstLayout then begin
4160 if ParentSite.IsTwoSiteLayout(Site1,Site2) then begin
4161 // when there are two sites and one of them is removed
4162 // the content of the other will be moved up and then both sites are
4163 // removed
4164 if (Site1=AControl) or (Site2=AControl) then
4165 exit(true);
4166 end;
4167 exit; // removing only site will not free the layout
4168 end else begin
4169 raise Exception.Create('TAnchorDockMaster.AutoFreedIfControlIsRemoved ParentSiteType='+dbgs(ParentSite.SiteType)+' ChildSiteType='+dbgs(Site.SiteType));
4170 end;
4171 end else
4172 exit; // other classes will never be auto freed
4173 end else begin
4174 // control is not a site => check if control is in a OneControl site
4175 if not (RemovedControl.Parent is TAnchorDockHostSite) then exit;
4176 ParentSite:=TAnchorDockHostSite(RemovedControl.Parent);
4177 if (ParentSite.SiteType<>adhstOneControl) then exit;
4178 if ParentSite.GetOneControl<>RemovedControl then exit;
4179 // the control of a OneControl site is removed => the site is freed too
4180 end;
4181 RemovedControl:=RemovedControl.Parent;
4182 end;
4183 end;
4184
CreateSitenull4185 function TAnchorDockMaster.CreateSite(NamePrefix: string;
4186 DisableAutoSizing: boolean): TAnchorDockHostSite;
4187 var
4188 i: Integer;
4189 NewName: String;
4190 begin
4191 Result:=TAnchorDockHostSite(SiteClass.NewInstance);
4192 {$IFDEF DebugDisableAutoSizing}
4193 if DisableAutoSizing then
4194 Result.DisableAutoSizing(ADAutoSizingReason)
4195 else
4196 Result.DisableAutoSizing('TAnchorDockMaster.CreateSite');
4197 {$ELSE}
4198 Result.DisableAutoSizing;
4199 {$ENDIF};
4200 try
4201 Result.CreateNew(Self,1);
4202 i:=0;
4203 repeat
4204 inc(i);
4205 NewName:=NamePrefix+AnchorDockSiteName+IntToStr(i);
4206 until (Screen.FindForm(NewName)=nil) and (FindComponent(NewName)=nil);
4207 Result.Name:=NewName;
4208 finally
4209 if not DisableAutoSizing then
4210 Result.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.CreateSite'){$ENDIF};
4211 end;
4212 end;
4213
CreateSplitternull4214 function TAnchorDockMaster.CreateSplitter(NamePrefix: string): TAnchorDockSplitter;
4215 var
4216 i: Integer;
4217 NewName: String;
4218 begin
4219 Result:=SplitterClass.Create(Self);
4220 i:=0;
4221 repeat
4222 inc(i);
4223 NewName:=NamePrefix+AnchorDockSplitterName+IntToStr(i);
4224 until FindComponent(NewName)=nil;
4225 Result.Name:=NewName;
4226 end;
4227
4228 procedure TAnchorDockMaster.IncreaseOptionsChangeStamp;
4229 begin
4230 LUIncreaseChangeStamp64(FOptionsChangeStamp);
4231 end;
4232
4233 procedure TAnchorDockMaster.UpdateHeaders;
4234 var
4235 i: Integer;
4236 AControl: TControl;
4237 begin
4238 for i:=0 to ControlCount-1 do begin
4239 AControl:=Controls[i];
4240 while Assigned(AControl) do
4241 begin
4242 if AControl is TAnchorDockHostSite then
4243 TAnchorDockHostSite(AControl).UpdateHeaderShowing;
4244 AControl:=AControl.Parent;
4245 end;
4246 end;
4247 end;
4248
4249 { TAnchorDockHostSite }
4250
4251 procedure TAnchorDockHostSite.SetHeaderSide(const AValue: TAnchorKind);
4252 begin
4253 if FHeaderSide=AValue then exit;
4254 FHeaderSide:=AValue;
4255 end;
4256
GetMinimizednull4257 function TAnchorDockHostSite.GetMinimized: Boolean;
4258 begin
4259 Result:=Assigned(FMinimizedControl);
4260 end;
4261
4262 procedure TAnchorDockHostSite.CheckFormStyle;
4263 var
4264 AControl: TControl;
4265 AForm: TCustomForm absolute AControl;
4266 IsMainDockForm: Boolean;
4267 begin
4268 AControl := GetOneControl;
4269 if not (AControl is TCustomForm) then Exit;
4270 if AForm.FormStyle in fsAllStayOnTop then
4271 begin
4272 FormStyle := AForm.FormStyle;
4273 Exit;
4274 end;
4275 if not DockMaster.FloatingWindowsOnTop then
4276 Exit;
4277 IsMainDockForm := (AForm = DockMaster.MainDockForm)
4278 or (AForm.IsParentOf(DockMaster.MainDockForm))
4279 or (GetParentForm(AForm) = DockMaster.MainDockForm);
4280 if IsMainDockForm then Exit;
4281 FormStyle := fsStayOnTop;
4282 end;
4283
4284 procedure TAnchorDockHostSite.FirstShow(Sender: TObject);
4285 begin
4286 if Sender <> Self then Exit;
4287 CheckFormStyle;
4288 end;
4289
4290 procedure TAnchorDockHostSite.ChildVisibleChanged(Sender: TObject);
4291 var
4292 AControl: TControl;
4293 begin
4294 if Sender is TControl then begin
4295 AControl:=TControl(Sender);
4296 if not (csDestroying in ComponentState) then begin
4297 if (not AControl.Visible)
4298 and (not Minimized)
4299 and (not ((AControl is TAnchorDockHeader)
4300 or (AControl is TAnchorDockSplitter)
4301 or (AControl is TAnchorDockHostSite)))
4302 then begin
4303 //debugln(['TAnchorDockHostSite.ChildVisibleChanged START ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl),' UpdatingLayout=',UpdatingLayout]);
4304 if (SiteType=adhstOneControl) then
4305 Hide
4306 else if (SiteType=adhstLayout) then begin
4307 RemoveControlFromLayout(AControl);
4308 UpdateDockCaption;
4309 end;
4310 //debugln(['TAnchorDockHostSite.ChildVisibleChanged END ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl)]);
4311 end;
4312 end;
4313 end;
4314 end;
4315
4316 procedure TAnchorDockHostSite.DoEnter;
4317 begin
4318 inherited;
4319 if Assigned(FHeader) then
4320 FHeader.FFocused:=true;
4321 invalidate;
4322 end;
4323
4324 procedure TAnchorDockHostSite.DoExit;
4325 begin
4326 inherited;
4327 if Assigned(FHeader) then
4328 FHeader.FFocused:=false;
4329 invalidate;
4330 end;
4331
4332 procedure TAnchorDockHostSite.Notification(AComponent: TComponent;
4333 Operation: TOperation);
4334 begin
4335 inherited Notification(AComponent, Operation);
4336 if Operation=opRemove then begin
4337 if AComponent=Pages then FPages:=nil;
4338 if AComponent=Header then FHeader:=nil;
4339 if AComponent=BoundSplitter then FBoundSplitter:=nil;
4340 end;
4341 end;
4342
DoDockClientMsgnull4343 function TAnchorDockHostSite.DoDockClientMsg(DragDockObject: TDragDockObject;
4344 aPosition: TPoint): boolean;
4345 begin
4346 if aPosition.X=0 then ;
4347 Result:=ExecuteDock(DragDockObject.Control,DragDockObject.DropOnControl,
4348 DragDockObject.DropAlign);
4349 end;
4350
ExecuteDocknull4351 function TAnchorDockHostSite.ExecuteDock(NewControl, DropOnControl: TControl;
4352 DockAlign: TAlign): boolean;
4353 begin
4354 if UpdatingLayout then exit;
4355 //debugln(['TAnchorDockHostSite.ExecuteDock Self="',Caption,'" Control=',DbgSName(NewControl),' DropOnControl=',DbgSName(DropOnControl),' Align=',dbgs(DockAlign)]);
4356
4357 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock HostSite'){$ENDIF};
4358 try
4359 BeginUpdateLayout;
4360 try
4361 DockMaster.SimplifyPendingLayouts;
4362 NewControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock NewControl'){$ENDIF};
4363
4364 if (NewControl.Parent=Self) and (SiteType=adhstLayout) then begin
4365 // change of layout, one child is docked to the outer side
4366 RemoveControlFromLayout(NewControl);
4367 end else if (NewControl.Parent=Parent) and (Parent is TAnchorDockHostSite)
4368 and (TAnchorDockHostSite(Parent).SiteType=adhstLayout) then begin
4369 // change of layout, one sibling is moved
4370 TAnchorDockHostSite(Parent).RemoveControlFromLayout(NewControl);
4371 end;
4372
4373 if SiteType=adhstNone then begin
4374 // make a control dockable by docking it into a TAnchorDockHostSite;
4375 Result:=DockFirstControl(NewControl);
4376 end else if DockAlign=alClient then begin
4377 // page docking
4378 if SiteType=adhstOneControl then begin
4379 if Parent is TAnchorDockPage then begin
4380 // add as sibling page
4381 Result:=(Parent.Parent.Parent as TAnchorDockHostSite).DockAnotherPage(NewControl,nil);
4382 end else
4383 // create pages
4384 Result:=DockSecondPage(NewControl);
4385 end else if SiteType=adhstPages then
4386 // add as sibling page
4387 Result:=DockAnotherPage(NewControl,DropOnControl);
4388 end else if DockAlign in [alLeft,alTop,alRight,alBottom] then
4389 begin
4390 // anchor docking
4391 if SiteType=adhstOneControl then begin
4392 if Parent is TAnchorDockHostSite then begin
4393 // add site as sibling
4394 Result:=TAnchorDockHostSite(Parent).DockAnotherControl(Self,NewControl,
4395 DockAlign,DropOnControl<>nil);
4396 end else
4397 // create layout
4398 Result:=DockSecondControl(NewControl,DockAlign,DropOnControl<>nil);
4399 end else if SiteType=adhstLayout then
4400 // add site as sibling
4401 Result:=DockAnotherControl(nil,NewControl,DockAlign,DropOnControl<>nil);
4402 end;
4403
4404 NewControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock NewControl'){$ENDIF};
4405 finally
4406 EndUpdateLayout;
4407 end;
4408 finally
4409 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock HostSite'){$ENDIF};
4410 end;
4411 end;
4412
DockFirstControlnull4413 function TAnchorDockHostSite.DockFirstControl(NewControl: TControl): boolean;
4414 var
4415 DestRect: TRect;
4416 begin
4417 if SiteType<>adhstNone then
4418 RaiseGDBException('TAnchorDockHostSite.DockFirstControl inconsistency');
4419 // create adhstOneControl
4420 DestRect := ClientRect;
4421 NewControl.Dock(Self, DestRect);
4422 FSiteType:=adhstOneControl;
4423 if NewControl is TCustomForm then begin
4424 Icon.Assign(TCustomForm(NewControl).Icon);
4425 end;
4426 Result:=true;
4427 end;
4428
DockSecondControlnull4429 function TAnchorDockHostSite.DockSecondControl(NewControl: TControl;
4430 DockAlign: TAlign; Inside: boolean): boolean;
4431 { Convert a adhstOneControl into a adhstLayout by docking NewControl
4432 at a side (DockAlign).
4433 If Inside=true this DockSite is not expanded and both controls share the old space.
4434 If Inside=false this DockSite is expanded.
4435 }
4436 var
4437 OldSite: TAnchorDockHostSite;
4438 OldControl: TControl;
4439 begin
4440 Result:=true;
4441 {$IFDEF VerboseAnchorDocking}
4442 debugln(['TAnchorDockHostSite.DockSecondControl Self="',Caption,'" AControl=',DbgSName(NewControl),' Align=',dbgs(DockAlign),' Inside=',Inside]);
4443 {$ENDIF}
4444 if SiteType<>adhstOneControl then
4445 RaiseGDBException('TAnchorDockHostSite.DockSecondControl inconsistency: not adhstOneControl');
4446 if not (DockAlign in [alLeft,alTop,alRight,alBottom]) then
4447 RaiseGDBException('TAnchorDockHostSite.DockSecondControl inconsistency: DockAlign='+dbgs(DockAlign));
4448
4449 FSiteType:=adhstLayout;
4450
4451 // remove header (keep it for later use)
4452 Header.Parent:=nil;
4453
4454 // put the OldControl into a site of its own (OldSite) and dock OldSite
4455 OldControl:=GetOneControl;
4456 OldSite:=MakeSite(OldControl);
4457 AddCleanControl(OldSite);
4458 OldSite.AnchorClient(0);
4459 // the LCL will compute the bounds later after EnableAutoSizing
4460 // but the bounds are needed now => set them manually
4461 OldSite.BoundsRect:=Rect(0,0,ClientWidth,ClientHeight);
4462
4463 Result:=DockAnotherControl(OldSite,NewControl,DockAlign,Inside);
4464 {$IFDEF VerboseAnchorDocking}
4465 debugln(['TAnchorDockHostSite.DockSecondControl END Self="',Caption,'" AControl=',DbgSName(NewControl),' Align=',dbgs(DockAlign),' Inside=',Inside]);
4466 {$ENDIF}
4467 end;
4468
DockAnotherControlnull4469 function TAnchorDockHostSite.DockAnotherControl(Sibling, NewControl: TControl;
4470 DockAlign: TAlign; Inside: boolean): boolean;
4471 var
4472 Splitter: TAnchorDockSplitter;
4473 a: TAnchorKind;
4474 NewSite: TAnchorDockHostSite;
4475 NewBounds: TRect;
4476 MainAnchor: TAnchorKind;
4477 i: Integer;
4478 NewSiblingWidth: Integer;
4479 NewSiblingHeight: Integer;
4480 NewSize: LongInt;
4481 BoundsIncreased: Boolean;
4482 NewParentBounds: TRect;
4483 begin
4484 Result:=false;
4485 if SiteType<>adhstLayout then
4486 RaiseGDBException('TAnchorDockHostSite.DockAnotherControl inconsistency');
4487 if not (DockAlign in [alLeft,alTop,alRight,alBottom]) then
4488 RaiseGDBException('TAnchorDockHostSite.DockAnotherControl inconsistency');
4489
4490 // add a splitter
4491 Splitter:=DockMaster.CreateSplitter;
4492 if DockAlign in [alLeft,alRight] then begin
4493 Splitter.ResizeAnchor:=akLeft;
4494 Splitter.Width:=DockMaster.SplitterWidth;
4495 end else begin
4496 Splitter.ResizeAnchor:=akTop;
4497 Splitter.Height:=DockMaster.SplitterWidth;
4498 end;
4499 Splitter.Parent:=Self;
4500
4501 // dock the NewControl
4502 NewSite:=MakeSite(NewControl);
4503 AddCleanControl(NewSite);
4504
4505 BoundsIncreased:=false;
4506 if (not Inside) then begin
4507 if (Parent=nil) then begin
4508 // expand Self
4509 NewBounds:=BoundsRect;
4510 case DockAlign of
4511 alLeft:
4512 begin
4513 dec(NewBounds.Left,NewSite.Width+Splitter.Width);
4514 MoveAllControls(NewSite.Width+Splitter.Width,0);
4515 end;
4516 alRight:
4517 inc(NewBounds.Right,NewSite.Width+Splitter.Width);
4518 alTop:
4519 begin
4520 dec(NewBounds.Top,NewSite.Height+Splitter.Height);
4521 MoveAllControls(0,NewSite.Height+Splitter.Height);
4522 end;
4523 alBottom:
4524 inc(NewBounds.Bottom,NewSite.Height+Splitter.Height);
4525 end;
4526 BoundsRect:=NewBounds;
4527 BoundsIncreased:=true;
4528 end else if DockMaster.IsCustomSite(Parent) then begin
4529 // Parent is a custom docksite
4530 // => expand Self and Parent
4531 // expand Parent (the custom docksite)
4532 NewParentBounds:=Parent.BoundsRect;
4533 NewBounds:=BoundsRect;
4534 case DockAlign of
4535 alLeft:
4536 begin
4537 i:=NewSite.Width+Splitter.Width;
4538 dec(NewParentBounds.Left,i);
4539 dec(NewBounds.Left,i);
4540 MoveAllControls(i,0);
4541 end;
4542 alRight:
4543 begin
4544 i:=NewSite.Width+Splitter.Width;
4545 inc(NewBounds.Right,i);
4546 inc(NewParentBounds.Right,i);
4547 end;
4548 alTop:
4549 begin
4550 i:=NewSite.Height+Splitter.Height;
4551 dec(NewBounds.Top,i);
4552 dec(NewParentBounds.Top,i);
4553 MoveAllControls(0,i);
4554 end;
4555 alBottom:
4556 begin
4557 i:=NewSite.Height+Splitter.Height;
4558 inc(NewParentBounds.Bottom,i);
4559 inc(NewBounds.Bottom,i);
4560 end;
4561 end;
4562 Parent.BoundsRect:=NewParentBounds;
4563 BoundsRect:=NewBounds;
4564 BoundsIncreased:=true;
4565 TAnchorDockManager(Parent.DockManager).FSiteClientRect:=Parent.ClientRect;
4566 end;
4567 {$IFDEF VerboseAnchorDocking}
4568 debugln(['TAnchorDockHostSite.DockAnotherControl AFTER ENLARGE ',Caption]);
4569 //DebugWriteChildAnchors(Self,true,true);
4570 {$ENDIF}
4571 end;
4572
4573 // anchors
4574 MainAnchor:=MainAlignAnchor[DockAlign];
4575 if Inside and (Sibling<>nil) then begin
4576 { Example: insert right of Sibling
4577 # #
4578 ################ ########################
4579 -------+# -------+#+-------+#
4580 Sibling|# -----> Sibling|#|NewSite|#
4581 -------+# -------+#+-------+#
4582 ################ ########################
4583 # #
4584 }
4585 for a:=low(TAnchorKind) to high(TAnchorKind) do begin
4586 if a in AnchorAlign[DockAlign] then begin
4587 NewSite.AnchorSide[a].Assign(Sibling.AnchorSide[a]);
4588 end else begin
4589 NewSite.AnchorToNeighbour(a,0,Splitter);
4590 end;
4591 end;
4592 Sibling.AnchorToNeighbour(MainAnchor,0,Splitter);
4593
4594 if DockAlign in [alLeft,alRight] then begin
4595 Splitter.AnchorSide[akTop].Assign(Sibling.AnchorSide[akTop]);
4596 Splitter.AnchorSide[akBottom].Assign(Sibling.AnchorSide[akBottom]);
4597 // resize and move
4598 // the NewSite gets at maximum half the space
4599 // Many bounds are later set by the LCL anchoring. When docking several
4600 // controls at once the bounds are needed earlier.
4601 NewSize:=Max(1,Min(NewSite.Width,Sibling.Width div 2));
4602 NewBounds:=Rect(0,0,NewSize,Sibling.Height);
4603 NewSiblingWidth:=Max(1,Sibling.Width-NewSize-Splitter.Width);
4604 if DockAlign=alLeft then begin
4605 // alLeft: NewControl, Splitter, Sibling
4606 Splitter.SetBounds(Sibling.Left+NewSize,Sibling.Top,
4607 Splitter.Width,Sibling.Height);
4608 OffsetRect(NewBounds,Sibling.Left,Sibling.Top);
4609 Sibling.SetBounds(Splitter.Left+Splitter.Width,Sibling.Top,
4610 NewSiblingWidth,Sibling.Height);
4611 end else begin
4612 // alRight: Sibling, Splitter, NewControl
4613 Sibling.Width:=NewSiblingWidth;
4614 Splitter.SetBounds(Sibling.Left+Sibling.Width,Sibling.Top,
4615 Splitter.Width,Sibling.Height);
4616 OffsetRect(NewBounds,Splitter.Left+Splitter.Width,Sibling.Top);
4617 end;
4618 NewSite.BoundsRect:=NewBounds;
4619 end else begin
4620 Splitter.AnchorSide[akLeft].Assign(Sibling.AnchorSide[akLeft]);
4621 Splitter.AnchorSide[akRight].Assign(Sibling.AnchorSide[akRight]);
4622 // resize and move
4623 // the NewSite gets at maximum half the space
4624 // Many bounds are later set by the LCL anchoring. When docking several
4625 // controls at once the bounds are needed earlier.
4626 NewSize:=Max(1,Min(NewSite.Height,Sibling.Height div 2));
4627 NewSiblingHeight:=Max(1,Sibling.Height-NewSize-Splitter.Height);
4628 if DockAlign=alTop then begin
4629 // alTop: NewControl, Splitter, Sibling
4630 Splitter.SetBounds(Sibling.Left,Sibling.Top+NewSize,
4631 Sibling.Width,Splitter.Height);
4632 NewSite.SetBounds(Sibling.Left,Sibling.Top,Sibling.Width,NewSize);
4633 Sibling.SetBounds(Sibling.Left,Splitter.Top+Splitter.Height,
4634 Sibling.Width,NewSiblingHeight);
4635 end else begin
4636 // alBottom: Sibling, Splitter, NewControl
4637 Sibling.Height:=NewSiblingHeight;
4638 Splitter.SetBounds(Sibling.Left,Sibling.Top+Sibling.Height,
4639 Sibling.Width,Splitter.Height);
4640 NewSite.SetBounds(Sibling.Left,Splitter.Top+Splitter.Height,
4641 Sibling.Width,NewSize);
4642 end;
4643 end;
4644 end else begin
4645 { Example: insert right of all siblings
4646 ########## #######################
4647 --------+# --------+#+----------+#
4648 SiblingA|# SiblingA|#| |#
4649 --------+# --------+#| |#
4650 ########## -----> ##########|NewControl|#
4651 --------+# --------+#| |#
4652 SiblingB|# SiblingB|#| |#
4653 --------+# --------+#+----------+#
4654 ########## #######################
4655 }
4656 if DockAlign in [alLeft,alRight] then
4657 NewSize:=NewSite.Width
4658 else
4659 NewSize:=NewSite.Height;
4660 for i:=0 to ControlCount-1 do begin
4661 Sibling:=Controls[i];
4662 if Sibling.AnchorSide[MainAnchor].Control=Self then begin
4663 // this Sibling is anchored to the docked site
4664 // anchor it to the splitter
4665 Sibling.AnchorToNeighbour(MainAnchor,0,Splitter);
4666 if not BoundsIncreased then begin
4667 // the NewSite gets at most half the space
4668 if DockAlign in [alLeft,alRight] then
4669 NewSize:=Min(NewSize,Sibling.Width div 2)
4670 else
4671 NewSize:=Min(NewSize,Sibling.Height div 2);
4672 end;
4673 end;
4674 end;
4675 NewSize:=Max(1,NewSize);
4676
4677 // anchor Splitter and NewSite
4678 a:=ClockwiseAnchor[MainAnchor];
4679 Splitter.AnchorParallel(a,0,Self);
4680 Splitter.AnchorParallel(OppositeAnchor[a],0,Self);
4681 NewSite.AnchorParallel(a,0,Self);
4682 NewSite.AnchorParallel(OppositeAnchor[a],0,Self);
4683 NewSite.AnchorParallel(MainAnchor,0,Self);
4684 NewSite.AnchorToNeighbour(OppositeAnchor[MainAnchor],0,Splitter);
4685
4686 // Many bounds are later set by the LCL anchoring. When docking several
4687 // controls at once the bounds are needed earlier.
4688 if DockAlign in [alLeft,alRight] then begin
4689 if DockAlign=alLeft then begin
4690 // alLeft: NewSite, Splitter, other siblings
4691 Splitter.SetBounds(NewSize,0,Splitter.Width,ClientHeight);
4692 NewSite.SetBounds(0,0,NewSize,ClientHeight);
4693 end else begin
4694 // alRight: other siblings, Splitter, NewSite
4695 NewSite.SetBounds(ClientWidth-NewSize,0,NewSize,ClientHeight);
4696 Splitter.SetBounds(NewSite.Left-Splitter.Width,0,Splitter.Width,ClientHeight);
4697 end;
4698 end else begin
4699 if DockAlign=alTop then begin
4700 // alTop: NewSite, Splitter, other siblings
4701 Splitter.SetBounds(0,NewSize,ClientWidth,Splitter.Height);
4702 NewSite.SetBounds(0,0,ClientWidth,NewSize);
4703 end else begin
4704 // alBottom: other siblings, Splitter, NewSite
4705 NewSite.SetBounds(0,ClientHeight-NewSize,ClientWidth,NewSize);
4706 Splitter.SetBounds(0,NewSite.Top-Splitter.Height,ClientWidth,Splitter.Height);
4707 end;
4708 end;
4709 // shrink siblings
4710 for i:=0 to ControlCount-1 do begin
4711 Sibling:=Controls[i];
4712 if Sibling.AnchorSide[MainAnchor].Control=Splitter then begin
4713 NewBounds:=Sibling.BoundsRect;
4714 case DockAlign of
4715 alLeft: NewBounds.Left:=Splitter.Left+Splitter.Width;
4716 alRight: NewBounds.Right:=Splitter.Left;
4717 alTop: NewBounds.Top:=Splitter.Top+Splitter.Height;
4718 alBottom: NewBounds.Bottom:=Splitter.Top;
4719 end;
4720 NewBounds.Right:=Max(NewBounds.Left+1,NewBounds.Right);
4721 NewBounds.Bottom:=Max(NewBounds.Top+1,NewBounds.Bottom);
4722 Sibling.BoundsRect:=NewBounds;
4723 end;
4724 end;
4725 end;
4726
4727 //debugln(['TAnchorDockHostSite.DockAnotherControl ',DbgSName(Self)]);
4728 //DebugWriteChildAnchors(Self,true,true);
4729 Result:=true;
4730 end;
4731
4732 procedure TAnchorDockHostSite.CreatePages;
4733 begin
4734 if FPages<>nil then
4735 RaiseGDBException('');
4736 FPages:=DockMaster.PageControlClass.Create(nil); // do not own it, pages can be moved to another site
4737 FPages.FreeNotification(Self);
4738 FPages.Parent:=Self;
4739 FPages.Align:=alClient;
4740 FPages.MultiLine:=DockMaster.MultiLinePages;
4741 end;
4742
4743 procedure TAnchorDockHostSite.FreePages;
4744 begin
4745 FreeAndNil(FPages);
4746 end;
4747
DockSecondPagenull4748 function TAnchorDockHostSite.DockSecondPage(NewControl: TControl): boolean;
4749 var
4750 OldControl: TControl;
4751 OldSite: TAnchorDockHostSite;
4752 begin
4753 {$IFDEF VerboseAnchorDockPages}
4754 debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" AControl=',DbgSName(NewControl)]);
4755 {$ENDIF}
4756 if SiteType<>adhstOneControl then
4757 RaiseGDBException('TAnchorDockHostSite.DockSecondPage inconsistency');
4758
4759 FSiteType:=adhstPages;
4760 CreatePages;
4761
4762 // remove header (keep it for later use)
4763 {$IFDEF VerboseAnchorDockPages}
4764 debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" removing header ...']);
4765 {$ENDIF}
4766 Header.Parent:=nil;
4767
4768 // put the OldControl into a page of its own
4769 {$IFDEF VerboseAnchorDockPages}
4770 debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" move oldcontrol to site of its own ...']);
4771 {$ENDIF}
4772 OldControl:=GetOneControl;
4773 OldSite:=MakeSite(OldControl);
4774 OldSite.HostDockSite:=nil;
4775 {$IFDEF VerboseAnchorDockPages}
4776 debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" adding oldcontrol site ...']);
4777 {$ENDIF}
4778 FPages.Pages.Add(OldSite.Caption);
4779 OldSite.Parent:=FPages.Page[0];
4780 OldSite.Align:=alClient;
4781 OldSite.Visible:=true;
4782
4783 Result:=DockAnotherPage(NewControl,nil);
4784 end;
4785
DockAnotherPagenull4786 function TAnchorDockHostSite.DockAnotherPage(NewControl: TControl;
4787 InFrontOf: TControl): boolean;
4788 var
4789 NewSite: TAnchorDockHostSite;
4790 NewIndex: LongInt;
4791 begin
4792 {$IFDEF VerboseAnchorDockPages}
4793 debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" make new control (',DbgSName(NewControl),') dockable ...']);
4794 {$ENDIF}
4795 if SiteType<>adhstPages then
4796 RaiseGDBException('TAnchorDockHostSite.DockAnotherPage inconsistency');
4797
4798 NewSite:=MakeSite(NewControl);
4799 //debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" adding newcontrol site ...']);
4800 NewIndex:=FPages.PageCount;
4801 if (InFrontOf is TAnchorDockPage)
4802 and (InFrontOf.Parent=Pages) then
4803 NewIndex:=TAnchorDockPage(InFrontOf).PageIndex;
4804 Pages.Pages.Insert(NewIndex,NewSite.Caption);
4805 //debugln(['TAnchorDockHostSite.DockAnotherPage ',DbgSName(FPages.Page[1])]);
4806 NewSite.Parent:=FPages.Page[NewIndex];
4807 NewSite.Align:=alClient;
4808 NewSite.Visible:=true;
4809 FPages.PageIndex:=NewIndex;
4810
4811 Result:=true;
4812 end;
4813
4814 procedure TAnchorDockHostSite.AddCleanControl(AControl: TControl;
4815 TheAlign: TAlign);
4816 var
4817 a: TAnchorKind;
4818 begin
4819 AControl.Parent:=Self;
4820 AControl.Align:=TheAlign;
4821 AControl.Anchors:=[akLeft,akTop,akRight,akBottom];
4822 for a:=Low(TAnchorKind) to high(TAnchorKind) do
4823 AControl.AnchorSide[a].Control:=nil;
4824 AControl.Visible:=true;
4825 end;
4826
4827 procedure TAnchorDockHostSite.RemoveControlFromLayout(AControl: TControl);
4828
4829 procedure RemoveControlBoundSplitter(Splitter: TAnchorDockSplitter;
4830 Side: TAnchorKind);
4831 var
4832 i: Integer;
4833 Sibling: TControl;
4834 NewBounds: TRect;
4835 begin
4836 //debugln(['RemoveControlBoundSplitter START ',DbgSName(Splitter)]);
4837 { Example: Side=akRight
4838 # #
4839 ##################### #########
4840 ---+S+--------+# ---+#
4841 ---+S|AControl|# ---> ---+#
4842 ---+S+--------+# ---+#
4843 ##################### #########
4844 }
4845 for i:=Splitter.AnchoredControlCount-1 downto 0 do begin
4846 Sibling:=Splitter.AnchoredControls[i];
4847 if Sibling.AnchorSide[Side].Control=Splitter then begin
4848 // anchor Sibling to next
4849 Sibling.AnchorSide[Side].Assign(AControl.AnchorSide[Side]);
4850 // enlarge Sibling
4851 NewBounds:=Sibling.BoundsRect;
4852 case Side of
4853 akTop: NewBounds.Top:=AControl.Top;
4854 akLeft: NewBounds.Left:=AControl.Left;
4855 akRight: NewBounds.Right:=AControl.Left+AControl.Width;
4856 akBottom: NewBounds.Bottom:=AControl.Top+AControl.Height;
4857 end;
4858 if (sibling is TAnchorDockHostSite) then
4859 if (sibling as TAnchorDockHostSite).Minimized then begin
4860 DockMaster.FMapMinimizedControls.Remove((sibling as TAnchorDockHostSite).FMinimizedControl);
4861 (sibling as TAnchorDockHostSite).FMinimizedControl.Parent:=(sibling as TAnchorDockHostSite);
4862 (sibling as TAnchorDockHostSite).FMinimizedControl.Visible:=True;
4863 (sibling as TAnchorDockHostSite).FMinimizedControl:=nil;
4864 (sibling as TAnchorDockHostSite).UpdateHeaderAlign;
4865 end;
4866 Sibling.BoundsRect:=NewBounds;
4867 end;
4868 end;
4869 //debugln(['RemoveControlBoundSplitter ',DbgSName(Splitter)]);
4870 Splitter.Free;
4871
4872 ClearChildControlAnchorSides(AControl);
4873 //DebugWriteChildAnchors(GetParentForm(Self),true,true);
4874 end;
4875
4876 procedure ConvertToOneControlType(OnlySiteLeft: TAnchorDockHostSite);
4877 var
4878 a: TAnchorKind;
4879 NewBounds: TRect;
4880 p: TPoint;
4881 i: Integer;
4882 Sibling: TControl;
4883 NewParentBounds: TRect;
4884 begin
4885 BeginUpdateLayout;
4886 try
4887 // remove splitter
4888 for i:=ControlCount-1 downto 0 do begin
4889 Sibling:=Controls[i];
4890 if Sibling is TAnchorDockSplitter then
4891 Sibling.Free
4892 else if Sibling is TAnchorDockHostSite then
4893 for a:=low(TAnchorKind) to high(TAnchorKind) do
4894 Sibling.AnchorSide[a].Control:=nil;
4895 end;
4896 if (Parent=nil) then begin
4897 // shrink this site
4898 NewBounds:=OnlySiteLeft.BoundsRect;
4899 p:=ClientOrigin;
4900 OffsetRect(NewBounds,p.x,p.y);
4901 BoundsRect:=NewBounds;
4902 end else if DockMaster.IsCustomSite(Parent) then begin
4903 // parent is a custom dock site
4904 // shrink this site and the parent
4905 NewParentBounds:=Parent.BoundsRect;
4906 case Align of
4907 alTop:
4908 begin
4909 inc(NewParentBounds.Top,Height-OnlySiteLeft.Height);
4910 Width:=Parent.ClientWidth;
4911 Height:=OnlySiteLeft.Height;
4912 end;
4913 alBottom:
4914 begin
4915 dec(NewParentBounds.Bottom,Height-OnlySiteLeft.Height);
4916 Width:=Parent.ClientWidth;
4917 Height:=OnlySiteLeft.Height;
4918 end;
4919 alLeft:
4920 begin
4921 inc(NewParentBounds.Left,Width-OnlySiteLeft.Width);
4922 Width:=OnlySiteLeft.Width;
4923 Height:=Parent.ClientHeight;
4924 end;
4925 alRight:
4926 begin
4927 dec(NewParentBounds.Right,Width-OnlySiteLeft.Width);
4928 Width:=OnlySiteLeft.Width;
4929 Height:=Parent.ClientHeight;
4930 end;
4931 end;
4932 Parent.BoundsRect:=NewParentBounds;
4933 end;
4934
4935 // change type
4936 FSiteType:=adhstOneControl;
4937 OnlySiteLeft.Align:=alClient;
4938 Header.Parent:=Self;
4939 if OnlySiteLeft.Minimized then begin
4940 DockMaster.FMapMinimizedControls.Remove(OnlySiteLeft.FMinimizedControl);
4941 OnlySiteLeft.FMinimizedControl.Parent:=OnlySiteLeft;
4942 OnlySiteLeft.FMinimizedControl.Visible:=True;
4943 OnlySiteLeft.FMinimizedControl:=nil;
4944 UpdateHeaderAlign;
4945 end;
4946 UpdateHeaderAlign;
4947
4948 //debugln(['TAnchorDockHostSite.RemoveControlFromLayout.ConvertToOneControlType AFTER CONVERT "',Caption,'" to onecontrol OnlySiteLeft="',OnlySiteLeft.Caption,'"']);
4949 //DebugWriteChildAnchors(GetParentForm(Self),true,true);
4950
4951 DockMaster.NeedSimplify(Self);
4952 finally
4953 EndUpdateLayout;
4954 end;
4955 end;
4956
4957 var
4958 Side: TAnchorKind;
4959 Splitter: TAnchorDockSplitter;
4960 OnlySiteLeft: TAnchorDockHostSite;
4961 Sibling: TControl;
4962 SplitterCount: Integer;
4963 begin
4964 {$IFDEF VerboseAnchorDocking}
4965 debugln(['TAnchorDockHostSite.RemoveControlFromLayout Self="',Caption,'" AControl=',DbgSName(AControl),'="',AControl.Caption,'"']);
4966 {$ENDIF}
4967 if SiteType<>adhstLayout then
4968 RaiseGDBException('TAnchorDockHostSite.RemoveControlFromLayout inconsistency');
4969
4970 if IsOneSiteLayout(OnlySiteLeft) then begin
4971 ClearChildControlAnchorSides(AControl);
4972 ConvertToOneControlType(OnlySiteLeft);
4973 exit;
4974 end;
4975
4976 // remove a splitter and fill the gap
4977 SplitterCount:=0;
4978 for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin
4979 Sibling:=AControl.AnchorSide[OppositeAnchor[Side]].Control;
4980 if Sibling is TAnchorDockSplitter then begin
4981 inc(SplitterCount);
4982 Splitter:=TAnchorDockSplitter(Sibling);
4983 if Splitter.SideAnchoredControlCount(Side)=1 then begin
4984 // Splitter is only used by AControl at Side
4985 RemoveControlBoundSplitter(Splitter,Side);
4986 exit;
4987 end;
4988 end;
4989 end;
4990
4991 if SplitterCount=4 then begin
4992 RemoveSpiralSplitter(AControl);
4993 exit;
4994 end;
4995
4996 ClearChildControlAnchorSides(AControl);
4997 end;
4998
4999 procedure TAnchorDockHostSite.RemoveMinimizedControl;
5000 begin
5001 FMinimizedControl:=nil;
5002 DockMaster.FMapMinimizedControls.Remove(FMinimizedControl);
5003 end;
5004
5005 procedure TAnchorDockHostSite.RemoveSpiralSplitter(AControl: TControl);
5006 { Merge two splitters and delete one of them.
5007 Prefer the pair with shortest distance between.
5008
5009 For example:
5010 3 3
5011 111111111111113 3
5012 2+--------+3 3
5013 2|AControl|3 ---> 111111111
5014 2+--------+3 2
5015 24444444444444 2
5016 2 2
5017 Everything anchored to 4 is now anchored to 1.
5018 And right side of 1 is now anchored to where the right side of 4 was anchored.
5019 }
5020 var
5021 Splitters: array[TAnchorKind] of TAnchorDockSplitter;
5022 Side: TAnchorKind;
5023 Keep: TAnchorKind;
5024 DeleteSplitter: TAnchorDockSplitter;
5025 i: Integer;
5026 Sibling: TControl;
5027 NextSide: TAnchorKind;
5028 NewBounds: TRect;
5029 begin
5030 for Side:=low(TAnchorKind) to high(TAnchorKind) do
5031 Splitters[Side]:=AControl.AnchorSide[Side].Control as TAnchorDockSplitter;
5032 // Prefer the pair with shortest distance between
5033 if (Splitters[akRight].Left-Splitters[akLeft].Left)
5034 <(Splitters[akBottom].Top-Splitters[akTop].Top)
5035 then
5036 Keep:=akLeft
5037 else
5038 Keep:=akTop;
5039 DeleteSplitter:=Splitters[OppositeAnchor[Keep]];
5040 // transfer anchors from the deleting splitter to the kept splitter
5041 for i:=0 to ControlCount-1 do begin
5042 Sibling:=Controls[i];
5043 for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
5044 if Sibling.AnchorSide[Side].Control=DeleteSplitter then
5045 Sibling.AnchorSide[Side].Control:=Splitters[Keep];
5046 end;
5047 end;
5048 // longen kept splitter
5049 NextSide:=ClockwiseAnchor[Keep];
5050 if Splitters[Keep].AnchorSide[NextSide].Control<>Splitters[NextSide] then
5051 NextSide:=OppositeAnchor[NextSide];
5052 Splitters[Keep].AnchorSide[NextSide].Control:=
5053 DeleteSplitter.AnchorSide[NextSide].Control;
5054 case NextSide of
5055 akTop: Splitters[Keep].Top:=DeleteSplitter.Top;
5056 akLeft: Splitters[Keep].Left:=DeleteSplitter.Left;
5057 akRight: Splitters[Keep].Width:=DeleteSplitter.Left+DeleteSplitter.Width-Splitters[Keep].Left;
5058 akBottom: Splitters[Keep].Height:=DeleteSplitter.Top+DeleteSplitter.Height-Splitters[Keep].Top;
5059 end;
5060
5061 // move splitter to the middle
5062 if Keep=akLeft then
5063 Splitters[Keep].Left:=(Splitters[Keep].Left+DeleteSplitter.Left) div 2
5064 else
5065 Splitters[Keep].Top:=(Splitters[Keep].Top+DeleteSplitter.Top) div 2;
5066 // adjust all anchored controls
5067 for i:=0 to ControlCount-1 do begin
5068 Sibling:=Controls[i];
5069 for Side:=low(TAnchorKind) to high(TAnchorKind) do begin
5070 if Sibling.AnchorSide[Side].Control=Splitters[Keep] then begin
5071 NewBounds:=Sibling.BoundsRect;
5072 case Side of
5073 akTop: NewBounds.Top:=Splitters[Keep].Top+Splitters[Keep].Height;
5074 akLeft: NewBounds.Left:=Splitters[Keep].Left+Splitters[Keep].Width;
5075 akRight: NewBounds.Right:=Splitters[Keep].Left;
5076 akBottom: NewBounds.Bottom:=Splitters[Keep].Top;
5077 end;
5078 Sibling.BoundsRect:=NewBounds;
5079 end;
5080 end;
5081 end;
5082
5083 // delete the splitter
5084 DeleteSplitter.Free;
5085
5086 ClearChildControlAnchorSides(AControl);
5087 end;
5088
5089 procedure TAnchorDockHostSite.ClearChildControlAnchorSides(AControl: TControl);
5090 var
5091 Side: TAnchorKind;
5092 Sibling: TControl;
5093 begin
5094 for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin
5095 Sibling:=AControl.AnchorSide[Side].Control;
5096 if (Sibling=nil) then continue;
5097 if (Sibling.Parent=Self) then
5098 AControl.AnchorSide[Side].Control:=nil;
5099 end;
5100 end;
5101
5102 procedure TAnchorDockHostSite.Simplify;
5103 var
5104 AControl: TControl;
5105 begin
5106 if (Pages<>nil) and (Pages.PageCount=1) then
5107 SimplifyPages
5108 else if (SiteType=adhstOneControl) then begin
5109 AControl:=GetOneControl;
5110 {$IFDEF VerboseAnchorDocking}
5111 debugln(['TAnchorDockHostSite.Simplify ',DbgSName(Self),' ',DbgSName(AControl)]);
5112 {$ENDIF}
5113 if AControl is TAnchorDockHostSite then
5114 SimplifyOneControl
5115 else if ((AControl=nil) or (csDestroying in AControl.ComponentState)) then
5116 DockMaster.NeedFree(Self);
5117 end;
5118 end;
5119
5120 procedure TAnchorDockHostSite.SimplifyPages;
5121 var
5122 Page: TAnchorDockPage;
5123 Site: TAnchorDockHostSite;
5124 begin
5125 if Pages=nil then exit;
5126 if DockMaster.IsReleasing(Pages) then exit;
5127 if Pages.PageCount=1 then begin
5128 {$IFDEF VerboseAnchorDockPages}
5129 debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=1']);
5130 {$ENDIF}
5131 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyPages'){$ENDIF};
5132 BeginUpdateLayout;
5133 try
5134 // move the content of the Page to the place where Pages is
5135 Page:=Pages.DockPages[0];
5136 Site:=Page.GetSite;
5137 Site.Parent:=Self;
5138 if Site<>nil then
5139 CopyAnchorBounds(Pages,Site);
5140 if SiteType=adhstPages then
5141 FSiteType:=adhstOneControl;
5142 // free Pages
5143 DockMaster.NeedFree(Pages);
5144 if SiteType=adhstOneControl then
5145 SimplifyOneControl;
5146 finally
5147 EndUpdateLayout;
5148 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyPages'){$ENDIF};
5149 end;
5150 //debugln(['TAnchorDockHostSite.SimplifyPages END Self="',Caption,'"']);
5151 //DebugWriteChildAnchors(GetParentForm(Self),true,true);
5152 end else if Pages.PageCount=0 then begin
5153 //debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=0 Self=',dbgs(Pointer(Self))]);
5154 FSiteType:=adhstNone;
5155 FreePages;
5156 DockMaster.NeedSimplify(Self);
5157 end;
5158 end;
5159
5160 procedure TAnchorDockHostSite.SimplifyOneControl;
5161 var
5162 Site: TAnchorDockHostSite;
5163 i: Integer;
5164 Child, PlaceHolder: TControl;
5165 a: TAnchorKind;
5166 begin
5167 if SiteType<>adhstOneControl then exit;
5168 if not IsOneSiteLayout(Site) then exit;
5169 {$IFDEF VerboseAnchorDocking}
5170 debugln(['TAnchorDockHostSite.SimplifyOneControl Self="',Caption,'" Site="',Site.Caption,'"']);
5171 {$ENDIF}
5172 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyOneControl'){$ENDIF};
5173 BeginUpdateLayout;
5174 try
5175 // move the content of Site up and free Site
5176 // Note: it is not possible to do it the other way round, because moving a
5177 // form to screen changes the z order and focus
5178 FSiteType:=Site.SiteType;
5179
5180 // header
5181 Header.Align:=Site.Header.Align;
5182 Header.Caption:=Site.Header.Caption;
5183 UpdateHeaderShowing;
5184 Caption:=Site.Caption;
5185
5186 Site.BeginUpdateLayout;
5187 // move controls from Site to Self
5188 // when a site is moved to a other parent, we have to insert a place holder
5189 // on old site or the splitters will be removed, see issue #34937
5190 i:=Site.ControlCount-1;
5191 while i>=0 do begin
5192 Child:=Site.Controls[i];
5193 if (Child.Owner<>Site) then begin
5194 if not (Child is TAnchorDockSplitter) then begin
5195 PlaceHolder:=TAnchorDockHostSite.CreateNew(Site);
5196 PlaceHolder.Parent:=Site;
5197 PlaceHolder.Anchors:=Child.Anchors;
5198 for a:=Low(TAnchorKind) to High(TAnchorKind) do
5199 PlaceHolder.AnchorSide[a].Control:=Child.AnchorSide[a].Control;
5200 PlaceHolder.SetBounds(Child.Left, Child.Top, Child.Width, Child.Height);
5201 PlaceHolder.Name:='_'+Child.Name;
5202 PlaceHolder.Visible:=Child.Visible;
5203 end;
5204 Child.Parent:=Self;
5205 if Child=Site.Pages then begin
5206 FPages:=Site.Pages;
5207 Site.FPages:=nil;
5208 end;
5209 if Child.HostDockSite=Site then
5210 Child.HostDockSite:=Self;
5211 for a:=low(TAnchorKind) to high(TAnchorKind) do begin
5212 if Child.AnchorSide[a].Control=Site then
5213 Child.AnchorSide[a].Control:=Self;
5214 end;
5215 end;
5216 i:=Min(i,Site.ControlCount)-1;
5217 end;
5218
5219 for i:=0 to ControlCount-1 do begin
5220 Child:=Controls[i];
5221 PlaceHolder:=TControl(Site.FindComponent('_'+Child.Name));
5222 if not Assigned(PlaceHolder) then continue;
5223 for a:=Low(TAnchorKind) to High(TAnchorKind) do
5224 if PlaceHolder.AnchorSide[a].Control<>Site then
5225 Child.AnchorSide[a].Control:=PlaceHolder.AnchorSide[a].Control;
5226 end;
5227 Site.EndUpdateLayout;
5228
5229 // delete Site
5230 Site.FSiteType:=adhstNone;
5231 DockMaster.NeedFree(Site);
5232 finally
5233 EndUpdateLayout;
5234 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyOneControl'){$ENDIF};
5235 end;
5236
5237 //debugln(['TAnchorDockHostSite.SimplifyOneControl END Self="',Caption,'"']);
5238 //DebugWriteChildAnchors(GetParentForm(Self),true,true);
5239 end;
5240
GetOneControlnull5241 function TAnchorDockHostSite.GetOneControl: TControl;
5242 var
5243 i: Integer;
5244 begin
5245 for i:=0 to ControlCount-1 do begin
5246 Result:=Controls[i];
5247 if Result.Owner<>Self then exit;
5248 end;
5249 result:=FMinimizedControl;
5250 //Result:=nil;
5251 end;
5252
GetSiteCountnull5253 function TAnchorDockHostSite.GetSiteCount: integer;
5254 var
5255 i: Integer;
5256 Child: TControl;
5257 begin
5258 Result:=0;
5259 for i:=0 to ControlCount-1 do begin
5260 Child:=Controls[i];
5261 if not (Child is TAnchorDockHostSite) then continue;
5262 if not Child.IsControlVisible then continue;
5263 inc(Result);
5264 end;
5265 end;
5266
IsOneSiteLayoutnull5267 function TAnchorDockHostSite.IsOneSiteLayout(out Site: TAnchorDockHostSite
5268 ): boolean;
5269 var
5270 i: Integer;
5271 Child: TControl;
5272 begin
5273 Site:=nil;
5274 for i:=0 to ControlCount-1 do begin
5275 Child:=Controls[i];
5276 if not (Child is TAnchorDockHostSite) then continue;
5277 if not Child.IsControlVisible then continue;
5278 if Site<>nil then exit(false);
5279 Site:=TAnchorDockHostSite(Child);
5280 end;
5281 Result:=Site<>nil;
5282 end;
5283
IsTwoSiteLayoutnull5284 function TAnchorDockHostSite.IsTwoSiteLayout(out Site1,
5285 Site2: TAnchorDockHostSite): boolean;
5286 var
5287 i: Integer;
5288 Child: TControl;
5289 begin
5290 Site1:=nil;
5291 Site2:=nil;
5292 for i:=0 to ControlCount-1 do begin
5293 Child:=Controls[i];
5294 if not (Child is TAnchorDockHostSite) then continue;
5295 if not Child.IsControlVisible then continue;
5296 if Site1=nil then
5297 Site1:=TAnchorDockHostSite(Child)
5298 else if Site2=nil then
5299 Site2:=TAnchorDockHostSite(Child)
5300 else
5301 exit(false);
5302 end;
5303 Result:=Site2<>nil;
5304 end;
5305
GetUniqueSplitterNamenull5306 function TAnchorDockHostSite.GetUniqueSplitterName: string;
5307 var
5308 i: Integer;
5309 begin
5310 i:=0;
5311 repeat
5312 inc(i);
5313 Result:=AnchorDockSplitterName+IntToStr(i);
5314 until FindComponent(Result)=nil;
5315 end;
5316
MakeSitenull5317 function TAnchorDockHostSite.MakeSite(AControl: TControl): TAnchorDockHostSite;
5318 begin
5319 if AControl is TAnchorDockHostSite then
5320 Result:=TAnchorDockHostSite(AControl)
5321 else begin
5322 Result:=DockMaster.CreateSite;
5323 try
5324 AControl.ManualDock(Result,nil,alClient);
5325 finally
5326 Result.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF};
5327 end;
5328 end;
5329 end;
5330
5331 procedure TAnchorDockHostSite.MoveAllControls(dx, dy: integer);
5332 // move all children, except the sides that are anchored to parent left,top
5333 var
5334 i: Integer;
5335 Child: TControl;
5336 NewBounds: TRect;
5337 begin
5338 for i:=0 to ControlCount-1 do begin
5339 Child:=Controls[i];
5340 NewBounds:=Child.BoundsRect;
5341 OffsetRect(NewBounds,dx,dy);
5342 if Child.AnchorSideLeft.Control=Self then
5343 NewBounds.Left:=0;
5344 if Child.AnchorSideTop.Control=Self then
5345 NewBounds.Top:=0;
5346 Child.BoundsRect:=NewBounds;
5347 end;
5348 end;
5349
5350 procedure TAnchorDockHostSite.AlignControls(AControl: TControl; var ARect: TRect);
5351 var
5352 i: Integer;
5353 Child: TControl;
5354 Splitter: TAnchorDockSplitter;
5355 begin
5356 inherited AlignControls(AControl, ARect);
5357 if csDestroying in ComponentState then exit;
5358
5359 if DockMaster.ScaleOnResize and (not UpdatingLayout)
5360 and (not DockMaster.Restoring) then begin
5361 // scale splitters
5362 for i:=0 to ControlCount-1 do begin
5363 Child:=Controls[i];
5364 if not Child.IsControlVisible then continue;
5365 if Child is TAnchorDockSplitter then begin
5366 Splitter:=TAnchorDockSplitter(Child);
5367 //debugln(['TAnchorDockHostSite.AlignControls ',Caption,' ',DbgSName(Splitter),' OldBounds=',dbgs(Splitter.BoundsRect),' BaseBounds=',dbgs(Splitter.DockBounds),' BaseParentSize=',dbgs(Splitter.DockParentClientSize),' ParentSize=',ClientWidth,'x',ClientHeight]);
5368 Splitter.SetBoundsPercentually;
5369 //debugln(['TAnchorDockHostSite.AlignControls ',Caption,' ',DbgSName(Child),' NewBounds=',dbgs(Child.BoundsRect)]);
5370 end;
5371 end;
5372 end;
5373 end;
5374
CheckIfOneControlHiddennull5375 function TAnchorDockHostSite.CheckIfOneControlHidden: boolean;
5376 var
5377 Child: TControl;
5378 begin
5379 Result:=false;
5380 //debugln(['TAnchorDockHostSite.CheckIfOneControlHidden ',DbgSName(Self),' UpdatingLayout=',UpdatingLayout,' Visible=',Visible,' Parent=',DbgSName(Parent),' csDestroying=',csDestroying in ComponentState,' SiteType=',dbgs(SiteType)]);
5381 if UpdatingLayout or (not IsControlVisible)
5382 or (csDestroying in ComponentState)
5383 or (SiteType<>adhstOneControl)
5384 then
5385 exit;
5386 Child:=GetOneControl;
5387 if (Child=nil) then exit;
5388 if Child.IsControlVisible then exit;
5389
5390 // docked child was hidden/closed
5391 Result:=true;
5392 // => undock
5393 BeginUpdateLayout;
5394 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CheckIfOneControlHidden'){$ENDIF};
5395 try
5396 {$IFDEF VerboseAnchorDocking}
5397 debugln(['TAnchorDockHostSite.CheckIfOneControlHidden ',DbgSName(Self),' UpdatingLayout=',UpdatingLayout,' Visible=',Visible,' Parent=',DbgSName(Parent),' csDestroying=',csDestroying in ComponentState,' SiteType=',dbgs(SiteType),' Child=',DbgSName(Child),' Child.csDestroying=',csDestroying in Child.ComponentState]);
5398 {$ENDIF}
5399 Visible:=false;
5400 Parent:=nil;
5401 finally
5402 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CheckIfOneControlHidden'){$ENDIF};
5403 end;
5404 EndUpdateLayout;
5405 if (not (Child is TCustomForm)) or (csDestroying in Child.ComponentState) then
5406 Release;
5407 end;
5408
5409 procedure TAnchorDockHostSite.DoDock(NewDockSite: TWinControl; var ARect: TRect);
5410 begin
5411 inherited DoDock(NewDockSite, ARect);
5412 if DockMaster <> nil then
5413 DockMaster.SimplifyPendingLayouts;
5414 end;
5415
5416 procedure TAnchorDockHostSite.SetParent(NewParent: TWinControl);
5417 var
5418 OldCaption: string;
5419 OldParent: TWinControl;
5420 begin
5421 OldParent:=Parent;
5422 if NewParent=OldParent then exit;
5423 inherited SetParent(NewParent);
5424 OldCaption:=Caption;
5425 UpdateDockCaption;
5426 if OldCaption<>Caption then begin
5427 // UpdateDockCaption has not updated parents => do it now
5428 if Parent is TAnchorDockHostSite then
5429 TAnchorDockHostSite(Parent).UpdateDockCaption;
5430 if Parent is TAnchorDockPage then
5431 TAnchorDockPage(Parent).UpdateDockCaption;
5432 end;
5433 UpdateHeaderShowing;
5434
5435 if (BoundSplitter<>nil) and (BoundSplitter.Parent<>Parent) then begin
5436 //debugln(['TAnchorDockHostSite.SetParent freeing splitter: ',DbgSName(BoundSplitter)]);
5437 FreeAndNil(FBoundSplitter);
5438 end;
5439 if Parent=nil then
5440 BorderStyle:=bsSizeable
5441 else
5442 BorderStyle:=bsNone;
5443 end;
5444
HeaderNeedsShowingnull5445 function TAnchorDockHostSite.HeaderNeedsShowing: boolean;
5446 begin
5447 Result:=(SiteType<>adhstLayout)
5448 and (not (Parent is TAnchorDockPage))
5449 and Assigned(DockMaster) and DockMaster.ShowHeader;
5450 end;
5451
5452 procedure TAnchorDockHostSite.DoClose(var CloseAction: TCloseAction);
5453 var
5454 AControl: TControl;
5455 AForm: TCustomForm absolute AControl;
5456 begin
5457 if (GetSiteCount=0) and not DockMaster.FAllClosing then
5458 begin
5459 AControl:=GetOneControl;
5460 if (AControl is TCustomForm) then
5461 begin
5462 AForm.Close;
5463 if csDestroying in AForm.ComponentState then
5464 CloseAction:=caFree
5465 else if AForm.Visible then
5466 CloseAction:=caNone;
5467 end;
5468 end;
5469 inherited DoClose(CloseAction);
5470 end;
5471
CanUndocknull5472 function TAnchorDockHostSite.CanUndock: boolean;
5473 begin
5474 Result:=Parent<>nil;
5475 end;
5476
5477 procedure TAnchorDockHostSite.Undock;
5478 var
5479 p: TPoint;
5480 begin
5481 if Parent=nil then exit;
5482 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Undock'){$ENDIF};
5483 try
5484 p := Point(0,0);
5485 p := ClientToScreen(p);
5486 Parent:=nil;
5487 SetBounds(p.x,p.y,Width,Height);
5488 finally
5489 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Undock'){$ENDIF};
5490 end;
5491 end;
5492
CanMergenull5493 function TAnchorDockHostSite.CanMerge: boolean;
5494 begin
5495 Result:=(SiteType=adhstLayout)
5496 and (Parent is TAnchorDockHostSite)
5497 and (TAnchorDockHostSite(Parent).SiteType=adhstLayout);
5498 end;
5499
5500 procedure TAnchorDockHostSite.Merge;
5501 { Move all child controls to parent and delete this site
5502 }
5503 var
5504 ParentSite: TAnchorDockHostSite;
5505 i: Integer;
5506 Child: TControl;
5507 Side: TAnchorKind;
5508 begin
5509 ParentSite:=Parent as TAnchorDockHostSite;
5510 if (SiteType<>adhstLayout) or (ParentSite.SiteType<>adhstLayout) then
5511 RaiseGDBException('');
5512 ParentSite.BeginUpdateLayout;
5513 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Merge'){$ENDIF};
5514 try
5515 for i := ControlCount - 1 downto 0 do begin
5516 Child := Controls[i];
5517 if Child.Owner <> Self then
5518 begin
5519 Child.Parent := ParentSite;
5520 Child.SetBounds(Child.Left + Left, Child.Top + Top, Child.Width, Child.Height);
5521 for Side := Low(TAnchorKind) to High(TAnchorKind) do
5522 if Child.AnchorSide[Side].Control = Self then
5523 Child.AnchorSide[Side].Assign(AnchorSide[Side]);
5524 end;
5525 end;
5526 Parent:=nil;
5527 DockMaster.NeedFree(Self);
5528 finally
5529 ParentSite.EndUpdateLayout;
5530 // not needed, because this site is freed: EnableAutoSizing;
5531 end;
5532 end;
5533
EnlargeSidenull5534 function TAnchorDockHostSite.EnlargeSide(Side: TAnchorKind;
5535 OnlyCheckIfPossible: boolean): boolean;
5536 {
5537 Shrink one splitter, enlarge the other splitter.
5538
5539 |#| |# |#| |#
5540 |#| Control |# |#| |#
5541 --+#+---------+# --> --+#| Control |#
5542 ===============# ===#| |#
5543 --------------+# --+#| |#
5544 A |# A|#| |#
5545 --------------+# --+#+---------+#
5546 ================== ===================
5547
5548 Move one neighbor splitter, enlarge Control, resize one splitter, rotate the other splitter.
5549
5550 |#| |#| |#| |#|
5551 |#| Control |#| |#| |#|
5552 --+#+---------+#+-- --> --+#| Control |#+--
5553 =================== ===#| |#===
5554 --------+#+-------- --+#| |#+--
5555 |#| B |#| |#|B
5556 |#+-------- |#| |#+--
5557 A |#========= A|#| |#===
5558 |#+-------- |#| |#+--
5559 |#| C |#| |#|C
5560 --------+#+-------- --+#+---------+#+--
5561 =================== ===================
5562 }
5563 begin
5564 Result:=true;
5565 if EnlargeSideResizeTwoSplitters(Side,ClockwiseAnchor[Side],
5566 OnlyCheckIfPossible) then exit;
5567 if EnlargeSideResizeTwoSplitters(Side,OppositeAnchor[ClockwiseAnchor[Side]],
5568 OnlyCheckIfPossible) then exit;
5569 if EnlargeSideRotateSplitter(Side,OnlyCheckIfPossible) then exit;
5570 Result:=false;
5571 end;
5572
EnlargeSideResizeTwoSplittersnull5573 function TAnchorDockHostSite.EnlargeSideResizeTwoSplitters(ShrinkSplitterSide,
5574 EnlargeSpitterSide: TAnchorKind; OnlyCheckIfPossible: boolean): boolean;
5575 { Shrink one neighbor control, enlarge Self. Two splitters are resized.
5576
5577 For example: ShrinkSplitterSide=akBottom, EnlargeSpitterSide=akLeft
5578
5579 |#| |# |#| |#
5580 |#| Self |# |#| |#
5581 --+#+--------+# --> --+#| Self |#
5582 ==============# ===#| |#
5583 -------------+# --+#| |#
5584 A |# A|#| |#
5585 -------------+# --+#+--------+#
5586 ================= ==================
5587
5588
5589
5590 }
5591 var
5592 ParentSite: TAnchorDockHostSite;
5593 ShrinkSplitter: TAnchorDockSplitter;
5594 EnlargeSplitter: TAnchorDockSplitter;
5595 KeptSide: TAnchorKind;
5596 KeptAnchorControl: TControl;
5597 Sibling: TControl;
5598 ShrinkControl: TControl;
5599 i: Integer;
5600 begin
5601 Result:=false;
5602 if not (Parent is TAnchorDockHostSite) then exit;
5603 ParentSite:=TAnchorDockHostSite(Parent);
5604 if not OnlyCheckIfPossible then begin
5605 ParentSite.BeginUpdateLayout;
5606 ParentSite.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideResizeTwoSplitters'){$ENDIF};
5607 end;
5608 try
5609 // check ShrinkSplitter
5610 ShrinkSplitter:=TAnchorDockSplitter(AnchorSide[ShrinkSplitterSide].Control);
5611 if not (ShrinkSplitter is TAnchorDockSplitter) then exit;
5612 // check if EnlargeSpitterSide is a neighbor ShrinkSplitterSide
5613 if (EnlargeSpitterSide<>ClockwiseAnchor[ShrinkSplitterSide])
5614 and (EnlargeSpitterSide<>OppositeAnchor[ClockwiseAnchor[ShrinkSplitterSide]]) then
5615 exit;
5616 // check EnlargeSpitter
5617 EnlargeSplitter:=TAnchorDockSplitter(AnchorSide[EnlargeSpitterSide].Control);
5618 if not (EnlargeSplitter is TAnchorDockSplitter) then exit;
5619 // check if KeptSide is anchored to a splitter or parent
5620 KeptSide:=OppositeAnchor[EnlargeSpitterSide];
5621 KeptAnchorControl:=AnchorSide[KeptSide].Control;
5622 if not ((KeptAnchorControl=ParentSite)
5623 or (KeptAnchorControl is TAnchorDockSplitter)) then exit;
5624 // check if ShrinkSplitter is anchored/stops at KeptAnchorControl
5625 if ShrinkSplitter.AnchorSide[KeptSide].Control<>KeptAnchorControl then exit;
5626
5627 // check if there is a control to shrink
5628 ShrinkControl:=nil;
5629 for i:=0 to ShrinkSplitter.AnchoredControlCount-1 do begin
5630 Sibling:=ShrinkSplitter.AnchoredControls[i];
5631 if (Sibling.AnchorSide[OppositeAnchor[ShrinkSplitterSide]].Control=ShrinkSplitter)
5632 and (Sibling.AnchorSide[KeptSide].Control=KeptAnchorControl) then begin
5633 ShrinkControl:=Sibling;
5634 break;
5635 end;
5636 end;
5637 if ShrinkControl=nil then exit;
5638
5639 if OnlyCheckIfPossible then begin
5640 // check if ShrinkControl is large enough for shrinking
5641 case EnlargeSpitterSide of
5642 akTop: if ShrinkControl.Top>=EnlargeSplitter.Top then exit;
5643 akLeft: if ShrinkControl.Left>=EnlargeSplitter.Left then exit;
5644 akRight: if ShrinkControl.Left+ShrinkControl.Width
5645 <=EnlargeSplitter.Left+EnlargeSplitter.Width then exit;
5646 akBottom: if ShrinkControl.Top+ShrinkControl.Height
5647 <=EnlargeSplitter.Top+EnlargeSplitter.Height then exit;
5648 end;
5649 end else begin
5650 // do it
5651 // enlarge the EnlargeSplitter and Self
5652 AnchorAndChangeBounds(EnlargeSplitter,ShrinkSplitterSide,
5653 ShrinkControl.AnchorSide[ShrinkSplitterSide].Control);
5654 AnchorAndChangeBounds(Self,ShrinkSplitterSide,
5655 ShrinkControl.AnchorSide[ShrinkSplitterSide].Control);
5656 // shrink the ShrinkSplitter and ShrinkControl
5657 AnchorAndChangeBounds(ShrinkSplitter,KeptSide,EnlargeSplitter);
5658 AnchorAndChangeBounds(ShrinkControl,KeptSide,EnlargeSplitter);
5659 end;
5660
5661 finally
5662 if not OnlyCheckIfPossible then begin
5663 ParentSite.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideResizeTwoSplitters'){$ENDIF};
5664 ParentSite.EndUpdateLayout;
5665 end;
5666 end;
5667 Result:=true;
5668 end;
5669
EnlargeSideRotateSplitternull5670 function TAnchorDockHostSite.EnlargeSideRotateSplitter(Side: TAnchorKind;
5671 OnlyCheckIfPossible: boolean): boolean;
5672 { Shrink splitter at Side, enlarge both neighbor splitters,
5673 rotate the splitter behind, enlarge Control,
5674 shrink controls at rotate splitter
5675
5676 |#| |#| |#| |#|
5677 |#| Control |#| |#| |#|
5678 --+#+---------+#+-- --> --+#| Control |#+--
5679 =================== ===#| |#===
5680 --------+#+-------- --+#| |#+--
5681 |#| B |#| |#|B
5682 |#+-------- |#| |#+--
5683 A |#========= A|#| |#===
5684 |#+-------- |#| |#+--
5685 |#| C |#| |#|C
5686 --------+#+-------- --+#+---------+#+--
5687 =================== ===================
5688 }
5689 var
5690 Splitter: TAnchorDockSplitter;
5691 CWSide: TAnchorKind;
5692 CWSplitter: TAnchorDockSplitter;
5693 CCWSide: TAnchorKind;
5694 i: Integer;
5695 Sibling: TControl;
5696 BehindSide: TAnchorKind;
5697 RotateSplitter: TAnchorDockSplitter;
5698 CCWSplitter: TAnchorDockSplitter;
5699 begin
5700 Result:=false;
5701 // check if there is a splitter at Side
5702 Splitter:=TAnchorDockSplitter(AnchorSide[Side].Control);
5703 if not (Splitter is TAnchorDockSplitter) then exit;
5704 // check if there is a splitter at clockwise Side
5705 CWSide:=ClockwiseAnchor[Side];
5706 CWSplitter:=TAnchorDockSplitter(AnchorSide[CWSide].Control);
5707 if not (CWSplitter is TAnchorDockSplitter) then exit;
5708 // check if there is a splitter at counter clockwise Side
5709 CCWSide:=OppositeAnchor[CWSide];
5710 CCWSplitter:=TAnchorDockSplitter(AnchorSide[CCWSide].Control);
5711 if not (CCWSplitter is TAnchorDockSplitter) then exit;
5712 // check if neighbor splitters end at Splitter
5713 if CWSplitter.AnchorSide[Side].Control<>Splitter then exit;
5714 if CCWSplitter.AnchorSide[Side].Control<>Splitter then exit;
5715 // find the rotate splitter behind Splitter
5716 BehindSide:=OppositeAnchor[Side];
5717 RotateSplitter:=nil;
5718 for i:=0 to Splitter.AnchoredControlCount-1 do begin
5719 Sibling:=Splitter.AnchoredControls[i];
5720 if Sibling.AnchorSide[BehindSide].Control<>Splitter then continue;
5721 if not (Sibling is TAnchorDockSplitter) then continue;
5722 if Side in [akLeft,akRight] then begin
5723 if Sibling.Top<Top-DockMaster.SplitterWidth then continue;
5724 if Sibling.Top>Top+Height then continue;
5725 end else begin
5726 if Sibling.Left<Left-DockMaster.SplitterWidth then continue;
5727 if Sibling.Left>Left+Width then continue;
5728 end;
5729 if RotateSplitter=nil then
5730 RotateSplitter:=TAnchorDockSplitter(Sibling)
5731 else
5732 // there are multiple splitters behind
5733 exit;
5734 end;
5735 if RotateSplitter=nil then exit;
5736 // check that all siblings at RotateSplitter are large enough to shrink
5737 for i:=0 to RotateSplitter.AnchoredControlCount-1 do begin
5738 Sibling:=RotateSplitter.AnchoredControls[i];
5739 if Side in [akLeft,akRight] then begin
5740 if (Sibling.Top>Top-DockMaster.SplitterWidth)
5741 and (Sibling.Top+Sibling.Height<Top+Height+DockMaster.SplitterWidth) then
5742 exit;
5743 end else begin
5744 if (Sibling.Left>Left-DockMaster.SplitterWidth)
5745 and (Sibling.Left+Sibling.Width<Left+Width+DockMaster.SplitterWidth) then
5746 exit;
5747 end;
5748 end;
5749 Result:=true;
5750 if OnlyCheckIfPossible then exit;
5751
5752 //debugln(['TAnchorDockHostSite.EnlargeSideRotateSplitter BEFORE Self=',DbgSName(Self),'=',dbgs(BoundsRect),' Side=',dbgs(Side),' CWSide=',dbgs(CWSide),' CWSplitter=',CWSplitter.Name,'=',dbgs(CWSplitter.BoundsRect),' CCWSide=',dbgs(CCWSide),' CCWSplitter=',CCWSplitter.Name,'=',dbgs(CCWSplitter.BoundsRect),' Behind=',dbgs(BehindSide),'=',RotateSplitter.Name,'=',dbgs(RotateSplitter.BoundsRect)]);
5753
5754 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideRotateSplitter'){$ENDIF};
5755 try
5756 // enlarge the two neighbor splitters
5757 AnchorAndChangeBounds(CWSplitter,Side,RotateSplitter.AnchorSide[Side].Control);
5758 AnchorAndChangeBounds(CCWSplitter,Side,RotateSplitter.AnchorSide[Side].Control);
5759 // enlarge control
5760 AnchorAndChangeBounds(Self,Side,RotateSplitter.AnchorSide[Side].Control);
5761 // shrink the neighbors and anchor them to the enlarge splitters
5762 for i:=0 to Parent.ControlCount-1 do begin
5763 Sibling:=Parent.Controls[i];
5764 if Sibling.AnchorSide[CWSide].Control=RotateSplitter then
5765 AnchorAndChangeBounds(Sibling,CWSide,CCWSplitter)
5766 else if Sibling.AnchorSide[CCWSide].Control=RotateSplitter then
5767 AnchorAndChangeBounds(Sibling,CCWSide,CWSplitter);
5768 end;
5769 // rotate the RotateSplitter
5770 RotateSplitter.AnchorSide[Side].Control:=nil;
5771 RotateSplitter.AnchorSide[BehindSide].Control:=nil;
5772 RotateSplitter.ResizeAnchor:=Side;
5773 AnchorAndChangeBounds(RotateSplitter,CCWSide,Splitter.AnchorSide[CCWSide].Control);
5774 AnchorAndChangeBounds(RotateSplitter,CWSide,CCWSplitter);
5775 if Side in [akLeft,akRight] then begin
5776 RotateSplitter.Left:=Splitter.Left;
5777 RotateSplitter.Width:=DockMaster.SplitterWidth;
5778 end else begin
5779 RotateSplitter.Top:=Splitter.Top;
5780 RotateSplitter.Height:=DockMaster.SplitterWidth;
5781 end;
5782 // shrink Splitter
5783 AnchorAndChangeBounds(Splitter,CCWSide,CWSplitter);
5784 // anchor some siblings of Splitter to RotateSplitter
5785 for i:=0 to Parent.ControlCount-1 do begin
5786 Sibling:=Parent.Controls[i];
5787 case Side of
5788 akLeft: if Sibling.Top<Top then continue;
5789 akRight: if Sibling.Top>Top then continue;
5790 akTop: if Sibling.Left>Left then continue;
5791 akBottom: if Sibling.Left<Left then continue;
5792 end;
5793 if Sibling.AnchorSide[BehindSide].Control=Splitter then
5794 Sibling.AnchorSide[BehindSide].Control:=RotateSplitter
5795 else if Sibling.AnchorSide[Side].Control=Splitter then
5796 Sibling.AnchorSide[Side].Control:=RotateSplitter;
5797 end;
5798 //debugln(['TAnchorDockHostSite.EnlargeSideRotateSplitter AFTER Self=',DbgSName(Self),'=',dbgs(BoundsRect),' Side=',dbgs(Side),' CWSide=',dbgs(CWSide),' CWSplitter=',CWSplitter.Name,'=',dbgs(CWSplitter.BoundsRect),' CCWSide=',dbgs(CCWSide),' CCWSplitter=',CCWSplitter.Name,'=',dbgs(CCWSplitter.BoundsRect),' Behind=',dbgs(BehindSide),'=',RotateSplitter.Name,'=',dbgs(RotateSplitter.BoundsRect)]);
5799 finally
5800 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideRotateSplitter'){$ENDIF};
5801 end;
5802 end;
5803
5804 procedure TAnchorDockHostSite.CreateBoundSplitter(Disabled: boolean);
5805 begin
5806 if BoundSplitter<>nil then exit;
5807 FBoundSplitter:=DockMaster.CreateSplitter;
5808 BoundSplitter.FreeNotification(Self);
5809 BoundSplitter.Align:=Align;
5810 BoundSplitter.Parent:=Parent;
5811 if Disabled then
5812 begin
5813 BoundSplitter.Width:=0;
5814 BoundSplitter.Height:=0;
5815 BoundSplitter.Visible:=false;
5816 end;
5817 end;
5818
5819 procedure TAnchorDockHostSite.PositionBoundSplitter;
5820 begin
5821 case Align of
5822 alTop: BoundSplitter.SetBounds(0,Height,Parent.ClientWidth,BoundSplitter.Height);
5823 alBottom: BoundSplitter.SetBounds(0,Parent.ClientHeight-Height-BoundSplitter.Height,
5824 Parent.ClientWidth,BoundSplitter.Height);
5825 alLeft: BoundSplitter.SetBounds(Width,0,BoundSplitter.Width,Parent.ClientHeight);
5826 alRight: BoundSplitter.SetBounds(Parent.ClientWidth-Width-BoundSplitter.Width,0
5827 ,BoundSplitter.Width,Parent.ClientHeight);
5828 end;
5829 end;
5830
CloseQuerynull5831 function TAnchorDockHostSite.CloseQuery: boolean;
5832
5833 function Check(AControl: TWinControl): boolean;
5834 var
5835 i: Integer;
5836 Child: TControl;
5837 begin
5838 for i:=0 to AControl.ControlCount-1 do begin
5839 Child:=AControl.Controls[i];
5840 if Child is TWinControl then begin
5841 if Child is TCustomForm then begin
5842 if not TCustomForm(Child).CloseQuery then exit(false);
5843 end else begin
5844 if not Check(TWinControl(Child)) then exit(false);
5845 end;
5846 end;
5847 end;
5848 Result:=true;
5849 end;
5850
5851 begin
5852 Result:=Check(Self);
5853 end;
5854
5855 function CheckOposite(Side:TAnchorKind;AControl: TControl;out Splitter: TAnchorDockSplitter; out SplitterAnchorKind:TAnchorKind):boolean;
5856 begin
5857 result:=GetDockSplitter(AControl,Side,Splitter);
5858 if result then begin
5859 if CountAnchoredControls(Splitter,OppositeAnchor[Side])=1 then begin
5860 SplitterAnchorKind:=Side;
5861 exit;
5862 end;
5863 end;
5864 result:=false
5865 end;
5866
5867 function FindNearestSpliter(AControl: TControl;out Splitter: TAnchorDockSplitter;out SplitterAnchorKind:TAnchorKind):boolean;
5868 begin
5869 result:=CheckOposite(akTop,AControl,Splitter,SplitterAnchorKind);
5870 if result then exit;
5871 result:=CheckOposite(akRight,AControl,Splitter,SplitterAnchorKind);
5872 if result then exit;
5873 result:=CheckOposite(akBottom,AControl,Splitter,SplitterAnchorKind);
5874 if result then exit;
5875 result:=CheckOposite(akLeft,AControl,Splitter,SplitterAnchorKind);
5876 end;
5877
CanBeMinimizednull5878 function TAnchorDockHostSite.CanBeMinimized(out Splitter: TAnchorDockSplitter;
5879 out SplitterAnchorKind:TAnchorKind):boolean;
5880 var
5881 //AControl: TControl;
5882 OpositeDockHostSite:TAnchorDockHostSite;
5883 OpositeSplitter: TAnchorDockSplitter;
5884 begin
5885 result:=false;
5886 if FindNearestSpliter(self,Splitter,SplitterAnchorKind) then begin
5887 OpositeDockHostSite:=CountAndReturnOnlyOneMinimizedAnchoredControls(Splitter,SplitterAnchorKind);
5888 if (Splitter.Enabled and (OpositeDockHostSite=nil)) then begin
5889 result:=true;
5890 if CheckOposite(OppositeAnchorKind[SplitterAnchorKind],self,OpositeSplitter,SplitterAnchorKind) then
5891 if Assigned(OpositeSplitter) then
5892 if not OpositeSplitter.Enabled then
5893 result:=false;
5894 end;
5895 end;
5896 end;
5897
5898 procedure TAnchorDockHostSite.MinimizeSite;
5899 begin
5900 //Application.QueueAsyncCall(@AsyncMinimizeSite,0);
5901 AsyncMinimizeSite(0);
5902 end;
5903
5904 procedure TAnchorDockHostSite.AsyncMinimizeSite(Data: PtrInt);
5905 var
5906 AControl: TControl;
5907 Splitter: TAnchorDockSplitter;
5908 SplitterAnchorKind:TAnchorKind;
5909 MaxSize:integer;
5910 begin
5911 {$IFDEF VerboseAnchorDocking}
5912 debugln(['TAnchorDockHostSite.MinimizeSite ',DbgSName(Self),' SiteType=',dbgs(SiteType)]);
5913 {$ENDIF}
5914 if Minimized then
5915 AControl:=FMinimizedControl
5916 else
5917 AControl:=GetOneControl;
5918 if CanBeMinimized(Splitter,SplitterAnchorKind) or Minimized then begin
5919 if not Minimized then begin
5920 FMinimizedControl:=AControl;
5921 AControl.Visible:=False;
5922 AControl.Parent:=nil;
5923 DockMaster.FMapMinimizedControls.Add(AControl,Self);
5924 end else begin
5925 MaxSize:=ReturnAnchoredControlsSize(Splitter,SplitterAnchorKind);
5926 case SplitterAnchorKind of
5927 akTop:
5928 if AControl.Height>=MaxSize+Height then
5929 Splitter.FPercentPosition:=1-(MaxSize+Height)/(Splitter.Parent.ClientHeight*2);
5930 akBottom:
5931 if AControl.Height>=MaxSize+Height then
5932 Splitter.FPercentPosition:=(MaxSize+Height)/(Splitter.Parent.ClientHeight*2);
5933 akLeft:
5934 if AControl.Width>=MaxSize+Width then
5935 Splitter.FPercentPosition:=1-(MaxSize+Width)/(Splitter.Parent.ClientWidth*2);
5936 akRight:
5937 if AControl.Width>=MaxSize+Width then
5938 Splitter.FPercentPosition:=(MaxSize+Width)/(Splitter.Parent.ClientWidth*2);
5939 end;
5940 AControl.Parent:=self;
5941 AControl.Visible:=True;
5942 FMinimizedControl:=nil;
5943 DockMaster.FMapMinimizedControls.Remove(AControl);
5944 end;
5945 Splitter.Enabled:=AControl.Visible;
5946 UpdateHeaderAlign;
5947 dockmaster.UpdateHeaders;
5948 dockmaster.InvalidateHeaders;
5949 Splitter.SetBoundsPercentually;
5950 end;
5951 end;
5952
5953 procedure TAnchorDockHostSite.ShowMinimizedControl;
5954 var
5955 Splitter: TAnchorDockSplitter;
5956 SplitterAnchorKind:TAnchorKind;
5957 SpliterRect,OverlappingFormRect:TRect;
5958 begin
5959 if FindNearestSpliter(self,Splitter,SplitterAnchorKind) then begin
5960 SpliterRect:=Splitter.GetSpliterBoundsWithUnminimizedDockSites;
5961 OverlappingFormRect:=BoundsRect;
5962 case SplitterAnchorKind of
5963 akTop:OverlappingFormRect.Top:=SpliterRect.Bottom;
5964 akLeft:OverlappingFormRect.Left:=SpliterRect.Right;
5965 akRight:OverlappingFormRect.Right:=SpliterRect.Left;
5966 akBottom:OverlappingFormRect.Bottom:=SpliterRect.Top;
5967 end;
5968 DockMaster.FOverlappingForm:=TAnchorDockOverlappingForm.CreateNew(self);
5969 DockMaster.FOverlappingForm.BoundsRect:=OverlappingFormRect;
5970 DockMaster.FOverlappingForm.Parent:=GetParentFormOrDockPanel(self,false);
5971 DockMaster.FOverlappingForm.AnchorDockHostSite:=self;
5972 header.Parent:=DockMaster.FOverlappingForm;
5973 FMinimizedControl.Parent:=DockMaster.FOverlappingForm.Panel;
5974 FMinimizedControl.Show;
5975 DockMaster.ShowOverlappingForm;
5976 end;
5977 end;
5978
5979 procedure TAnchorDockHostSite.HideMinimizedControl;
5980 begin
5981 FMinimizedControl.Hide;
5982 header.Parent:=self;
5983 header.UpdateHeaderControls;
5984 FMinimizedControl.Parent:=nil;
5985 FreeAndNil(DockMaster.FOverlappingForm);
5986 end;
5987
CloseSitenull5988 function TAnchorDockHostSite.CloseSite: boolean;
5989 var
5990 AControl: TControl;
5991 AForm: TCustomForm;
5992 IsMainForm: Boolean;
5993 CloseAction: TCloseAction;
5994 NeedEnableAutoSizing: Boolean;
5995 i: Integer;
5996 begin
5997 Result:=CloseQuery;
5998 if not Result then exit;
5999
6000 {$IFDEF VerboseAnchorDocking}
6001 debugln(['TAnchorDockHostSite.CloseSite ',DbgSName(Self),' SiteType=',dbgs(SiteType)]);
6002 {$ENDIF}
6003 case SiteType of
6004 adhstNone:
6005 begin
6006 Release;
6007 exit;
6008 end;
6009 adhstOneControl:
6010 begin
6011 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF};
6012 NeedEnableAutoSizing:=true;
6013 try
6014 AControl:=GetOneControl;
6015 if AControl is TCustomForm then begin
6016 AForm:=TCustomForm(AControl);
6017 IsMainForm := (Application.MainForm = AForm)
6018 or (AForm.IsParentOf(Application.MainForm));
6019 if IsMainForm then
6020 CloseAction := caFree
6021 else
6022 CloseAction := caHide;
6023 // ToDo: TCustomForm(AControl).DoClose(CloseAction);
6024 case CloseAction of
6025 caHide: Hide;
6026 caMinimize: WindowState := wsMinimized;
6027 caFree:
6028 begin
6029 // if form is MainForm, then terminate the application
6030 // the owner of the MainForm is the application,
6031 // so the Application will take care of free-ing the form
6032 // and Release is not necessary
6033 if IsMainForm then
6034 Application.Terminate
6035 else begin
6036 NeedEnableAutoSizing:=false;
6037 Release;
6038 AForm.Release;
6039 exit;
6040 end;
6041 end;
6042 end;
6043 end else begin
6044 AControl.Visible:=false;
6045 NeedEnableAutoSizing:=false;
6046 Release;
6047 exit;
6048 end;
6049 Visible:=false;
6050 Parent:=nil;
6051 finally
6052 if NeedEnableAutoSizing then
6053 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF};
6054 end;
6055 end;
6056 adhstPages:
6057 begin
6058 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF};
6059 NeedEnableAutoSizing:=true;
6060 try
6061 if Minimized then
6062 begin
6063 // close all pages
6064 for i:=Pages.PageCount-1 downto 0 do begin
6065 AControl:=Pages.DockPages[Pages.PageCount-1].GetSite;
6066 if AControl is TAnchorDockHostSite then
6067 TAnchorDockHostSite(AControl).CloseSite;
6068 Pages.Pages.Delete(i);
6069 end;
6070 Release;
6071 end else begin
6072 // just close current page
6073 AControl:=Pages.DockPages[Pages.PageIndex].GetSite;
6074 if AControl is TAnchorDockHostSite then
6075 TAnchorDockHostSite(AControl).CloseSite;
6076 Pages.Pages.Delete(Pages.PageIndex);
6077 end;
6078 finally
6079 if NeedEnableAutoSizing then
6080 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF};
6081 end;
6082 end;
6083 end;
6084 end;
6085
6086 procedure TAnchorDockHostSite.RemoveControl(AControl: TControl);
6087 begin
6088 //debugln(['TAnchorDockHostSite.RemoveControl ',DbgSName(Self),'=',Caption,' ',DbgSName(AControl)]);
6089 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.RemoveControl'){$ENDIF};
6090 try
6091 AControl.RemoveHandlerOnVisibleChanged(@ChildVisibleChanged);
6092 inherited RemoveControl(AControl);
6093 if not (csDestroying in ComponentState) then begin
6094 if (not ((AControl is TAnchorDockHeader)
6095 or (AControl is TAnchorDockSplitter)))
6096 then begin
6097 //debugln(['TAnchorDockHostSite.RemoveControl START ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl),' UpdatingLayout=',UpdatingLayout]);
6098 if (SiteType=adhstLayout) then
6099 RemoveControlFromLayout(AControl)
6100 else
6101 DockMaster.NeedSimplify(Self);
6102 UpdateDockCaption;
6103 //debugln(['TAnchorDockHostSite.RemoveControl END ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl)]);
6104 end;
6105 end;
6106 finally
6107 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.RemoveControl'){$ENDIF};
6108 end;
6109 end;
6110
6111 procedure TAnchorDockHostSite.InsertControl(AControl: TControl; Index: integer);
6112 begin
6113 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.InsertControl'){$ENDIF};
6114 try
6115 inherited InsertControl(AControl, Index);
6116 if not ((AControl is TAnchorDockSplitter)
6117 or (AControl is TAnchorDockHeader))
6118 then
6119 UpdateDockCaption;
6120 AControl.AddHandlerOnVisibleChanged(@ChildVisibleChanged);
6121 finally
6122 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.InsertControl'){$ENDIF};
6123 end;
6124 end;
6125
6126 procedure TAnchorDockHostSite.UpdateDockCaption(Exclude: TControl);
6127 var
6128 i: Integer;
6129 Child: TControl;
6130 NewCaption, OldCaption: String;
6131 begin
6132 if csDestroying in ComponentState then exit;
6133 NewCaption:='';
6134 if Minimized then
6135 begin
6136 if Assigned(FMinimizedControl) then
6137 NewCaption:=FMinimizedControl.Caption;
6138 end
6139 else
6140 for i:=0 to ControlCount-1 do begin
6141 Child:=Controls[i];
6142 if Child=Exclude then continue;
6143 if (Child.HostDockSite=Self) or (Child is TAnchorDockHostSite)
6144 or (Child is TAnchorDockPageControl) then begin
6145 if NewCaption<>'' then
6146 NewCaption:=NewCaption+',';
6147 NewCaption:=NewCaption+Child.Caption;
6148 end;
6149 end;
6150 OldCaption:=Caption;
6151 Caption:=NewCaption;
6152 //debugln(['TAnchorDockHostSite.UpdateDockCaption Caption="',Caption,'" NewCaption="',NewCaption,'" HasParent=',Parent<>nil,' ',DbgSName(Header)]);
6153 Header.Caption:=Caption;
6154 if OldCaption<>Caption then begin
6155 //debugln(['TAnchorDockHostSite.UpdateDockCaption Caption="',Caption,'" NewCaption="',NewCaption,'" HasParent=',Parent<>nil]);
6156 if Parent is TAnchorDockHostSite then
6157 TAnchorDockHostSite(Parent).UpdateDockCaption;
6158 if Parent is TAnchorDockPage then
6159 TAnchorDockPage(Parent).UpdateDockCaption;
6160 end;
6161 // do not show close button for mainform
6162 Header.CloseButton.Visible:=(not IsParentOf(Application.MainForm));
6163 end;
6164
6165 procedure TAnchorDockHostSite.GetSiteInfo(Client: TControl;
6166 var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
6167 var
6168 ADockMargin: LongInt;
6169 begin
6170 GetWindowRect(Handle, InfluenceRect);
6171
6172 if (Parent=nil) or DockMaster.IsCustomSite(Parent) then begin
6173 // allow docking outside => enlarge margins
6174 ADockMargin:=DockMaster.DockOutsideMargin;
6175 //debugln(['TAnchorDockHostSite.GetSiteInfo ',DbgSName(Self),' allow outside ADockMargin=',ADockMargin,' ',dbgs(InfluenceRect)]);
6176 InfluenceRect.Left := InfluenceRect.Left-ADockMargin;
6177 InfluenceRect.Top := InfluenceRect.Top-ADockMargin;
6178 InfluenceRect.Right := InfluenceRect.Right+ADockMargin;
6179 InfluenceRect.Bottom := InfluenceRect.Bottom+ADockMargin;
6180 end else if Parent is TAnchorDockHostSite then begin
6181 // do not cover parent site => shrink margins
6182 ADockMargin:=DockMaster.DockParentMargin;
6183 ADockMargin:=Min(ADockMargin,Min(ClientWidth,ClientHeight) div 10);
6184 ADockMargin:=Max(0,ADockMargin);
6185 //debugln(['TAnchorDockHostSite.GetSiteInfo ',DbgSName(Self),' do not cover parent ADockMargin=',ADockMargin,' ',dbgs(InfluenceRect)]);
6186 InfluenceRect.Left := InfluenceRect.Left+ADockMargin;
6187 InfluenceRect.Top := InfluenceRect.Top+ADockMargin;
6188 InfluenceRect.Right := InfluenceRect.Right-ADockMargin;
6189 InfluenceRect.Bottom := InfluenceRect.Bottom-ADockMargin;
6190 end;
6191
6192 CanDock:=(Client is TAnchorDockHostSite)
6193 and not DockMaster.AutoFreedIfControlIsRemoved(Self,Client)
6194 and not Minimized;
6195 //debugln(['TAnchorDockHostSite.GetSiteInfo ',DbgSName(Self),' ',dbgs(BoundsRect),' ',Caption,' CanDock=',CanDock,' PtIn=',PtInRect(InfluenceRect,MousePos)]);
6196
6197 if Assigned(OnGetSiteInfo) then
6198 OnGetSiteInfo(Self, Client, InfluenceRect, MousePos, CanDock);
6199 end;
6200
GetPageAreanull6201 function TAnchorDockHostSite.GetPageArea: TRect;
6202 begin
6203 Result:=Rect(0,0,Width*DockMaster.PageAreaInPercent div 100,
6204 Height*DockMaster.PageAreaInPercent div 100);
6205 OffsetRect(Result,(Width*(100-DockMaster.PageAreaInPercent)) div 200,
6206 (Height*(100-DockMaster.PageAreaInPercent)) div 200);
6207 end;
6208
6209 procedure TAnchorDockHostSite.ChangeBounds(ALeft, ATop, AWidth,
6210 AHeight: integer; KeepBase: boolean);
6211 begin
6212 inherited ChangeBounds(ALeft, ATop, AWidth, AHeight, KeepBase);
6213 if Header<>nil then UpdateHeaderAlign;
6214 end;
6215
6216 procedure TAnchorDockHostSite.UpdateHeaderAlign;
6217 var
6218 NeededHeaderPosition:TADLHeaderPosition;
6219 Splitter: TAnchorDockSplitter;
6220 SplitterAnchorKind:TAnchorKind;
6221 begin
6222 if Header=nil then exit;
6223 if Minimized then begin
6224 if FindNearestSpliter(self,Splitter,SplitterAnchorKind) then begin
6225 NeededHeaderPosition:=OppositeAnchorKind2TADLHeaderPosition[SplitterAnchorKind];
6226 end else
6227 NeededHeaderPosition:=Header.HeaderPosition;
6228 end else
6229 NeededHeaderPosition:=Header.HeaderPosition;
6230 case NeededHeaderPosition of
6231 adlhpAuto:
6232 if Header.Align in [alLeft,alRight] then begin
6233 if (ClientHeight>0)
6234 and ((ClientWidth*100 div ClientHeight)<=DockMaster.HeaderAlignTop) then
6235 Header.Align:=alTop;
6236 end else begin
6237 if (ClientHeight>0)
6238 and ((ClientWidth*100 div ClientHeight)>=DockMaster.HeaderAlignLeft) then
6239 begin
6240 if Application.BidiMode=bdRightToLeft then
6241 Header.Align:=alRight
6242 else
6243 Header.Align:=alLeft;
6244 end;
6245 end;
6246 adlhpLeft: Header.Align:=alLeft;
6247 adlhpTop: Header.Align:=alTop;
6248 adlhpRight: Header.Align:=alRight;
6249 adlhpBottom: Header.Align:=alBottom;
6250 end;
6251 end;
6252
6253 procedure TAnchorDockHostSite.UpdateHeaderShowing;
6254 var
6255 Splitter: TAnchorDockSplitter;
6256 SplitterAnchorKind:TAnchorKind;
6257 begin
6258 if Header=nil then exit;
6259 if HeaderNeedsShowing then begin
6260 Header.Parent:=Self;
6261 Header.MinimizeButton.Visible:=(DockMaster.DockSitesCanBeMinimized and CanBeMinimized(Splitter,SplitterAnchorKind))or Minimized;
6262 Header.MinimizeButton.Parent:=Header;
6263 end
6264 else
6265 Header.Parent:=nil;
6266 end;
6267
6268 procedure TAnchorDockHostSite.BeginUpdateLayout;
6269 begin
6270 inc(FUpdateLayout);
6271 if FUpdateLayout=1 then DockMaster.BeginUpdate;
6272 end;
6273
6274 procedure TAnchorDockHostSite.EndUpdateLayout;
6275 begin
6276 if FUpdateLayout=0 then RaiseGDBException('TAnchorDockHostSite.EndUpdateLayout');
6277 dec(FUpdateLayout);
6278 if FUpdateLayout=0 then
6279 DockMaster.EndUpdate;
6280 end;
6281
UpdatingLayoutnull6282 function TAnchorDockHostSite.UpdatingLayout: boolean;
6283 begin
6284 Result:=(FUpdateLayout>0) or (csDestroying in ComponentState);
6285 end;
6286
6287 function AcceptAlign(Site:TAnchorDockHostSite; AlignCandidate:TAlign):TAlign;
6288 var
6289 i:integer;
6290 Splitter: TAnchorDockSplitter;
6291 SplitterAnchorKind:TAnchorKind;
6292 MinimizedSiteAlign:TAlign;
6293 begin
6294 for i:=0 to Site.ControlCount-1 do
6295 if Site.Controls[i] is TAnchorDockHostSite then
6296 if (Site.Controls[i] as TAnchorDockHostSite).Minimized then begin
6297 if FindNearestSpliter(Site.Controls[i] as TAnchorDockHostSite,Splitter,SplitterAnchorKind) then begin
6298 MinimizedSiteAlign:=OppositeAnchorKind2Align[SplitterAnchorKind];
6299 if AlignCandidate=MinimizedSiteAlign then
6300 exit(alNone);
6301 end
6302 end;
6303 result:=AlignCandidate;
6304 end;
6305
GetDockEdgenull6306 function TAnchorDockHostSite.GetDockEdge(const MousePos: TPoint): TAlign;
6307 begin
6308 result:=inherited;
6309 result:=AcceptAlign(self,result);
6310 end;
6311
6312 procedure TAnchorDockHostSite.SaveLayout(
6313 LayoutTree: TAnchorDockLayoutTree; LayoutNode: TAnchorDockLayoutTreeNode);
6314 var
6315 i: Integer;
6316 Site: TAnchorDockHostSite;
6317 ChildNode: TAnchorDockLayoutTreeNode;
6318 Child: TControl;
6319 Splitter: TAnchorDockSplitter;
6320 OneControl: TControl;
6321 begin
6322 if SiteType=adhstOneControl then
6323 OneControl:=GetOneControl
6324 else
6325 OneControl:=nil;
6326 if (SiteType=adhstOneControl) and (OneControl<>nil)
6327 and (not (OneControl is TAnchorDockHostSite)) then begin
6328 LayoutNode.NodeType:=adltnControl;
6329 LayoutNode.Assign(Self,false,Minimized);
6330 LayoutNode.Name:=OneControl.Name;
6331 LayoutNode.HeaderPosition:=Header.HeaderPosition;
6332 end else if (SiteType in [adhstLayout,adhstOneControl]) then begin
6333 LayoutNode.NodeType:=adltnLayout;
6334 for i:=0 to ControlCount-1 do begin
6335 Child:=Controls[i];
6336 if Child.Owner=Self then continue;
6337 if (Child is TAnchorDockHostSite) then begin
6338 Site:=TAnchorDockHostSite(Child);
6339 ChildNode:=LayoutTree.NewNode(LayoutNode);
6340 Site.SaveLayout(LayoutTree,ChildNode);
6341 end else if (Child is TAnchorDockSplitter) then begin
6342 Splitter:=TAnchorDockSplitter(Child);
6343 ChildNode:=LayoutTree.NewNode(LayoutNode);
6344 Splitter.SaveLayout(ChildNode);
6345 end;
6346 end;
6347 LayoutNode.Assign(Self,false,Minimized);
6348 LayoutNode.HeaderPosition:=Header.HeaderPosition;
6349 end else if SiteType=adhstPages then begin
6350 LayoutNode.NodeType:=adltnPages;
6351 for i:=0 to Pages.PageCount-1 do begin
6352 Site:=Pages.DockPages[i].GetSite;
6353 if Site<>nil then begin
6354 ChildNode:=LayoutTree.NewNode(LayoutNode);
6355 Site.SaveLayout(LayoutTree,ChildNode);
6356 end;
6357 end;
6358 LayoutNode.Assign(Self,false,Minimized);
6359 LayoutNode.HeaderPosition:=Header.HeaderPosition;
6360 LayoutNode.TabPosition:=Pages.TabPosition;
6361 LayoutNode.PageIndex:=Pages.PageIndex;
6362 end else
6363 LayoutNode.NodeType:=adltnNone;
6364 if BoundSplitter<>nil then begin
6365 if Align in [alLeft,alRight] then
6366 LayoutNode.BoundSplitterPos:=BoundSplitter.Left
6367 else
6368 LayoutNode.BoundSplitterPos:=BoundSplitter.Top;
6369 end;
6370 LayoutNode.PixelsPerInch:=Screen.PixelsPerInch;
6371 end;
6372
6373 constructor TAnchorDockHostSite.CreateNew(AOwner: TComponent; Num: Integer);
6374 begin
6375 inherited CreateNew(AOwner,Num);
6376 FMinimizedControl:=Nil;
6377 Visible:=false;
6378 FHeaderSide:=akTop;
6379 FHeader:=DockMaster.HeaderClass.Create(Self);
6380 FHeader.Align:=alTop;
6381 FHeader.Parent:=Self;
6382 FSiteType:=adhstNone;
6383 UpdateHeaderAlign;
6384 DragKind:=dkDock;
6385 DockManager:=DockMaster.ManagerClass.Create(Self);
6386 UseDockManager:=true;
6387 DragManager.RegisterDockSite(Self,true);
6388 AddHandlerFirstShow(@FirstShow);
6389 end;
6390
6391 destructor TAnchorDockHostSite.Destroy;
6392 {$IFDEF VerboseAnchorDocking}
6393 var i: Integer;
6394 {$ENDIF}
6395 begin
6396 {$IFDEF VerboseAnchorDocking}
6397 debugln(['TAnchorDockHostSite.Destroy ',DbgSName(Self),' Caption="',Caption,'" Self=',dbgs(Pointer(Self)),' ComponentCount=',ComponentCount,' ControlCount=',ControlCount]);
6398 for i:=0 to ComponentCount-1 do
6399 debugln(['TAnchorDockHostSite.Destroy Component ',i,'/',ComponentCount,' ',DbgSName(Components[i])]);
6400 for i:=0 to ControlCount-1 do
6401 debugln(['TAnchorDockHostSite.Destroy Control ',i,'/',ControlCount,' ',DbgSName(Controls[i])]);
6402 {$ENDIF}
6403 FreePages;
6404 inherited Destroy;
6405 end;
6406
6407 { TAnchorDockHeader }
6408
6409 procedure TAnchorDockHeader.PopupMenuPopup(Sender: TObject);
6410 var
6411 HeaderPosItem: TMenuItem;
6412 ParentSite: TAnchorDockHostSite;
6413 Side: TAnchorKind;
6414 SideCaptions: array[TAnchorKind] of string;
6415 Item: TMenuItem;
6416 ContainsMainForm: boolean;
6417 s: String;
6418 begin
6419 ParentSite:=TAnchorDockHostSite(Parent);
6420 SideCaptions[akLeft]:=adrsLeft;
6421 SideCaptions[akTop]:=adrsTop;
6422 SideCaptions[akRight]:=adrsRight;
6423 SideCaptions[akBottom]:=adrsBottom;
6424
6425 // menu items: undock, merge
6426 DockMaster.AddRemovePopupMenuItem(ParentSite.CanUndock,'UndockMenuItem',
6427 adrsUndock,@UndockButtonClick);
6428 DockMaster.AddRemovePopupMenuItem(ParentSite.CanMerge,'MergeMenuItem',
6429 adrsMerge, @MergeButtonClick);
6430
6431 // menu items: header position
6432 HeaderPosItem:=DockMaster.AddPopupMenuItem('HeaderPosMenuItem',
6433 adrsHeaderPosition, nil);
6434 Item:=DockMaster.AddPopupMenuItem('HeaderPosAutoMenuItem', adrsAutomatically,
6435 @HeaderPositionItemClick, HeaderPosItem);
6436 if Item<>nil then begin
6437 Item.Tag:=ord(adlhpAuto);
6438 Item.Checked:=HeaderPosition=TADLHeaderPosition(Item.Tag);
6439 end;
6440 for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin
6441 Item:=DockMaster.AddPopupMenuItem('HeaderPos'+DbgS(Side)+'MenuItem',
6442 SideCaptions[Side], @HeaderPositionItemClick,
6443 HeaderPosItem);
6444 if Item=nil then continue;
6445 Item.Tag:=ord(Side)+1;
6446 Item.Checked:=HeaderPosition=TADLHeaderPosition(Item.Tag);
6447 end;
6448
6449 // menu items: enlarge
6450 for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin
6451 Item:=DockMaster.AddRemovePopupMenuItem(ParentSite.EnlargeSide(Side,true),
6452 'Enlarge'+DbgS(Side)+'MenuItem', Format(adrsEnlargeSide, [
6453 SideCaptions[Side]]),@EnlargeSideClick);
6454 if Item<>nil then Item.Tag:=ord(Side);
6455 end;
6456
6457 // menu item: close or quit
6458 ContainsMainForm:=ParentSite.IsParentOf(Application.MainForm);
6459 if ContainsMainForm then
6460 s:=Format(adrsQuit, [Application.Title])
6461 else
6462 s:=adrsClose;
6463 DockMaster.AddRemovePopupMenuItem(CloseButton.Visible,'CloseMenuItem',s,
6464 @CloseButtonClick);
6465 end;
6466
6467 procedure TAnchorDockHeader.CloseButtonClick(Sender: TObject);
6468 var
6469 HeaderParent:TAnchorDockHostSite;
6470 begin
6471 TWinControl(HeaderParent):=Parent;
6472 if HeaderParent=TWinControl(DockMaster.FOverlappingForm) then begin
6473 HeaderParent:=DockMaster.FOverlappingForm.AnchorDockHostSite;
6474 HeaderParent.HideMinimizedControl;
6475 end;
6476 if HeaderParent is TAnchorDockHostSite then begin
6477 DockMaster.RestoreLayouts.Add(DockMaster.CreateRestoreLayout(HeaderParent),true);
6478 HeaderParent.CloseSite;
6479 end;
6480 end;
6481
6482 procedure TAnchorDockHeader.MinimizeButtonClick(Sender: TObject);
6483 var
6484 HeaderParent:TAnchorDockHostSite;
6485 begin
6486 TWinControl(HeaderParent):=Parent;
6487 if HeaderParent=TWinControl(DockMaster.FOverlappingForm) then begin
6488 HeaderParent:=DockMaster.FOverlappingForm.AnchorDockHostSite;
6489 HeaderParent.HideMinimizedControl;
6490 end;
6491 if HeaderParent is TAnchorDockHostSite then begin
6492 HeaderParent.MinimizeSite;
6493 end;
6494 end;
6495
6496 procedure TAnchorDockHeader.HeaderPositionItemClick(Sender: TObject);
6497 var
6498 Item: TMenuItem;
6499 begin
6500 if not (Sender is TMenuItem) then exit;
6501 Item:=TMenuItem(Sender);
6502 HeaderPosition:=TADLHeaderPosition(Item.Tag);
6503 end;
6504
6505 procedure TAnchorDockHeader.UndockButtonClick(Sender: TObject);
6506 begin
6507 TAnchorDockHostSite(Parent).Undock;
6508 end;
6509
6510 procedure TAnchorDockHeader.MergeButtonClick(Sender: TObject);
6511 begin
6512 TAnchorDockHostSite(Parent).Merge;
6513 end;
6514
6515 procedure TAnchorDockHeader.EnlargeSideClick(Sender: TObject);
6516 var
6517 Side: TAnchorKind;
6518 begin
6519 if not (Sender is TMenuItem) then exit;
6520 Side:=TAnchorKind(TMenuItem(Sender).Tag);
6521 TAnchorDockHostSite(Parent).EnlargeSide(Side,false);
6522 end;
6523
6524 procedure TAnchorDockHeader.SetHeaderPosition(const AValue: TADLHeaderPosition);
6525 begin
6526 if FHeaderPosition=AValue then exit;
6527 FHeaderPosition:=AValue;
6528 if Parent is TAnchorDockHostSite then
6529 TAnchorDockHostSite(Parent).UpdateHeaderAlign;
6530 end;
6531
6532 procedure TAnchorDockHeader.Draw(HeaderStyle:TADHeaderStyle);
6533 var
6534 r: TRect;
6535 TxtH: longint;
6536 TxtW: longint;
6537 dx,dy: Integer;
6538 //NeedDrawHeaderAfterText,NeedHighlightText:boolean;
6539 begin
6540 r:=ClientRect;
6541 if not HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then begin
6542 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,not(Align in [alLeft,alRight]),FFocused);
6543 end else begin
6544 Canvas.Brush.Color := clForm;
6545 if DockMaster.HeaderFilled then
6546 Canvas.FillRect(r);
6547 if not DockMaster.HeaderFlatten then
6548 Canvas.Frame3d(r,1,bvRaised);
6549 end;
6550 {case DockMaster.HeaderStyle of
6551 adhsPoints: Canvas.Brush.Color := clForm;
6552 else Canvas.Frame3d(r,1,bvRaised);
6553 end;
6554 Canvas.FillRect(r);}
6555
6556 if CloseButton.IsControlVisible and (CloseButton.Parent=Self) then begin
6557 if Align in [alLeft,alRight] then
6558 r.Top:=CloseButton.Top+CloseButton.Height+ButtonBorderSpacingAround
6559 else
6560 r.Right:=CloseButton.Left-ButtonBorderSpacingAround;
6561 end;
6562
6563 if MinimizeButton.IsControlVisible and (MinimizeButton.Parent=Self) then begin
6564 if Align in [alLeft,alRight] then
6565 r.Top:=MinimizeButton.Top+MinimizeButton.Height+ButtonBorderSpacingAround
6566 else
6567 r.Right:=MinimizeButton.Left-ButtonBorderSpacingAround;
6568 end;
6569
6570 // caption
6571 if Caption<>'' then begin
6572 if FFocused and DockMaster.HeaderHighlightFocused and HeaderStyle.StyleDesc.NeedHighlightText then
6573 Canvas.Font.Bold:=true
6574 else
6575 Canvas.Font.Bold:=False;
6576 Canvas.Brush.Color:=clNone;
6577 Canvas.Brush.Style:=bsClear;
6578 TxtH:=Canvas.TextHeight('ABCMgq');
6579 TxtW:=Canvas.TextWidth(Caption);
6580 if Align in [alLeft,alRight] then begin
6581 // vertical
6582 dx:=Max(0,(r.Right-r.Left-TxtH) div 2);
6583 {$IFDEF LCLWin32}
6584 dec(dx,2);
6585 {$ENDIF}
6586 dy:=Max(0,(r.Bottom-r.Top-TxtW) div 2);
6587 Canvas.Font.Orientation:=900;
6588 if TxtW<(r.Bottom-r.Top)then
6589 begin
6590 // text fits
6591 Canvas.TextOut(r.Left+dx-1,r.Bottom-dy,Caption);
6592 if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then begin
6593 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left,r.Top,r.Right,r.Bottom-dy-TxtW-1),false,FFocused);
6594 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left,r.Bottom-dy+1,r.Right,r.Bottom),false,FFocused);
6595 end;
6596 end else begin
6597 // text does not fit
6598 if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then
6599 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,false,FFocused);
6600 end;
6601 end else begin
6602 // horizontal
6603 dx:=Max(0,(r.Right-r.Left-TxtW) div 2);
6604 dy:=Max(0,(r.Bottom-r.Top-TxtH) div 2);
6605 Canvas.Font.Orientation:=0;
6606 if TxtW<(r.right-r.Left)then
6607 begin
6608 // text fits
6609 Canvas.TextRect(r,dx+2,dy,Caption);
6610 if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then begin
6611 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left,r.Top,r.Left+dx-1,r.Bottom),true,FFocused);
6612 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left+dx+TxtW+2,r.Top,r.Right,r.Bottom),true,FFocused);
6613 end;
6614 end else begin
6615 // text does not fit
6616 if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then
6617 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,true,FFocused);
6618 end;
6619 end;
6620 end
6621 else if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then
6622 if Align in [alLeft,alRight] then
6623 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,false,FFocused)
6624 else
6625 HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,true,FFocused);
6626 end;
6627
6628 procedure TAnchorDockHeader.Paint;
6629 begin
6630 draw(DockMaster.CurrentADHeaderStyle);
6631 end;
6632
6633 procedure TAnchorDockHeader.CalculatePreferredSize(var PreferredWidth,
6634 PreferredHeight: integer; WithThemeSpace: Boolean);
6635 const
6636 TestTxt = 'ABCXYZ123gqj';
6637 var
6638 DC: HDC;
6639 R: TRect;
6640 OldFont: HGDIOBJ;
6641 Flags: cardinal;
6642 NeededHeight: Integer;
6643 begin
6644 inherited CalculatePreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace);
6645 if Caption<>'' then begin
6646 DC := GetDC(Parent.Handle);
6647 try
6648 R := Rect(0, 0, 10000, 10000);
6649 OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
6650 Flags := DT_CALCRECT or DT_EXPANDTABS or DT_SINGLELINE or DT_NOPREFIX;
6651
6652 DrawText(DC, PChar(TestTxt), Length(TestTxt), R, Flags);
6653 SelectObject(DC, OldFont);
6654 NeededHeight := R.Bottom - R.Top + BevelWidth*2;
6655 finally
6656 ReleaseDC(Parent.Handle, DC);
6657 end;
6658 if Align in [alLeft,alRight] then begin
6659 PreferredWidth:=Max(NeededHeight,PreferredWidth);
6660 end else begin
6661 PreferredHeight:=Max(NeededHeight,PreferredHeight);
6662 end;
6663 end else begin
6664 NeededHeight:=CloseButton.Height;
6665 if Align in [alLeft,alRight] then begin
6666 PreferredWidth:=Max(NeededHeight,PreferredWidth);
6667 end else begin
6668 PreferredHeight:=Max(NeededHeight,PreferredHeight);
6669 end;
6670 end;
6671 end;
6672
6673 procedure TAnchorDockHeader.MouseDown(Button: TMouseButton; Shift: TShiftState;
6674 X, Y: Integer);
6675 var
6676 SiteMinimized:Boolean;
6677 begin
6678 inherited MouseDown(Button, Shift, X, Y);
6679 SiteMinimized:=False;
6680 FUseTimer:=false;
6681 StopMouseNoMoveTimer;
6682 if Parent is TAnchorDockHostSite then
6683 SiteMinimized:=(Parent as TAnchorDockHostSite).Minimized;
6684 if SiteMinimized then begin
6685 DoMouseNoMoveTimer(nil);
6686 end else
6687 begin
6688 if parent<>nil then
6689 if DockMaster.FOverlappingForm<>nil then
6690 //if parent=DockMaster.FOverlappingForm.Panel then
6691 DockMaster.HideOverlappingForm(nil);
6692 if (Button=mbLeft) and (DockMaster.AllowDragging) and (DockMaster.FOverlappingForm=nil) then
6693 DragManager.DragStart(Parent,false,DockMaster.DragTreshold);
6694 end;
6695 end;
6696
6697 procedure TAnchorDockHeader.MouseMove(Shift: TShiftState; X,Y: Integer);
6698 begin
6699 inherited MouseMove(Shift, X, Y);
6700 if parent<>nil then
6701 if parent is TAnchorDockHostSite then
6702 if (parent as TAnchorDockHostSite).Minimized then
6703 if DockMaster.FOverlappingForm=nil then
6704 if FMouseTimeStartX=EmptyMouseTimeStartX then
6705 StartMouseNoMoveTimer
6706 else begin
6707 if (abs(FMouseTimeStartX-X)>MouseNoMoveDelta) or (abs(FMouseTimeStartY-Y)>MouseNoMoveDelta)then
6708 StopMouseNoMoveTimer;
6709 end;
6710 if (parent is TAnchorDockHostSite) and (DockMaster.FOverlappingForm=nil)then
6711 FUseTimer:=true;
6712 end;
6713
6714 procedure TAnchorDockHeader.MouseLeave;
6715 begin
6716 inherited;
6717 StopMouseNoMoveTimer;
6718 end;
6719
6720 procedure TAnchorDockHeader.StartMouseNoMoveTimer;
6721 begin
6722 if FUseTimer then begin
6723 if DockTimer.Enabled then DockTimer.Enabled:=false;
6724 DockTimer.Interval:=MouseNoMoveTime;
6725 DockTimer.OnTimer:=@DoMouseNoMoveTimer;
6726 DockTimer.Enabled:=true;
6727 end;
6728 end;
6729
6730 procedure TAnchorDockHeader.StopMouseNoMoveTimer;
6731 begin
6732 FMouseTimeStartX:=EmptyMouseTimeStartX;
6733 DockTimer.OnTimer:=nil;
6734 DockTimer.Enabled:=false;
6735 end;
6736
6737 procedure TAnchorDockHeader.DoMouseNoMoveTimer(Sender: TObject);
6738 begin
6739 StopMouseNoMoveTimer;
6740 //if FUseTimer then
6741 if parent<>nil then
6742 if parent is TAnchorDockHostSite then
6743 if (parent as TAnchorDockHostSite).Minimized then
6744 (parent as TAnchorDockHostSite).ShowMinimizedControl;
6745 end;
6746
6747 procedure TAnchorDockHeader.UpdateHeaderControls;
6748 begin
6749 if Align in [alLeft,alRight] then begin
6750 if CloseButton<>nil then begin
6751 //MinimizeButton.Align:=alTop;
6752 //CloseButton.Align:=alTop;
6753 CloseButton.AnchorSide[akLeft].Side := asrCenter;
6754 CloseButton.AnchorSide[akLeft].Control := Self;
6755 CloseButton.AnchorSide[akTop].Side := asrTop;
6756 CloseButton.AnchorSide[akTop].Control := Self;
6757 CloseButton.Anchors := [akTop] + [akLeft];
6758
6759 MinimizeButton.AnchorSide[akLeft].Side := asrCenter;
6760 MinimizeButton.AnchorSide[akLeft].Control := Self;
6761 MinimizeButton.AnchorSide[akTop].Side := asrBottom;
6762 MinimizeButton.AnchorSide[akTop].Control := CloseButton;
6763 MinimizeButton.Anchors := [akTop] + [akLeft];
6764 end;
6765 end else begin
6766 if CloseButton<>nil then begin
6767 //MinimizeButton.Align:=alRight;
6768 //CloseButton.Align:=alRight;
6769 CloseButton.AnchorSide[akRight].Side := asrRight;
6770 CloseButton.AnchorSide[akRight].Control := Self;
6771 CloseButton.AnchorSide[akTop].Side := asrCenter;
6772 CloseButton.AnchorSide[akTop].Control := Self;
6773 CloseButton.Anchors := [akTop] + [akRight];
6774
6775 MinimizeButton.AnchorSide[akRight].Side := asrLeft;
6776 MinimizeButton.AnchorSide[akRight].Control := CloseButton;
6777 MinimizeButton.AnchorSide[akTop].Side := asrCenter;
6778 MinimizeButton.AnchorSide[akTop].Control := Self;
6779 MinimizeButton.Anchors := [akTop] + [akRight];
6780 end;
6781 end;
6782 CloseButton.BorderSpacing.Around:=ButtonBorderSpacingAround;
6783 MinimizeButton.BorderSpacing.Around:=ButtonBorderSpacingAround;
6784 //debugln(['TAnchorDockHeader.UpdateHeaderControls ',dbgs(Align),' ',dbgs(CloseButton.Align)]);
6785 end;
6786
6787 procedure TAnchorDockHeader.SetAlign(Value: TAlign);
6788 begin
6789 if Value=Align then exit;
6790 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SetAlign'){$ENDIF};
6791 try
6792 inherited SetAlign(Value);
6793 UpdateHeaderControls;
6794 finally
6795 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SetAlign'){$ENDIF};
6796 end;
6797 end;
6798
6799 procedure TAnchorDockHeader.DoOnShowHint(HintInfo: PHintInfo);
6800 var
6801 s: String;
6802 p: LongInt;
6803 c: String;
6804 begin
6805 s:=DockMaster.GetLocalizedHeaderHint;
6806 p:=Pos('%s',s);
6807 if p>0 then begin
6808 if Parent<>nil then
6809 c:=Parent.Caption
6810 else
6811 c:='';
6812 s:=Format(s,[c]);
6813 end;
6814 //debugln(['TAnchorDockHeader.DoOnShowHint "',s,'" "',DockMaster.HeaderHint,'"']);
6815 HintInfo^.HintStr:=s;
6816 inherited DoOnShowHint(HintInfo);
6817 end;
6818
6819 constructor TAnchorDockHeader.Create(TheOwner: TComponent);
6820 begin
6821 inherited Create(TheOwner);
6822 FHeaderPosition:=adlhpAuto;
6823 BevelOuter:=bvNone;
6824 BorderWidth:=0;
6825 FCloseButton:=TAnchorDockCloseButton.Create(Self);
6826 with FCloseButton do begin
6827 Name:='CloseButton';
6828 Parent:=Self;
6829 Flat:=true;
6830 ShowHint:=true;
6831 Hint:=adrsClose;
6832 OnClick:=@CloseButtonClick;
6833 AutoSize:=true;
6834 end;
6835 FMinimizeButton:=TAnchorDockMinimizeButton.Create(Self);
6836 with FMinimizeButton do begin
6837 Name:='MinimizeButton';
6838 Parent:=Self;
6839 Flat:=true;
6840 ShowHint:=true;
6841 Hint:=adrsMinimize;
6842 OnClick:=@MinimizeButtonClick;
6843 AutoSize:=true;
6844 end;
6845 Align:=alTop;
6846 AutoSize:=true;
6847 ShowHint:=true;
6848 PopupMenu:=DockMaster.GetPopupMenu;
6849 FFocused:=false;
6850 FMouseTimeStartX:=EmptyMouseTimeStartX;
6851 FUseTimer:=true;
6852 end;
6853
6854 { TAnchorDockCloseButton }
6855
GetDrawDetailsnull6856 function TAnchorDockCloseButton.GetDrawDetails: TThemedElementDetails;
6857
6858 function WindowPart: TThemedWindow;
6859 begin
6860 // no check states available
6861 Result := twCloseButtonNormal;
6862 if not IsEnabled then
6863 Result := {$IFDEF LCLWIN32}twCloseButtonDisabled{$ELSE}twSmallCloseButtonDisabled{$ENDIF}
6864 else
6865 if FState in [bsDown, bsExclusive] then
6866 Result := {$IFDEF LCLWIN32}twCloseButtonPushed{$ELSE}twSmallCloseButtonPushed{$ENDIF}
6867 else
6868 if FState = bsHot then
6869 Result := {$IFDEF LCLWIN32}twCloseButtonHot{$ELSE}twSmallCloseButtonHot{$ENDIF}
6870 else
6871 Result := {$IFDEF LCLWIN32}twCloseButtonNormal;{$ELSE}twSmallCloseButtonNormal;{$ENDIF}
6872 end;
6873
6874 begin
6875 Result := ThemeServices.GetElementDetails(WindowPart);
6876 end;
6877
6878 procedure SizeCorrector(var current,recomend:integer);
6879 begin
6880 if recomend<0 then begin
6881 if current>0 then
6882 recomend:=current
6883 else
6884 current:=HardcodedButtonSize;
6885 end else begin
6886 if current>recomend then
6887 current:=recomend
6888 else begin
6889 if current>0 then
6890 recomend:=current
6891 else
6892 current:=recomend;
6893 end;
6894 end;
6895 end;
6896
6897 procedure ButtonSizeCorrector(var w,h:integer);
6898 begin
6899 SizeCorrector(w,PreferredButtonWidth);
6900 SizeCorrector(h,PreferredButtonHeight);
6901 end;
6902
6903 procedure TAnchorDockCloseButton.CalculatePreferredSize(var PreferredWidth,
6904 PreferredHeight: integer; WithThemeSpace: Boolean);
6905 begin
6906 with ThemeServices.GetDetailSize(ThemeServices.GetElementDetails(twSmallCloseButtonNormal)) do
6907 begin
6908 PreferredWidth:=cx;
6909 PreferredHeight:=cy;
6910 ButtonSizeCorrector(PreferredWidth,PreferredHeight);
6911 {$IF defined(LCLGtk2) or defined(Carbon)}
6912 inc(PreferredWidth,2);
6913 inc(PreferredHeight,2);
6914 {$ENDIF}
6915 PreferredWidth:=ScaleDesignToForm(PreferredWidth);
6916 PreferredHeight:=ScaleDesignToForm(PreferredHeight);
6917 end;
6918 end;
6919
6920 { TAnchorDockMinimizeButton }
6921
GetDrawDetailsnull6922 function TAnchorDockMinimizeButton.GetDrawDetails: TThemedElementDetails;
6923
6924 function WindowPart: TThemedWindow;
6925 begin
6926 // no check states available
6927 Result := twMinButtonNormal;
6928 if not IsEnabled then
6929 Result := {$IFDEF LCLGtk2}twMDIRestoreButtonDisabled{$ELSE}twMinButtonDisabled{$ENDIF}
6930 else
6931 if FState in [bsDown, bsExclusive] then
6932 Result := {$IFDEF LCLGtk2}twMDIRestoreButtonPushed{$ELSE}twMinButtonPushed{$ENDIF}
6933 else
6934 if FState = bsHot then
6935 Result := {$IFDEF LCLGtk2}twMDIRestoreButtonHot{$ELSE}twMinButtonHot{$ENDIF}
6936 else
6937 Result := {$IFDEF LCLGtk2}twMDIRestoreButtonNormal{$ELSE}twMinButtonNormal{$ENDIF};
6938 end;
6939
6940 begin
6941 Result := ThemeServices.GetElementDetails(WindowPart);
6942 end;
6943
6944 procedure TAnchorDockMinimizeButton.CalculatePreferredSize(var PreferredWidth,
6945 PreferredHeight: integer; WithThemeSpace: Boolean);
6946 begin
6947 with ThemeServices.GetDetailSize(ThemeServices.GetElementDetails({$IFDEF LCLGtk2}twMDIRestoreButtonNormal{$ELSE}twMinButtonNormal{$ENDIF})) do
6948 begin
6949 PreferredWidth:=cx;
6950 PreferredHeight:=cy;
6951 ButtonSizeCorrector(PreferredWidth,PreferredHeight);
6952 {$IF defined(LCLGtk2) or defined(Carbon)}
6953 inc(PreferredWidth,2);
6954 inc(PreferredHeight,2);
6955 {$ENDIF}
6956 PreferredWidth:=ScaleDesignToForm(PreferredWidth);
6957 PreferredHeight:=ScaleDesignToForm(PreferredHeight);
6958 end;
6959 end;
6960
6961 { TAnchorDockManager }
6962
6963 procedure TAnchorDockManager.SetPreferredSiteSizeAsSiteMinimum(
6964 const AValue: boolean);
6965 begin
6966 if FPreferredSiteSizeAsSiteMinimum=AValue then exit;
6967 FPreferredSiteSizeAsSiteMinimum:=AValue;
6968 if DockSite=nil then
6969 Site.AdjustSize;
6970 end;
6971
6972 constructor TAnchorDockManager.Create(ADockSite: TWinControl);
6973 begin
6974 inherited Create(ADockSite);
6975 FSite:=ADockSite;
6976 FDockableSites:=[akLeft,akTop,akBottom,akRight];
6977 FInsideDockingAllowed:=true;
6978 FPreferredSiteSizeAsSiteMinimum:=true;
6979 if (ADockSite is TAnchorDockHostSite) then
6980 FDockSite:=TAnchorDockHostSite(ADockSite);
6981 end;
6982
6983 procedure TAnchorDockManager.GetControlBounds(Control: TControl; out
6984 AControlBounds: TRect);
6985 begin
6986 if Control=nil then ;
6987 AControlBounds:=Rect(0,0,0,0);
6988 //debugln(['TAnchorDockManager.GetControlBounds DockSite="',DockSite.Caption,'" Control=',DbgSName(Control)]);
6989 end;
6990
6991 procedure TAnchorDockManager.InsertControl(Control: TControl; InsertAt: TAlign;
6992 DropCtl: TControl);
6993 begin
6994 if Control=nil then;
6995 if InsertAt=alNone then ;
6996 if DropCtl=nil then ;
6997 end;
6998
6999 procedure TAnchorDockManager.InsertControl(ADockObject: TDragDockObject);
7000 var
7001 NewSiteBounds: TRect;
7002 NewChildBounds: TRect;
7003 Child: TControl;
7004 ChildSite: TAnchorDockHostSite;
7005 SplitterWidth: Integer;
7006 begin
7007 if DockSite<>nil then begin
7008 // handled by TAnchorDockHostSite
7009 //debugln(['TAnchorDockManager.InsertControl DockSite="',DockSite.Caption,'" Control=',DbgSName(ADockObject.Control),' InsertAt=',dbgs(ADockObject.DropAlign)])
7010 end else begin
7011 {$IFDEF VerboseAnchorDocking}
7012 debugln(['TAnchorDockManager.InsertControl DockSite=nil Site="',DbgSName(Site),'" Control=',DbgSName(ADockObject.Control),' InsertAt=',dbgs(ADockObject.DropAlign),' Site.Bounds=',dbgs(Site.BoundsRect),' Control.Client=',dbgs(ADockObject.Control.ClientRect),' Parent=',DbgSName(ADockObject.Control.Parent)]);
7013 {$ENDIF}
7014 Site.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockManager.InsertControl'){$ENDIF};
7015 try
7016 // align dragged Control
7017 Child:=ADockObject.Control;
7018 Child.Parent:=Site;
7019 Child.Align:=ADockObject.DropAlign;
7020 Child.Width:=ADockObject.DockRect.Right-ADockObject.DockRect.Left;
7021 Child.Height:=ADockObject.DockRect.Bottom-ADockObject.DockRect.Top;
7022
7023 SplitterWidth:=0;
7024 ChildSite:=nil;
7025 if Child is TAnchorDockHostSite then begin
7026 ChildSite:=TAnchorDockHostSite(Child);
7027 ChildSite.CreateBoundSplitter(Site is TAnchorDockPanel);
7028 SplitterWidth:=DockMaster.SplitterWidth;
7029 end;
7030
7031 if Site is TAnchorDockPanel then
7032 ADockObject.DropAlign:=alClient;
7033
7034 // resize Site
7035 NewSiteBounds:=Site.BoundsRect;
7036 case ADockObject.DropAlign of
7037 alLeft: dec(NewSiteBounds.Left,Child.ClientWidth+SplitterWidth);
7038 alRight: dec(NewSiteBounds.Right,Child.ClientWidth+SplitterWidth);
7039 alTop: dec(NewSiteBounds.Top,Child.ClientHeight+SplitterWidth);
7040 alBottom: inc(NewSiteBounds.Bottom,Child.ClientHeight+SplitterWidth);
7041 alClient: ;
7042 end;
7043 if not StoredConstraintsValid then
7044 StoreConstraints;
7045 if ADockObject.DropAlign in [alLeft,alRight] then
7046 Site.Constraints.MaxWidth:=0
7047 else if ADockObject.DropAlign in [alTop,alBottom] then
7048 Site.Constraints.MaxHeight:=0;
7049 Site.BoundsRect:=NewSiteBounds;
7050 if ADockObject.DropAlign=alClient then
7051 Child.Align:=alClient;
7052
7053 //debugln(['TAnchorDockManager.InsertControl Site.BoundsRect=',dbgs(Site.BoundsRect),' NewSiteBounds=',dbgs(NewSiteBounds),' Child.ClientRect=',dbgs(Child.ClientRect)]);
7054 FSiteClientRect:=Site.ClientRect;
7055
7056 // resize child
7057 NewChildBounds:=Child.BoundsRect;
7058 case ADockObject.DropAlign of
7059 alTop: NewChildBounds:=Bounds(0,0,Site.ClientWidth,Child.ClientHeight);
7060 alBottom: NewChildBounds:=Bounds(0,Site.ClientHeight-Child.ClientHeight,
7061 Site.ClientWidth,Child.ClientHeight);
7062 alLeft: NewChildBounds:=Bounds(0,0,Child.ClientWidth,Site.ClientHeight);
7063 alRight: NewChildBounds:=Bounds(Site.ClientWidth-Child.ClientWidth,0,
7064 Child.ClientWidth,Site.ClientHeight);
7065 alClient: NewChildBounds:=Bounds(0,0,
7066 Site.ClientWidth,Site.ClientHeight);
7067 end;
7068 Child.BoundsRect:=NewChildBounds;
7069 NewChildBounds:=Child.BoundsRect;
7070
7071 if ChildSite<>nil then
7072 ChildSite.PositionBoundSplitter;
7073
7074 // only allow to dock one control
7075 DragManager.RegisterDockSite(Site,false);
7076 {$IFDEF VerboseAnchorDocking}
7077 debugln(['TAnchorDockManager.InsertControl AFTER Site="',DbgSName(Site),'" Control=',DbgSName(ADockObject.Control),' InsertAt=',dbgs(ADockObject.DropAlign),' Site.Bounds=',dbgs(Site.BoundsRect),' Control.ClientRect=',dbgs(ADockObject.Control.ClientRect)]);
7078 {$ENDIF}
7079 finally
7080 Site.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockManager.InsertControl'){$ENDIF};
7081 end;
7082 end;
7083 end;
7084
7085 procedure TAnchorDockManager.LoadFromStream(Stream: TStream);
7086 begin
7087 debugln(['TAnchorDockManager.LoadFromStream not implemented Site="',DbgSName(Site),'"']);
7088 if Stream=nil then ;
7089 end;
7090
7091 procedure TAnchorDockManager.PositionDockRect(Client, DropCtl: TControl;
7092 DropAlign: TAlign; var DockRect: TRect);
7093 { Client = dragged source site (a TAnchorDockHostSite)
7094 DropCtl is target control (the DockSite, DockSite.Pages or one of the pages)
7095 DropAlign: where on Client DropCtl should be placed
7096 DockRect: the estimated new bounds of DropCtl
7097 }
7098 var
7099 Offset: TPoint;
7100 Inside: Boolean;
7101 begin
7102 if (DropAlign=alClient) and (DockSite<>nil) and (DockSite.Pages<>nil) then begin
7103 // dock into pages
7104 if DropCtl=DockSite.Pages then begin
7105 // dock as last page
7106 DockRect:=DockSite.Pages.TabRect(DockSite.Pages.PageCount-1);
7107 case DockSite.Pages.TabPosition of
7108 tpTop,tpBottom: DockRect.Left:=(DockRect.Left+DockRect.Right) div 2;
7109 tpLeft,tpRight: DockRect.Top:=(DockRect.Top+DockRect.Bottom) div 2;
7110 end;
7111 Offset:=DockSite.Pages.ClientOrigin;
7112 OffsetRect(DockRect,Offset.X,Offset.Y);
7113 exit;
7114 end else if DropCtl is TAnchorDockPage then begin
7115 // dock in front of page
7116 DockRect:=DockSite.Pages.TabRect(TAnchorDockPage(DropCtl).PageIndex);
7117 case DockSite.Pages.TabPosition of
7118 tpTop,tpBottom: DockRect.Right:=(DockRect.Left+DockRect.Right) div 2;
7119 tpLeft,tpRight: DockRect.Bottom:=(DockRect.Top+DockRect.Bottom) div 2;
7120 end;
7121 Offset:=DockSite.Pages.ClientOrigin;
7122 OffsetRect(DockRect,Offset.X,Offset.Y);
7123 exit;
7124 end;
7125 end;
7126
7127 Inside:=(DropCtl=Site);
7128 if (not Inside) and (Site.Parent<>nil) then begin
7129 if (Site.Parent is TAnchorDockHostSite)
7130 or (not (Site.Parent.DockManager is TAnchorDockManager))
7131 or (Site.Parent.Parent<>nil) then
7132 Inside:=true;
7133 end;
7134
7135 if Site is TAnchorDockPanel then begin
7136 DockRect:=Bounds(Site.ClientOrigin.x,Site.ClientOrigin.y,Site.ClientWidth,Site.ClientHeight);
7137 exit;
7138 end;
7139
7140 case DropAlign of
7141 alLeft:
7142 if Inside then
7143 DockRect:=Rect(0,0,Min(Client.Width,Site.ClientWidth div 2),Site.ClientHeight)
7144 else
7145 DockRect:=Rect(-Client.Width,0,0,Site.ClientHeight);
7146 alRight:
7147 if Inside then begin
7148 DockRect:=Rect(0,0,Min(Client.Width,Site.Width div 2),Site.ClientHeight);
7149 OffsetRect(DockRect,Site.ClientWidth-DockRect.Right,0);
7150 end else
7151 DockRect:=Bounds(Site.ClientWidth,0,Client.Width,Site.ClientHeight);
7152 alTop:
7153 if Inside then
7154 DockRect:=Rect(0,0,Site.ClientWidth,Min(Client.Height,Site.ClientHeight div 2))
7155 else
7156 DockRect:=Rect(0,-Client.Height,Site.ClientWidth,0);
7157 alBottom:
7158 if Inside then begin
7159 DockRect:=Rect(0,0,Site.ClientWidth,Min(Client.Height,Site.ClientHeight div 2));
7160 OffsetRect(DockRect,0,Site.ClientHeight-DockRect.Bottom);
7161 end else
7162 DockRect:=Bounds(0,Site.ClientHeight,Site.ClientWidth,Client.Height);
7163 alClient:
7164 begin
7165 // paged docking => show center
7166 if DockSite<>nil then
7167 DockRect:=DockSite.GetPageArea;
7168 end;
7169 else
7170 exit; // use default
7171 end;
7172 Offset:=Site.ClientOrigin;
7173 OffsetRect(DockRect,Offset.X,Offset.Y);
7174 end;
7175
7176 procedure TAnchorDockManager.RemoveControl(Control: TControl);
7177 var
7178 NewBounds: TRect;
7179 ChildSite: TAnchorDockHostSite;
7180 SplitterWidth: Integer;
7181 begin
7182 if DockSite<>nil then
7183 begin
7184 {$IFDEF VerboseAnchorDocking}
7185 debugln(['TAnchorDockManager.RemoveControl DockSite="',DockSite.Caption,'" Control=',DbgSName(Control)]);
7186 {$ENDIF}
7187 if DockSite.Minimized then
7188 DockSite.RemoveMinimizedControl;
7189 end
7190 else begin
7191 {$IFDEF VerboseAnchorDocking}
7192 debugln(['TAnchorDockManager.RemoveControl Site="',DbgSName(Site),'" Control=',DbgSName(Control)]);
7193 {$ENDIF}
7194 if Control is TAnchorDockHostSite then begin
7195 SplitterWidth:=0;
7196 if Control is TAnchorDockHostSite then begin
7197 ChildSite:=TAnchorDockHostSite(Control);
7198 if ChildSite.BoundSplitter<>nil then
7199 SplitterWidth:=DockMaster.SplitterWidth;
7200 end;
7201
7202 // shrink Site
7203 NewBounds:=Site.BoundsRect;
7204 case Control.Align of
7205 alTop: inc(NewBounds.Top,Control.Height+SplitterWidth);
7206 alBottom: dec(NewBounds.Bottom,Control.Height+SplitterWidth);
7207 alLeft: inc(NewBounds.Left,Control.Width+SplitterWidth);
7208 alRight: dec(NewBounds.Right,Control.Width+SplitterWidth);
7209 end;
7210 if StoredConstraintsValid then begin
7211 // restore constraints
7212 with Site.Constraints do begin
7213 MinWidth:=FStoredConstraints.Left;
7214 MinHeight:=FStoredConstraints.Top;
7215 MaxWidth:=FStoredConstraints.Right;
7216 MaxHeight:=FStoredConstraints.Bottom;
7217 end;
7218 FStoredConstraints:=Rect(0,0,0,0);
7219 end;
7220 Site.BoundsRect:=NewBounds;
7221 {$IFDEF VerboseAnchorDocking}
7222 debugln(['TAnchorDockManager.RemoveControl Site=',DbgSName(Site),' ',dbgs(Site.BoundsRect)]);
7223 {$ENDIF}
7224
7225 // Site can dock a control again
7226 DragManager.RegisterDockSite(Site,true);
7227 end;
7228 end;
7229 end;
7230
7231 procedure TAnchorDockManager.ResetBounds(Force: Boolean);
7232 var
7233 OldSiteClientRect: TRect;
7234 WidthDiff: Integer;
7235 HeightDiff: Integer;
7236 ClientRectChanged: Boolean;
7237
7238 procedure AlignChilds;
7239 var
7240 i: Integer;
7241 b: TRect;
7242 AControl: TControl;
7243 ChildMaxSize: TPoint;
7244 SiteMinSize: TPoint;
7245 Child: TAnchorDockHostSite;
7246 begin
7247 if ClientRectChanged and DockMaster.Restoring then begin
7248 // ClientRect changed => restore bounds
7249 for i:=0 to Site.ControlCount-1 do begin
7250 AControl:=Site.Controls[i];
7251 b:=Rect(0,0,0,0);
7252 if AControl is TAnchorDockHostSite then
7253 b:=TAnchorDockHostSite(AControl).DockRestoreBounds
7254 else if AControl is TAnchorDockSplitter then
7255 b:=TAnchorDockSplitter(AControl).DockRestoreBounds;
7256 if (b.Right<=b.Left) or (b.Bottom<=b.Top) then
7257 b:=AControl.BoundsRect;
7258 {$IFDEF VerboseAnchorDockRestore}
7259 debugln(['TAnchorDockManager.ResetBounds RESTORE ',DbgSName(AControl),' Cur=',dbgs(AControl.BoundsRect),' Restore=',dbgs(b)]);
7260 {$ENDIF}
7261 if AControl is TAnchorDockSplitter then begin
7262 // fit splitter into clientarea
7263 if AControl.AnchorSide[akLeft].Control=nil then
7264 b.Left:=Max(0,Min(b.Left,Site.ClientWidth-10));
7265 if AControl.AnchorSide[akTop].Control=nil then
7266 b.Top:=Max(0,Min(b.Top,Site.ClientHeight-10));
7267 if TAnchorDockSplitter(AControl).ResizeAnchor in [akLeft,akRight] then
7268 begin
7269 b.Right:=b.Left+DockMaster.SplitterWidth;
7270 b.Bottom:=Max(1,Min(b.Bottom,Site.ClientHeight-b.Top));
7271 end
7272 else begin
7273 b.Right:=Max(1,Min(b.Right,Site.ClientWidth-b.Left));
7274 b.Bottom:=b.Top+DockMaster.SplitterWidth;
7275 end;
7276 end;
7277
7278 AControl.BoundsRect:=b;
7279 if AControl is TAnchorDockSplitter then
7280 TAnchorDockSplitter(AControl).UpdateDockBounds;
7281 end;
7282 exit;
7283 end;
7284
7285 if DockSite<>nil then exit;
7286 Child:=GetChildSite;
7287 if Child=nil then exit;
7288
7289 {$IFDEF VerboseAnchorDockRestore}
7290 debugln(['TAnchorDockManager.ResetBounds ',DbgSName(Site),' ',dbgs(Child.BaseBounds),' ',WidthDiff,',',HeightDiff]);
7291 {$ENDIF}
7292 ChildMaxSize:=Point(Site.ClientWidth-DockMaster.SplitterWidth,
7293 Site.ClientHeight-DockMaster.SplitterWidth);
7294 if PreferredSiteSizeAsSiteMinimum then begin
7295 SiteMinSize:=GetSitePreferredClientSize;
7296 if Child.Align in [alLeft,alRight] then begin
7297 ChildMaxSize.X:=Max(0,(ChildMaxSize.X-SiteMinSize.X));
7298 end else begin
7299 ChildMaxSize.Y:=Max(0,(ChildMaxSize.Y-SiteMinSize.Y));
7300 end;
7301 {$IF defined(VerboseAnchorDockRestore) or defined(VerboseADCustomSite)}
7302 debugln(['TAnchorDockManager.ResetBounds ChildMaxSize=',dbgs(ChildMaxSize),' SiteMinSize=',dbgs(SiteMinSize),' Site.Client=',dbgs(Site.ClientRect)]);
7303 {$ENDIF}
7304 end;
7305
7306 case ResizePolicy of
7307 admrpChild:
7308 begin
7309 if Child.Parent is TAnchorDockPanel then
7310 //
7311 else begin
7312 if Child.Align in [alLeft,alRight] then
7313 Child.Width:=Max(1,Min(ChildMaxSize.X,Child.Width+WidthDiff))
7314 else begin
7315 i:=Max(1,Min(ChildMaxSize.Y,Child.Height+HeightDiff));
7316 {$IFDEF VerboseAnchorDockRestore}
7317 debugln(['TAnchorDockManager.ResetBounds Child=',DbgSName(Child),' OldHeight=',Child.Height,' NewHeight=',i]);
7318 {$ENDIF}
7319 Child.Height:=i;
7320 end;
7321 end;
7322 end;
7323 end;
7324 end;
7325
7326 begin
7327 if Force then ;
7328
7329 //debugln(['TAnchorDockManager.ResetBounds Site="',Site.Caption,'" Force=',Force,' ',dbgs(Site.ClientRect)]);
7330 OldSiteClientRect:=FSiteClientRect;
7331 FSiteClientRect:=Site.ClientRect;
7332 WidthDiff:=FSiteClientRect.Right-OldSiteClientRect.Right;
7333 HeightDiff:=FSiteClientRect.Bottom-OldSiteClientRect.Bottom;
7334 ClientRectChanged:=(WidthDiff<>0) or (HeightDiff<>0);
7335 if ClientRectChanged or PreferredSiteSizeAsSiteMinimum then
7336 AlignChilds;
7337 if ClientRectChanged then
7338 if DockMaster.FOverlappingForm<>nil then
7339 DockMaster.HideOverlappingForm(nil);
7340 end;
7341
7342 procedure TAnchorDockManager.SaveToStream(Stream: TStream);
7343 begin
7344 if Stream=nil then ;
7345 debugln(['TAnchorDockManager.SaveToStream not implemented Site="',DbgSName(Site),'"']);
7346 end;
7347
GetDockEdgenull7348 function TAnchorDockManager.GetDockEdge(ADockObject: TDragDockObject): boolean;
7349 var
7350 BestDistance: Integer;
7351
7352 procedure FindMinDistance(CurAlign: TAlign; CurDistance: integer);
7353 begin
7354 if CurDistance<0 then
7355 CurDistance:=-CurDistance;
7356 if CurDistance>=BestDistance then exit;
7357 ADockObject.DropAlign:=CurAlign;
7358 BestDistance:=CurDistance;
7359 end;
7360
7361 var
7362 p: TPoint;
7363 LastTabRect: TRect;
7364 TabIndex: longint;
7365 begin
7366 //debugln(['TAnchorDockManager.GetDockEdge ',DbgSName(Site),' ',DbgSName(DockSite),' DockableSites=',dbgs(DockableSites)]);
7367 if DockableSites=[] then begin
7368 ADockObject.DropAlign:=alNone;
7369 exit(false);
7370 end;
7371
7372 p:=Site.ScreenToClient(ADockObject.DragPos);
7373 //debugln(['TAnchorDockManager.GetDockEdge ',dbgs(p),' ',dbgs(Site.BoundsRect),' ',DbgSName(Site)]);
7374 if (DockSite<>nil) and (DockSite.Pages<>nil) then begin
7375 // page docking
7376 ADockObject.DropAlign:=alClient;
7377 p:=DockSite.Pages.ScreenToClient(ADockObject.DragPos);
7378 LastTabRect:=DockSite.Pages.TabRect(DockSite.Pages.PageCount-1);
7379 if (p.Y>=LastTabRect.Top) and (p.y<LastTabRect.Bottom) then begin
7380 // specific tab
7381 if p.X>=LastTabRect.Right then begin
7382 // insert as last
7383 ADockObject.DropOnControl:=DockSite.Pages;
7384 end else begin
7385 TabIndex:=DockSite.Pages.IndexOfPageAt(p);
7386 if TabIndex>=0 then begin
7387 // insert in front of an existing
7388 ADockObject.DropOnControl:=DockSite.Pages.Page[TabIndex];
7389 end;
7390 end;
7391 end;
7392 end else if (DockSite<>nil) and PtInRect(DockSite.GetPageArea,p) then begin
7393 // page docking
7394 ADockObject.DropAlign:=alClient;
7395 end else begin
7396
7397 // check side
7398 BestDistance:=High(Integer);
7399 if akLeft in DockableSites then FindMinDistance(alLeft,p.X);
7400 if akRight in DockableSites then FindMinDistance(alRight,Site.ClientWidth-p.X);
7401 if akTop in DockableSites then FindMinDistance(alTop,p.Y);
7402 if akBottom in DockableSites then FindMinDistance(alBottom,Site.ClientHeight-p.Y);
7403
7404 // check inside
7405 if InsideDockingAllowed
7406 and ( ((ADockObject.DropAlign=alLeft) and (p.X>=0))
7407 or ((ADockObject.DropAlign=alTop) and (p.Y>=0))
7408 or ((ADockObject.DropAlign=alRight) and (p.X<Site.ClientWidth))
7409 or ((ADockObject.DropAlign=alBottom) and (p.Y<Site.ClientHeight)) )
7410 then
7411 ADockObject.DropOnControl:=Site
7412 else
7413 ADockObject.DropOnControl:=nil;
7414 if Site is TAnchorDockHostSite then begin
7415 ADockObject.DropAlign:=AcceptAlign(Site as TAnchorDockHostSite,ADockObject.DropAlign);
7416 if ADockObject.DropAlign=alNone then
7417 exit(false);
7418 end;
7419 end;
7420 //debugln(['TAnchorDockManager.GetDockEdge ADockObject.DropAlign=',dbgs(ADockObject.DropAlign),' DropOnControl=',DbgSName(ADockObject.DropOnControl)]);
7421 Result:=true;
7422 end;
7423
7424 procedure TAnchorDockManager.RestoreSite(SplitterPos: integer);
7425 var
7426 ChildSite: TAnchorDockHostSite;
7427 begin
7428 FSiteClientRect:=Site.ClientRect;
7429 if DockSite<>nil then exit;
7430 ChildSite:=GetChildSite;
7431 {$IFDEF VerboseAnchorDockRestore}
7432 debugln(['TAnchorDockManager.RestoreSite START ',DbgSName(Site),' ChildSite=',DbgSName(ChildSite)]);
7433 {$ENDIF}
7434 if ChildSite<>nil then begin
7435 ChildSite.CreateBoundSplitter;
7436 ChildSite.PositionBoundSplitter;
7437 if ChildSite.Align in [alLeft,alRight] then
7438 ChildSite.BoundSplitter.Left:=SplitterPos
7439 else
7440 ChildSite.BoundSplitter.Top:=SplitterPos;
7441 case ChildSite.Align of
7442 alTop: ChildSite.Height:=ChildSite.BoundSplitter.Top;
7443 alBottom: ChildSite.Height:=Site.ClientHeight
7444 -(ChildSite.BoundSplitter.Top+ChildSite.BoundSplitter.Height);
7445 alLeft: ChildSite.Width:=ChildSite.BoundSplitter.Left;
7446 alRight: ChildSite.Width:=Site.ClientWidth
7447 -(ChildSite.BoundSplitter.Left+ChildSite.BoundSplitter.Width);
7448 end;
7449 // only allow to dock one control
7450 DragManager.RegisterDockSite(Site,false);
7451 {$IFDEF VerboseAnchorDockRestore}
7452 debugln(['TAnchorDockManager.RestoreSite ',DbgSName(Site),' ChildSite=',DbgSName(ChildSite),' Site.Bounds=',dbgs(Site.BoundsRect),' Site.Client=',dbgs(Site.ClientRect),' ChildSite.Bounds=',dbgs(ChildSite.BoundsRect),' Splitter.Bounds=',dbgs(ChildSite.BoundSplitter.BoundsRect)]);
7453 {$ENDIF}
7454 end;
7455 end;
7456
7457 procedure TAnchorDockManager.StoreConstraints;
7458 begin
7459 with Site.Constraints do
7460 FStoredConstraints:=Rect(MinWidth,MinHeight,MaxWidth,MaxHeight);
7461 end;
7462
GetSitePreferredClientSizenull7463 function TAnchorDockManager.GetSitePreferredClientSize: TPoint;
7464 { Compute the preferred inner size of Site without the ChildSite and without
7465 the splitter
7466 }
7467 var
7468 ChildSite: TAnchorDockHostSite;
7469 Splitter: TAnchorDockSplitter;
7470 SplitterSize: TPoint;
7471 i: Integer;
7472 ChildControl: TControl;
7473 PrefWidth: Integer;
7474 PrefHeight: Integer;
7475 SplitterAnchor: TAnchorKind; // side where a child is anchored to the splitter
7476 ChildPrefWidth: integer;
7477 ChildPrefHeight: integer;
7478 ChildBottom: Integer;
7479 ChildRight: Integer;
7480 begin
7481 Result:=Point(0,0);
7482 Site.GetPreferredSize(Result.X,Result.Y);
7483 // compute the bounds without the Splitter and ChildSite
7484 ChildSite:=GetChildSite;
7485 if ChildSite=nil then exit;
7486 Splitter:=ChildSite.BoundSplitter;
7487 if Splitter=nil then exit;
7488 SplitterSize:=Point(0,0);
7489 Splitter.GetPreferredSize(SplitterSize.X,SplitterSize.Y);
7490 PrefWidth:=0;
7491 PrefHeight:=0;
7492 if ChildSite.Align in [alLeft,alRight] then
7493 PrefHeight:=Result.Y
7494 else
7495 PrefWidth:=Result.X;
7496 SplitterAnchor:=MainAlignAnchor[ChildSite.Align];
7497 for i:=0 to Site.ControlCount-1 do begin
7498 ChildControl:=Site.Controls[i];
7499 if (ChildControl=Splitter) or (ChildControl=ChildSite) then continue;
7500 if (ChildControl.AnchorSide[SplitterAnchor].Control=Splitter)
7501 or ((ChildControl.Align in [alLeft,alTop,alRight,alBottom,alClient])
7502 and (SplitterAnchor in AnchorAlign[ChildControl.Align]))
7503 then begin
7504 // this control could be resized by the splitter
7505 // => use its position and preferred size for a preferred size of the ChildSite
7506 ChildPrefWidth:=0;
7507 ChildPrefHeight:=0;
7508 ChildControl.GetPreferredSize(ChildPrefWidth,ChildPrefHeight);
7509 //debugln([' ChildControl=',DbgSName(ChildControl),' ',ChildPrefWidth,',',ChildPrefHeight]);
7510 case ChildSite.Align of
7511 alTop:
7512 begin
7513 ChildBottom:=ChildControl.Top+ChildControl.Height;
7514 PrefHeight:=Max(PrefHeight,Site.ClientHeight-ChildBottom-ChildPrefHeight);
7515 end;
7516 alBottom:
7517 PrefHeight:=Max(PrefHeight,ChildControl.Top+ChildPrefHeight);
7518 alLeft:
7519 begin
7520 ChildRight:=ChildControl.Left+ChildControl.Width;
7521 PrefWidth:=Max(PrefWidth,Site.ClientWidth-ChildRight-ChildPrefWidth);
7522 end;
7523 alRight:
7524 PrefWidth:=Max(PrefWidth,ChildControl.Left+ChildPrefWidth);
7525 end;
7526 end;
7527 end;
7528 {$IFDEF VerboseADCustomSite}
7529 debugln(['TAnchorDockManager.GetSitePreferredClientSize DefaultSitePref=',dbgs(Result),' Splitter.Align=',dbgs(Splitter.Align),' ChildSite.Align=',dbgs(ChildSite.Align),' NewPref=',PrefWidth,',',PrefHeight]);
7530 {$ENDIF}
7531 Result.X:=PrefWidth;
7532 Result.Y:=PrefHeight;
7533 end;
7534
GetChildSitenull7535 function TAnchorDockManager.GetChildSite: TAnchorDockHostSite;
7536 var
7537 i: Integer;
7538 begin
7539 for i:=0 to Site.ControlCount-1 do
7540 if Site.Controls[i] is TAnchorDockHostSite then begin
7541 Result:=TAnchorDockHostSite(Site.Controls[i]);
7542 exit;
7543 end;
7544 Result:=nil;
7545 end;
7546
StoredConstraintsValidnull7547 function TAnchorDockManager.StoredConstraintsValid: boolean;
7548 begin
7549 with FStoredConstraints do
7550 Result:=(Left<>0) or (Top<>0) or (Right<>0) or (Bottom<>0);
7551 end;
7552
IsEnabledControlnull7553 function TAnchorDockManager.IsEnabledControl(Control: TControl):Boolean;
7554 begin
7555 Result := (DockMaster <> nil) and DockMaster.IsSite(Control);
7556 end;
7557
7558 { TAnchorDockSplitter }
7559
7560 procedure TAnchorDockSplitter.SetResizeAnchor(const AValue: TAnchorKind);
7561 begin
7562 inherited SetResizeAnchor(AValue);
7563
7564 case ResizeAnchor of
7565 akLeft: Anchors:=AnchorAlign[alLeft];
7566 akTop: Anchors:=AnchorAlign[alTop];
7567 akRight: Anchors:=AnchorAlign[alRight];
7568 akBottom: Anchors:=AnchorAlign[alBottom];
7569 end;
7570
7571 UpdatePercentPosition;
7572
7573 //debugln(['TAnchorDockSplitter.SetResizeAnchor ',DbgSName(Self),' ResizeAnchor=',dbgs(ResizeAnchor),' Align=',dbgs(Align),' Anchors=',dbgs(Anchors)]);
7574 end;
7575
7576 procedure TAnchorDockSplitter.SetParent(NewParent: TWinControl);
7577 begin
7578 if NewParent=nil then
7579 AsyncUpdateDockBounds:=false;
7580 inherited SetParent(NewParent);
7581 end;
7582
7583 procedure TAnchorDockSplitter.PopupMenuPopup(Sender: TObject);
7584 begin
7585
7586 end;
7587
7588 procedure TAnchorDockSplitter.OnAsyncUpdateDockBounds (Data: PtrInt);
7589 begin
7590 FAsyncUpdateDockBounds:=false;
7591 FPercentPosition:=-1;
7592 UpdateDockBounds;
7593 end;
7594
7595 procedure TAnchorDockSplitter.UpdateDockBounds;
7596 begin
7597 if csDestroying in ComponentState then exit;
7598 FDockBounds:=BoundsRect;
7599 if Parent<>nil then begin
7600 FDockParentClientSize.cx:=Parent.ClientWidth;
7601 FDockParentClientSize.cy:=Parent.ClientHeight;
7602 end else begin
7603 FDockParentClientSize.cx:=0;
7604 FDockParentClientSize.cy:=0;
7605 end;
7606 if FPercentPosition < 0 then
7607 UpdatePercentPosition;
7608 end;
7609
7610 procedure TAnchorDockSplitter.UpdatePercentPosition;
7611 begin
7612 case ResizeAnchor of
7613 akTop, akBottom:
7614 if FDockParentClientSize.cy > 0 then
7615 FPercentPosition := Top / FDockParentClientSize.cy
7616 else
7617 FPercentPosition := -1;
7618 else
7619 if FDockParentClientSize.cx > 0 then
7620 FPercentPosition := Left / FDockParentClientSize.cx
7621 else
7622 FPercentPosition := -1;
7623 end;
7624 end;
7625
7626 procedure TAnchorDockSplitter.SetAsyncUpdateDockBounds(const AValue: boolean);
7627 begin
7628 if FAsyncUpdateDockBounds=AValue then Exit;
7629 FAsyncUpdateDockBounds:=AValue;
7630 if FAsyncUpdateDockBounds then
7631 Application.QueueAsyncCall(@OnAsyncUpdateDockBounds,0)
7632 else
7633 Application.RemoveAsyncCalls(Self);
7634 end;
7635
7636 procedure TAnchorDockSplitter.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
7637 begin
7638 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockSplitter.SetBounds'){$ENDIF};
7639 try
7640 inherited SetBounds(ALeft, ATop, AWidth, AHeight);
7641 UpdateDockBounds;
7642 finally
7643 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockSplitter.SetBounds'){$ENDIF};
7644 end;
7645 end;
7646
7647 procedure TAnchorDockSplitter.SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer);
7648 begin
7649 inherited SetBounds(ALeft,ATop,AWidth,AHeight);
7650 end;
7651
7652 procedure TAnchorDockSplitter.SetBoundsPercentually;
7653 var
7654 NewLeft, NewTop: Integer;
7655 AControl: TControl;
7656 SplitterAnchorKind:TAnchorKind;
7657 begin
7658 if Enabled then begin
7659 if ResizeAnchor in [akLeft,akRight] then
7660 begin
7661 if DockParentClientSize.cx > 0 then
7662 begin
7663 if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then
7664 NewLeft := Round(FPercentPosition*Parent.ClientWidth)
7665 else
7666 NewLeft := (DockBounds.Left*Parent.ClientWidth) div DockParentClientSize.cx;
7667 NewTop := Top;
7668 SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height);
7669 end;
7670 end else
7671 begin
7672 if DockParentClientSize.cy > 0 then
7673 begin
7674 NewLeft := Left;
7675 if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then
7676 NewTop := Round(FPercentPosition*Parent.ClientHeight)
7677 else
7678 NewTop := (DockBounds.Top*Parent.ClientHeight) div DockParentClientSize.cy;
7679 SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height);
7680 end;
7681 end;
7682 if FPercentPosition < 0 then
7683 UpdatePercentPosition;
7684 end else begin
7685 SplitterAnchorKind:=akTop;
7686 AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind);
7687 if AControl=nil then begin
7688 SplitterAnchorKind:=akRight;
7689 AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind);
7690 end;
7691 if AControl=nil then begin
7692 SplitterAnchorKind:=akBottom;
7693 AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind);
7694 end;
7695 if AControl=nil then begin
7696 SplitterAnchorKind:=akLeft;
7697 AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind);
7698 end;
7699
7700 if AControl is TAnchorDockHostSite then begin
7701 (AControl as TAnchorDockHostSite).UpdateHeaderAlign;
7702 NewTop := (AControl as TAnchorDockHostSite).Header.Left;
7703 NewTop := (AControl as TAnchorDockHostSite).Header.Height;
7704 NewLeft := left;
7705 NewTop := top;
7706 (AControl as TAnchorDockHostSite).UpdateHeaderAlign;
7707 case SplitterAnchorKind of
7708 akTop: NewTop := AControl.Top+(AControl as TAnchorDockHostSite).Header.Height;
7709 akBottom: NewTop := AControl.Top+AControl.Height-(AControl as TAnchorDockHostSite).Header.Height-Height;
7710 akLeft: NewLeft := AControl.Left+(AControl as TAnchorDockHostSite).Header.Width;
7711 akRight: NewLeft := AControl.Left+AControl.Width-(AControl as TAnchorDockHostSite).Header.Width-Width;
7712 end;
7713 SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height);
7714 end;
7715 end;
7716 end;
7717
SideAnchoredControlCountnull7718 function TAnchorDockSplitter.SideAnchoredControlCount(Side: TAnchorKind): integer;
7719 var
7720 Sibling: TControl;
7721 i: Integer;
7722 begin
7723 Result:=0;
7724 for i:=0 to AnchoredControlCount-1 do begin
7725 Sibling:=AnchoredControls[i];
7726 if Sibling.AnchorSide[OppositeAnchor[Side]].Control=Self then
7727 inc(Result);
7728 end;
7729 end;
7730
HasAnchoredControlsnull7731 function TAnchorDockSplitter.HasAnchoredControls: boolean;
7732 // returns true if this splitter has at least one non splitter control anchored to it
7733 var
7734 i: Integer;
7735 Sibling: TControl;
7736 begin
7737 Result:=false;
7738 for i:=0 to AnchoredControlCount-1 do begin
7739 Sibling:=AnchoredControls[i];
7740 if Sibling is TAnchorDockSplitter then continue;
7741 exit(true);
7742 end;
7743 end;
7744
GetSpliterBoundsWithUnminimizedDockSitesnull7745 function TAnchorDockSplitter.GetSpliterBoundsWithUnminimizedDockSites:TRect;
7746 var
7747 NewLeft, NewTop: Integer;
7748 begin
7749 if ResizeAnchor in [akLeft,akRight] then
7750 begin
7751 if DockParentClientSize.cx > 0 then
7752 begin
7753 if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then
7754 NewLeft := Round(FPercentPosition*Parent.ClientWidth)
7755 else
7756 NewLeft := (DockBounds.Left*Parent.ClientWidth) div DockParentClientSize.cx;
7757 NewTop := Top;
7758 end;
7759 end else
7760 begin
7761 if DockParentClientSize.cy > 0 then
7762 begin
7763 NewLeft := Left;
7764 if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then
7765 NewTop := Round(FPercentPosition*Parent.ClientHeight)
7766 else
7767 NewTop := (DockBounds.Top*Parent.ClientHeight) div DockParentClientSize.cy;
7768 end;
7769 end;
7770 result:=Rect(NewLeft,NewTop,NewLeft+Width,NewTop+Height);
7771 end;
7772
7773 procedure TAnchorDockSplitter.SaveLayout(
7774 LayoutNode: TAnchorDockLayoutTreeNode);
7775 begin
7776 if ResizeAnchor in [akLeft,akRight] then
7777 LayoutNode.NodeType:=adltnSplitterVertical
7778 else
7779 LayoutNode.NodeType:=adltnSplitterHorizontal;
7780 LayoutNode.Assign(Self,false,false);
7781 if not Enabled then
7782 LayoutNode.BoundsRect:=GetSpliterBoundsWithUnminimizedDockSites;
7783 LayoutNode.PixelsPerInch:=Screen.PixelsPerInch;
7784 end;
7785
HasOnlyOneSiblingnull7786 function TAnchorDockSplitter.HasOnlyOneSibling(Side: TAnchorKind; MinPos,
7787 MaxPos: integer): TControl;
7788 var
7789 i: Integer;
7790 AControl: TControl;
7791 begin
7792 Result:=nil;
7793 for i:=0 to AnchoredControlCount-1 do begin
7794 AControl:=AnchoredControls[i];
7795 if AControl.AnchorSide[OppositeAnchor[Side]].Control<>Self then continue;
7796 // AControl is anchored at Side to this splitter
7797 if (Side in [akLeft,akRight]) then begin
7798 if (AControl.Left>MaxPos) or (AControl.Left+AControl.Width<MinPos) then
7799 continue;
7800 end else begin
7801 if (AControl.Top>MaxPos) or (AControl.Top+AControl.Height<MinPos) then
7802 continue;
7803 end;
7804 // AControl is in range
7805 if Result=nil then
7806 Result:=AControl
7807 else begin
7808 // there is more than one control
7809 Result:=nil;
7810 exit;
7811 end;
7812 end;
7813 end;
7814
7815 procedure TAnchorDockSplitter.MoveSplitter(Offset: integer);
7816 begin
7817 FPercentPosition:=-1;
7818 inherited MoveSplitter(Offset);
7819 UpdatePercentPosition;
7820 end;
7821
7822 procedure TAnchorDockSplitter.Paint;
7823 begin
7824 if Enabled then
7825 inherited Paint
7826 else
7827 begin
7828 Canvas.Brush.Color := clDefault;
7829 Canvas.FillRect(ClientRect);
7830 end;
7831 end;
7832
7833 constructor TAnchorDockSplitter.Create(TheOwner: TComponent);
7834 begin
7835 inherited Create(TheOwner);
7836 Align:=alNone;
7837 ResizeAnchor:=akLeft;
7838 // make sure the splitter never vanish
7839 Constraints.MinWidth:=2;
7840 Constraints.MinHeight:=2;
7841 PopupMenu:=DockMaster.GetPopupMenu;
7842 FPercentPosition:=-1;
7843 end;
7844
7845 destructor TAnchorDockSplitter.Destroy;
7846 begin
7847 AsyncUpdateDockBounds:=false;
7848 inherited Destroy;
7849 end;
7850
7851 { TAnchorDockPageControl }
7852
GetDockPagesnull7853 function TAnchorDockPageControl.GetDockPages(Index: integer): TAnchorDockPage;
7854 begin
7855 Result:=TAnchorDockPage(Page[Index]);
7856 end;
7857
7858 procedure TAnchorDockPageControl.MouseDown(Button: TMouseButton;
7859 Shift: TShiftState; X, Y: Integer);
7860 var
7861 ATabIndex: LongInt;
7862 APage: TCustomPage;
7863 Site: TAnchorDockHostSite;
7864 begin
7865 inherited MouseDown(Button, Shift, X, Y);
7866 ATabIndex := IndexOfPageAt(X, Y);
7867 if (Button = mbLeft) and DockMaster.AllowDragging and (ATabIndex >= 0) and (DockMaster.FOverlappingForm=nil) then
7868 begin
7869 APage:=Page[ATabIndex];
7870 if (APage.ControlCount>0) and (APage.Controls[0] is TAnchorDockHostSite) then
7871 begin
7872 Site:=TAnchorDockHostSite(APage.Controls[0]);
7873 DragManager.DragStart(Site,false,DockMaster.DragTreshold);
7874 end;
7875 end;
7876 if (Button = mbRight) then
7877 begin
7878 //select on right click
7879 if ATabIndex>=0 then
7880 PageIndex:=ATabIndex;
7881 end;
7882 end;
7883
7884 procedure TAnchorDockPageControl.PopupMenuPopup(Sender: TObject);
7885 var
7886 ContainsMainForm: Boolean;
7887 s: String;
7888 TabPositionSection: TMenuItem;
7889 Item: TMenuItem;
7890 tp: TTabPosition;
7891 begin
7892 // movement
7893 if PageIndex>0 then
7894 DockMaster.AddPopupMenuItem('MoveLeftMenuItem', adrsMovePageLeft,
7895 @MoveLeftButtonClick);
7896 if PageIndex>1 then
7897 DockMaster.AddPopupMenuItem('MoveLeftMostMenuItem', adrsMovePageLeftmost,
7898 @MoveLeftMostButtonClick);
7899
7900 if PageIndex<PageCount-1 then
7901 DockMaster.AddPopupMenuItem('MoveRightMenuItem', adrsMovePageRight,
7902 @MoveRightButtonClick);
7903 if PageIndex<PageCount-2 then
7904 DockMaster.AddPopupMenuItem('MoveRightMostMenuItem', adrsMovePageRightmost,
7905 @MoveRightMostButtonClick);
7906
7907 // tab position
7908 TabPositionSection:=DockMaster.AddPopupMenuItem('TabPositionMenuItem',
7909 adrsTabPosition,nil);
7910 for tp:=Low(TTabPosition) to high(TTabPosition) do begin
7911 case tp of
7912 tpTop: s:=adrsTop;
7913 tpBottom: s:=adrsBottom;
7914 tpLeft: s:=adrsLeft;
7915 tpRight: s:=adrsRight;
7916 end;
7917 Item:=DockMaster.AddPopupMenuItem('TabPos'+ADLTabPostionNames[tp]+'MenuItem',
7918 s,@TabPositionClick,TabPositionSection);
7919 Item.ShowAlwaysCheckable:=true;
7920 Item.Checked:=TabPosition=tp;
7921 Item.Tag:=ord(tp);
7922 end;
7923
7924 // close
7925 ContainsMainForm:=IsParentOf(Application.MainForm);
7926 if ContainsMainForm then
7927 s:=Format(adrsQuit, [Application.Title])
7928 else
7929 s:=adrsClose;
7930 DockMaster.AddPopupMenuItem('CloseMenuItem',s,@CloseButtonClick);
7931 end;
7932
7933 procedure TAnchorDockPageControl.CloseButtonClick(Sender: TObject);
7934 var
7935 Site: TAnchorDockHostSite;
7936 begin
7937 Site:=GetActiveSite;
7938 if Site=nil then exit;
7939 DockMaster.RestoreLayouts.Add(DockMaster.CreateRestoreLayout(Site),true);
7940 Site.CloseSite;
7941 DockMaster.SimplifyPendingLayouts;
7942 end;
7943
7944 procedure TAnchorDockPageControl.MoveLeftButtonClick(Sender: TObject);
7945 begin
7946 if PageIndex>0 then
7947 Page[PageIndex].PageIndex:=Page[PageIndex].PageIndex-1;
7948 end;
7949
7950 procedure TAnchorDockPageControl.MoveLeftMostButtonClick(Sender: TObject);
7951 begin
7952 if PageIndex>0 then
7953 Page[PageIndex].PageIndex:=0;
7954 end;
7955
7956 procedure TAnchorDockPageControl.MoveRightButtonClick(Sender: TObject);
7957 begin
7958 if PageIndex<PageCount-1 then
7959 Page[PageIndex].PageIndex:=Page[PageIndex].PageIndex+1;
7960 end;
7961
7962 procedure TAnchorDockPageControl.MoveRightMostButtonClick(Sender: TObject);
7963 begin
7964 if PageIndex<PageCount-1 then
7965 Page[PageIndex].PageIndex:=PageCount-1;
7966 end;
7967
7968 procedure TAnchorDockPageControl.TabPositionClick(Sender: TObject);
7969 var
7970 Item: TMenuItem;
7971 begin
7972 if not (Sender is TMenuItem) then exit;
7973 Item:=TMenuItem(Sender);
7974 TabPosition:=TTabPosition(Item.Tag);
7975 end;
7976
7977 procedure TAnchorDockPageControl.UpdateDockCaption(Exclude: TControl);
7978 begin
7979 if Exclude=nil then ;
7980 end;
7981
7982 procedure TAnchorDockPageControl.RemoveControl(AControl: TControl);
7983 begin
7984 inherited RemoveControl(AControl);
7985 if (not (csDestroying in ComponentState)) then begin
7986 if (PageCount<=1) and (Parent is TAnchorDockHostSite) then
7987 DockMaster.NeedSimplify(Parent);
7988 end;
7989 end;
7990
GetActiveSitenull7991 function TAnchorDockPageControl.GetActiveSite: TAnchorDockHostSite;
7992 var
7993 CurPage: TCustomPage;
7994 CurDockPage: TAnchorDockPage;
7995 begin
7996 Result:=nil;
7997 CurPage:=ActivePageComponent;
7998 if not (CurPage is TAnchorDockPage) then exit;
7999 CurDockPage:=TAnchorDockPage(CurPage);
8000 Result:=CurDockPage.GetSite;
8001 end;
8002
8003 constructor TAnchorDockPageControl.Create(TheOwner: TComponent);
8004 begin
8005 inherited Create(TheOwner);
8006 PopupMenu:=DockMaster.GetPopupMenu;
8007 end;
8008
GetPageClassnull8009 function TAnchorDockPageControl.GetPageClass: TCustomPageClass;
8010 begin
8011 Result:=DockMaster.PageClass;
8012 end;
8013
8014 { TAnchorDockOverlappingForm }
8015
8016 constructor TAnchorDockOverlappingForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
8017 begin
8018 inherited;
8019 BorderStyle:=bsNone;
8020 AnchorDockHostSite:=nil;
8021 Panel:=TPanel.Create(self);
8022 Panel.BorderStyle:=bsSingle;
8023 Panel.Align:=alClient;
8024 Panel.Parent:=self;
8025 Panel.Visible:=true;
8026 end;
8027
8028 { TAnchorDockPage }
8029
8030 procedure TAnchorDockPage.UpdateDockCaption(Exclude: TControl);
8031 var
8032 i: Integer;
8033 Child: TControl;
8034 NewCaption: String;
8035 begin
8036 NewCaption:='';
8037 for i:=0 to ControlCount-1 do begin
8038 Child:=Controls[i];
8039 if Child=Exclude then continue;
8040 if not (Child is TAnchorDockHostSite) then continue;
8041 if NewCaption<>'' then
8042 NewCaption:=NewCaption+',';
8043 NewCaption:=NewCaption+Child.Caption;
8044 end;
8045 //debugln(['TAnchorDockPage.UpdateDockCaption ',Caption,' ',NewCaption]);
8046 if Caption=NewCaption then exit;
8047 Caption:=NewCaption;
8048 if Parent is TAnchorDockPageControl then
8049 TAnchorDockPageControl(Parent).UpdateDockCaption;
8050 end;
8051
8052 procedure TAnchorDockPage.InsertControl(AControl: TControl; Index: integer);
8053 begin
8054 inherited InsertControl(AControl, Index);
8055 //debugln(['TAnchorDockPage.InsertControl ',DbgSName(AControl)]);
8056 if AControl is TAnchorDockHostSite then begin
8057 if TAnchorDockHostSite(AControl).Header<>nil then
8058 TAnchorDockHostSite(AControl).Header.Parent:=nil;
8059 UpdateDockCaption;
8060 end;
8061 end;
8062
8063 procedure TAnchorDockPage.RemoveControl(AControl: TControl);
8064 begin
8065 inherited RemoveControl(AControl);
8066 if (GetSite=nil) and (not (csDestroying in ComponentState))
8067 and (Parent<>nil) and (not (csDestroying in Parent.ComponentState)) then
8068 DockMaster.NeedSimplify(Self);
8069 end;
8070
GetSitenull8071 function TAnchorDockPage.GetSite: TAnchorDockHostSite;
8072 begin
8073 Result:=nil;
8074 if ControlCount=0 then exit;
8075 if not (Controls[0] is TAnchorDockHostSite) then exit;
8076 Result:=TAnchorDockHostSite(Controls[0]);
8077 end;
8078
8079 procedure DrawFrame3DHeader(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect;
8080 {%H-}Horizontal: boolean; {%H-}Focused: boolean);
8081 begin
8082 Canvas.Frame3d(r,2,bvLowered);
8083 Canvas.Frame3d(r,4,bvRaised);
8084 end;
8085
8086 procedure DrawFrameLine(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect;
8087 Horizontal: boolean; {%H-}Focused: boolean);
8088 var
8089 Center:integer;
8090 begin
8091 if Horizontal then
8092 begin
8093 Center:=r.Top+(r.Bottom-r.Top) div 2;
8094 Canvas.Pen.Color:=clltgray;
8095 Canvas.Line(r.Left+5,Center-1,r.Right-3,Center-1);
8096 Canvas.Pen.Color:=clgray;
8097 Canvas.Line(r.Left+5,Center,r.Right-3,Center);
8098 end else
8099 begin
8100 Center:=r.Right+(r.Left-r.Right) div 2;
8101 Canvas.Pen.Color:=clltgray;
8102 Canvas.Line(Center-1,r.Top+3,Center-1,r.Bottom-5);
8103 Canvas.Pen.Color:=clgray;
8104 Canvas.Line(Center,r.Top+3,Center,r.Bottom-5);
8105 end;
8106 end;
8107
8108 procedure DrawFrameLines(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect;
8109 Horizontal: boolean; {%H-}Focused: boolean);
8110 var
8111 lx,ly:integer;
8112 begin
8113 InflateRect(r,-2,-2);
8114 if Horizontal then
8115 begin
8116 lx:=0;
8117 ly:=3;
8118 r.Bottom:=r.top+(r.bottom-r.Top) div 3;
8119 r.top:=r.bottom-ly;
8120 end else
8121 begin
8122 lx:=3;
8123 ly:=0;
8124 r.Right:=r.Left+(r.Right-r.Left) div 3 ;
8125 r.Left:=r.Right-lx;
8126 end;
8127 DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT );
8128 OffsetRect(r,lx,ly);
8129 DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT );
8130 OffsetRect(r,lx,ly);
8131 DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT );
8132 end;
8133
8134 procedure DrawFramePoints(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect;
8135 Horizontal: boolean; {%H-}Focused: boolean);
8136 var
8137 lx,ly,d,lt,lb,lm:integer;
8138 begin
8139 if Horizontal then begin
8140 lx := r.left+2;
8141 d := (r.Bottom - r.Top - 5) div 2;
8142 lt := r.Top + d;
8143 lb := lt + 4;
8144 lm := lt + 2;
8145 while lx < r.Right do
8146 begin
8147 Canvas.Pixels[lx, lt] := clBtnShadow;
8148 Canvas.Pixels[lx, lb] := clBtnShadow;
8149 Canvas.Pixels[lx+2, lm] := clBtnShadow;
8150 lx := lx + 4;
8151 end;
8152 end else begin
8153 ly := r.Bottom - 2;
8154 d := (r.Right - r.Left - 5) div 2;
8155 lt := r.Left + d;
8156 lb := lt + 4;
8157 lm := lt + 2;
8158 while ly > r.Top do
8159 begin
8160 Canvas.Pixels[lt, ly] := clBtnShadow;
8161 Canvas.Pixels[lb, ly] := clBtnShadow;
8162 Canvas.Pixels[lm, ly-2] := clBtnShadow;
8163 ly := ly - 4;
8164 end;
8165 end;
8166 end;
8167
8168 procedure DrawFrameThemedCaption(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect;
8169 {%H-}Horizontal: boolean; Focused: boolean);
8170 var
8171 ted:TThemedElementDetails;
8172 begin
8173 if Focused then
8174 ted:=ThemeServices.GetElementDetails(twSmallCaptionActive)
8175 else
8176 ted:=ThemeServices.GetElementDetails(twSmallCaptionInactive);
8177 r.Bottom:=r.Bottom-3;
8178 ThemeServices.DrawElement(Canvas.Handle,ted, r);
8179 if Focused then
8180 ted:=ThemeServices.GetElementDetails(twSmallFrameBottomActive)
8181 else
8182 ted:=ThemeServices.GetElementDetails(twSmallFrameBottomInactive);
8183 r.Top:=r.Bottom;
8184 r.Bottom:=r.Bottom+3;
8185 ThemeServices.DrawElement(Canvas.Handle,ted, r);
8186 end;
8187
8188 procedure DrawFrameThemedButton(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect;
8189 {%H-}Horizontal: boolean; Focused: boolean);
8190 var
8191 ted:TThemedElementDetails;
8192 begin
8193 if Focused then
8194 ted:=ThemeServices.GetElementDetails(tbPushButtonHot)
8195 else
8196 ted:=ThemeServices.GetElementDetails(tbPushButtonNormal);
8197 ThemeServices.DrawElement(Canvas.Handle,ted, r);
8198 end;
8199
8200 initialization
8201 DockMaster:=TAnchorDockMaster.Create(nil);
8202 DockMaster.RegisterHeaderStyle('Frame3D', @DrawFrame3DHeader, true, true);
8203 DockMaster.RegisterHeaderStyle('Line', @DrawFrameLine, true, true);
8204 DockMaster.RegisterHeaderStyle('Lines', @DrawFrameLines, true, true);
8205 DockMaster.RegisterHeaderStyle('Points', @DrawFramePoints, true, true);
8206 DockMaster.RegisterHeaderStyle('ThemedCaption', @DrawFrameThemedCaption, false, false);
8207 DockMaster.RegisterHeaderStyle('ThemedButton', @DrawFrameThemedButton, false, false);
8208 DockTimer:=TTimer.Create(nil);
8209
8210 finalization
8211 FreeAndNil(DockMaster);
8212 FreeAndNil(DockTimer);
8213
8214 end.
8215
8216