{ Unit implementing anchor docking. Copyright (C) 2018 Mattias Gaertner mattias@freepascal.org This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version with the following modification: As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. Features: - dnd docking - preview rectangle while drag over - inside and outside docking - header with close button and hints - using stock item for close button glyph - auto header caption from content - hide header caption for floating form - auto site for headers to safe space (configurable) - bidimode for headers - page docking - pagecontrols uses TPageControl for native look&feel - page control is automatically removed if only one page left - scaling on resize (configurable) - auto insert splitters between controls (size configurable) - keep size when docking - header is automatically hidden when docked into page - save complete layout - restore layout: - close unneeded windows, - automatic clean up if windows are missing, - reusing existing docksites to minimize flickering - popup menu - close site - lock/unlock - header auto, left, top, right, bottom - undock (needed if no place to undock on screen) - merge (for example after moving a dock page into a layout) - enlarge side to left, top, right, bottom - move page left, right, leftmost, rightmost - close page - tab position (default, left, top, right, bottom) - options - dock site: MakeDockSite for forms, that should be able to dock other sites, but should not be docked themselves. Their Parent is always nil. - design time package for IDE - dnd move page index - dnd move page to another pagecontrol - on close button: save a restore layout - option to show/hide dock headers - option HeaderStyle to change appearance of grabbers - option MultiLine show pages tabs on multiple lines when needed - option FloatingWindowsOnTop MainDockForm has FormStyle fsNormal, all other not docked windows get FormStyle fsStayOnTop to not hide helper windows ToDo: - option to save on IDE close (if MainForm is visible on active screen) - restore: put MainForm on active screen - restore custom dock site splitter without resizing content, only resize docked site - undock on hide - popup menu - shrink side left, top, right, bottom - implement a simple way to make forms dockable at designtime without any code - on show again (hide form, show form): restore layout - close button for pages - event for drawing grabbers+headers - save/restore other splitters Parent bug with links to all other: - http://bugs.freepascal.org/view.php?id=18298 default layout sometimes wrong main bar Other bugs: - http://bugs.freepascal.org/view.php?id=19810 multi monitor } unit AnchorDocking; {$mode objfpc}{$H+} {$modeswitch advancedrecords} {$modeswitch typehelpers} // better use this definitions in project options, as it used in other units too { $DEFINE VerboseAnchorDockRestore} { $DEFINE VerboseADCustomSite} { $DEFINE VerboseAnchorDockPages} { $DEFINE VerboseAnchorDocking} { $DEFINE VerboseADFloatingWindowsOnTop} interface uses Types, Classes, SysUtils, Math, fgl, // LCL LCLType, LCLIntf, Controls, Forms, ExtCtrls, ComCtrls, Graphics, Themes, Menus, Buttons, // LazUtils LazLoggerBase, LazTracer, LazConfigStorage, Laz2_XMLCfg, LazFileCache, LazUTF8, // AnchorDocking AnchorDockStr, AnchorDockStorage, AnchorDockPanel; {$IFDEF DebugDisableAutoSizing} const ADAutoSizingReason = 'TAnchorDockMaster Delayed'; {$ENDIF} type TAnchorDockHostSite = class; { TAnchorDockCloseButton Close button used in TAnchorDockHeader, uses the close button glyph of the theme shrinked to a small size. The glyph is shared by all close buttons. } TAnchorDockCloseButton = class(TCustomSpeedButton) protected function GetDrawDetails: TThemedElementDetails; override; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override; public property OnPaint; end; TAnchorDockMinimizeButton = class(TCustomSpeedButton) protected function GetDrawDetails: TThemedElementDetails; override; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override; public property OnPaint; end; { TAnchorDockHeader The panel of a TAnchorDockHostSite containing the close button and the caption when the form is docked. The header can be shown at any of the four sides, shows a hint for long captions, starts dragging and shows the popup menu of the dockmaster. Hiding and aligning is done by its Parent, which is a TAnchorDockHostSite } THeaderStyleName=string; TADHeaderStyleDesc=record NeedDrawHeaderAfterText,NeedHighlightText:boolean; Name:THeaderStyleName; end; TDrawADHeaderProc= procedure (Canvas: TCanvas; Style: TADHeaderStyleDesc; r: TRect; Horizontal: boolean; Focused: boolean); TADHeaderStyle=record StyleDesc:TADHeaderStyleDesc; DrawProc:TDrawADHeaderProc; end; THeaderStyleName2ADHeaderStylesMap=specialize TFPGMap; type TAnchorDockHeader = class(TCustomPanel) private FCloseButton: TAnchorDockCloseButton; FMinimizeButton: TAnchorDockMinimizeButton; FHeaderPosition: TADLHeaderPosition; FFocused: Boolean; FUseTimer: Boolean; FMouseTimeStartX,FMouseTimeStartY:Integer; procedure ButtonPaint(Sender: TObject); procedure CloseButtonClick(Sender: TObject); procedure MinimizeButtonClick(Sender: TObject); procedure HeaderPositionItemClick(Sender: TObject); procedure UndockButtonClick(Sender: TObject); procedure MergeButtonClick(Sender: TObject); procedure EnlargeSideClick(Sender: TObject); procedure SetHeaderPosition(const AValue: TADLHeaderPosition); protected procedure Paint; override; procedure Draw(HeaderStyle:TADHeaderStyle); procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseLeave; override; procedure StartMouseNoMoveTimer; procedure StopMouseNoMoveTimer; procedure DoMouseNoMoveTimer(Sender: TObject); procedure UpdateHeaderControls; procedure SetAlign(Value: TAlign); override; procedure DoOnShowHint(HintInfo: PHintInfo); override; procedure PopupMenuPopup(Sender: TObject); virtual; public constructor Create(TheOwner: TComponent); override; property CloseButton: TAnchorDockCloseButton read FCloseButton; property MinimizeButton: TAnchorDockMinimizeButton read FMinimizeButton; property HeaderPosition: TADLHeaderPosition read FHeaderPosition write SetHeaderPosition; property BevelOuter default bvNone; end; TAnchorDockHeaderClass = class of TAnchorDockHeader; { TAnchorDockSplitter A TSplitter used on a TAnchorDockHostSite with SiteType=adhstLayout. It can store DockBounds, used by its parent to scale. Scaling works by moving the splitters. All other controls are fully anchored to these splitters or their parent. } TAnchorDockSplitter = class(TCustomSplitter) private FAsyncUpdateDockBounds: boolean; FCustomWidth: Boolean; FDockBounds: TRect; FDockParentClientSize: TSize; FDockRestoreBounds: TRect; FPercentPosition: Single; procedure SetAsyncUpdateDockBounds(const AValue: boolean); procedure UpdatePercentPosition; protected procedure OnAsyncUpdateDockBounds({%H-}Data: PtrInt); procedure SetResizeAnchor(const AValue: TAnchorKind); override; procedure SetParent(NewParent: TWinControl); override; procedure PopupMenuPopup(Sender: TObject); virtual; procedure Paint; override; public procedure MoveSplitter(Offset: integer); override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; property DockBounds: TRect read FDockBounds; property DockParentClientSize: TSize read FDockParentClientSize; procedure UpdateDockBounds; property AsyncUpdateDockBounds: boolean read FAsyncUpdateDockBounds write SetAsyncUpdateDockBounds; procedure ConstrainBounds(var ALeft, ATop, AWidth, AHeight: integer); procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; // any normal movement sets the DockBounds procedure SetBoundsPercentually; procedure SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer); // movement for scaling keeps the DockBounds function SideAnchoredControlCount(Side: TAnchorKind): integer; function HasAnchoredControls: boolean; function GetSpliterBoundsWithUnminimizedDockSites:TRect; procedure SaveLayout(LayoutNode: TAnchorDockLayoutTreeNode); function HasOnlyOneSibling(Side: TAnchorKind; MinPos, MaxPos: integer): TControl; property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds; property CustomWidth: Boolean read FCustomWidth write FCustomWidth; // Increase visibility of TCustomSplitter events: property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; end; TAnchorDockSplitterClass = class of TAnchorDockSplitter; TAnchorDockPageControl = class; { TAnchorDockPage A page of a TAnchorDockPageControl. } TAnchorDockPage = class(TCustomPage) public procedure UpdateDockCaption(Exclude: TControl = nil); override; procedure InsertControl(AControl: TControl; Index: integer); override; procedure RemoveControl(AControl: TControl); override; function GetSite: TAnchorDockHostSite; end; TAnchorDockPageClass = class of TAnchorDockPage; { TAnchorDockPageControl Used for page docking. The parent is always a TAnchorDockHostSite with SiteType=adhstPages. Its children are all TAnchorDockPage. It shows the DockMaster popup menu and starts dragging. } TAnchorDockPageControl = class(TCustomTabControl) private function GetDockPages(Index: integer): TAnchorDockPage; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; procedure PopupMenuPopup(Sender: TObject); virtual; procedure CloseButtonClick(Sender: TObject); virtual; procedure MoveLeftButtonClick(Sender: TObject); virtual; procedure MoveLeftMostButtonClick(Sender: TObject); virtual; procedure MoveRightButtonClick(Sender: TObject); virtual; procedure MoveRightMostButtonClick(Sender: TObject); virtual; procedure TabPositionClick(Sender: TObject); virtual; function GetPageClass: TCustomPageClass;override; public constructor Create(TheOwner: TComponent); override; procedure UpdateDockCaption(Exclude: TControl = nil); override; property DockPages[Index: integer]: TAnchorDockPage read GetDockPages; procedure InsertControl(AControl: TControl; Index: Integer); override; procedure RemoveControl(AControl: TControl); override; function GetActiveSite: TAnchorDockHostSite; end; TAnchorDockPageControlClass = class of TAnchorDockPageControl; TAnchorDockOverlappingForm = class(TCustomForm) public AnchorDockHostSite:TAnchorDockHostSite; Panel:TPanel; constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; end; { TAnchorDockHostSite This form is the dockhostsite for all controls. When docked together they build a tree structure with the docked controls as leaf nodes. A TAnchorDockHostSite has four modes: TAnchorDockHostSiteType } TAnchorDockHostSiteType = ( adhstNone, // fresh created, no control docked adhstOneControl, // a control and the "Header" (TAnchorDockHeader) adhstLayout, // several controls/TAnchorDockHostSite separated by TAnchorDockSplitters adhstPages // the "Pages" (TAnchorDockPageControl) with several pages ); TAnchorDockHostSite = class(TCustomForm) private FDockRestoreBounds: TRect; FHeader: TAnchorDockHeader; FHeaderSide: TAnchorKind; FPages: TAnchorDockPageControl; FSiteType: TAnchorDockHostSiteType; FBoundSplitter: TAnchorDockSplitter; FUpdateLayout: Integer; FMinimizedControl: TControl; procedure CheckFormStyle; procedure FirstShow(Sender: TObject); function GetMinimized: Boolean; procedure SetHeaderSide(const AValue: TAnchorKind); protected procedure DoEnter; override; procedure DoExit; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; function DoDockClientMsg(DragDockObject: TDragDockObject; aPosition: TPoint): boolean; override; function ExecuteDock(NewControl, DropOnControl: TControl; DockAlign: TAlign): boolean; virtual; function DockFirstControl(NewControl: TControl): boolean; virtual; function DockSecondControl(NewControl: TControl; DockAlign: TAlign; Inside: boolean): boolean; virtual; function DockAnotherControl(Sibling, NewControl: TControl; DockAlign: TAlign; Inside: boolean): boolean; virtual; procedure ChildVisibleChanged(Sender: TObject); virtual; procedure CreatePages; virtual; procedure FreePages; virtual; function DockSecondPage(NewControl: TControl): boolean; virtual; function DockAnotherPage(NewControl: TControl; InFrontOf: TControl): boolean; virtual; procedure AddCleanControl(AControl: TControl; TheAlign: TAlign = alNone); procedure RemoveControlFromLayout(AControl: TControl); procedure RemoveMinimizedControl; procedure RemoveSpiralSplitter(AControl: TControl); procedure ClearChildControlAnchorSides(AControl: TControl); procedure Simplify; procedure SimplifyPages; procedure SimplifyOneControl; function GetOneControl: TControl; function GetSiteCount: integer; function GetParentHostSite: TAnchorDockHostSite; function GetParentHostSiteOfTabbed(ASide: TAlign): TAnchorDockHostSite; function IsOneSiteLayout(out Site: TAnchorDockHostSite): boolean; function IsTwoSiteLayout(out Site1, Site2: TAnchorDockHostSite): boolean; function ControlHasSplitter(AControl: TControl; ASide: TAlign): boolean; function IsDockedPage(ASide: TAlign = alNone): boolean; function NestedDockedPageCount(ASide: TAlign = alNone): integer; // Nested anchor-page-controls (with no other controls in between) function GetUniqueSplitterName: string; function MakeSite(AControl: TControl): TAnchorDockHostSite; procedure MoveAllControls(dx, dy: integer); procedure AlignControls(AControl: TControl; var ARect: TRect); override; function CheckIfOneControlHidden: boolean; procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); override; procedure SetParent(NewParent: TWinControl); override; function HeaderNeedsShowing: boolean; procedure DoClose(var CloseAction: TCloseAction); override; function CanUndock: boolean; procedure Undock; function CanMerge: boolean; procedure Merge; function EnlargeSide(Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; function EnlargeSideResizeTwoSplitters(ShrinkSplitterSide, EnlargeSpitterSide: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; function EnlargeSideRotateSplitter(Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; procedure CreateBoundSplitter(Disabled: boolean=false); procedure PositionBoundSplitter; public constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; destructor Destroy; override; function CloseQuery: boolean; override; function CloseSite: boolean; virtual; procedure MinimizeSite; virtual; procedure AsyncMinimizeSite({%H-}Data: PtrInt); procedure ShowMinimizedControl; procedure HideMinimizedControl; procedure RemoveControl(AControl: TControl); override; procedure InsertControl(AControl: TControl; Index: integer); override; procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); override; function GetPageArea: TRect; function PointInOuterBorderArea(APoint: TPoint; AnAlign: TAlign; AWantedAreaCount: integer; out AnAreaIdx, AnAreaCount: integer): Boolean; procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); override; procedure UpdateDockCaption(Exclude: TControl = nil); override; procedure UpdateHeaderAlign; procedure UpdateHeaderShowing; function CanBeMinimized(out Splitter: TAnchorDockSplitter; out SplitterAnchorKind:TAnchorKind):boolean; procedure BeginUpdateLayout; procedure EndUpdateLayout; function UpdatingLayout: boolean; // save/restore layout procedure SaveLayout(LayoutTree: TAnchorDockLayoutTree; LayoutNode: TAnchorDockLayoutTreeNode); property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds; function GetDockEdge(const MousePos: TPoint): TAlign; override; property HeaderSide: TAnchorKind read FHeaderSide write SetHeaderSide; property Header: TAnchorDockHeader read FHeader; property Minimized: Boolean read GetMinimized; property MinimizedControl: TControl read FMinimizedControl; property Pages: TAnchorDockPageControl read FPages; property SiteType: TAnchorDockHostSiteType read FSiteType; property BoundSplitter: TAnchorDockSplitter read FBoundSplitter; end; TAnchorDockHostSiteClass = class of TAnchorDockHostSite; TADMResizePolicy = ( admrpNone, admrpChild // resize child ); { TAnchorDockManager A TDockManager is the LCL connector to catch various docking events for a TControl. Every TAnchorDockHostSite and every custom dock site gets one TAnchorDockManager. The LCL frees it automatically when the Site is freed. } TAnchorDockManager = class(TDockManager) private FDockableSites: TAnchors; FDockSite: TAnchorDockHostSite; FInsideDockingAllowed: boolean; FPreferredSiteSizeAsSiteMinimum: boolean; FRedirectToHostSite: TAnchorDockHostSite; FResizePolicy: TADMResizePolicy; FStoredConstraints: TRect; FSite: TWinControl; FSiteClientRect: TRect; procedure SetPreferredSiteSizeAsSiteMinimum(const AValue: boolean); public constructor Create(ADockSite: TWinControl); override; procedure GetControlBounds(Control: TControl; out AControlBounds: TRect); override; procedure InsertControl(Control: TControl; InsertAt: TAlign; DropCtl: TControl); override; overload; procedure InsertControl(ADockObject: TDragDockObject); override; overload; procedure LoadFromStream(Stream: TStream); override; procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign; var DockRect: TRect); override; overload; procedure RemoveControl(Control: TControl); override; procedure ResetBounds(Force: Boolean); override; procedure SaveToStream(Stream: TStream); override; function GetDockEdge(ADockObject: TDragDockObject): boolean; override; procedure RestoreSite(SplitterPos: integer); procedure StoreConstraints; function GetSitePreferredClientSize: TPoint; function IsEnabledControl(Control: TControl):Boolean; override; function CanBeDoubleDocked:Boolean; override; property Site: TWinControl read FSite; // the associated TControl (a TAnchorDockHostSite or a custom dock site) property DockSite: TAnchorDockHostSite read FDockSite; // if Site is a TAnchorDockHostSite, this is it property DockableSites: TAnchors read FDockableSites write FDockableSites; // at which sides can be docked property RedirectToHostSite: TAnchorDockHostSite read FRedirectToHostSite; property InsideDockingAllowed: boolean read FInsideDockingAllowed write FInsideDockingAllowed; // if true allow to put a site into the custom dock site function GetChildSite: TAnchorDockHostSite; // get first child TAnchorDockHostSite property ResizePolicy: TADMResizePolicy read FResizePolicy write FResizePolicy; property StoredConstraints: TRect read FStoredConstraints write FStoredConstraints; function StoredConstraintsValid: boolean; property PreferredSiteSizeAsSiteMinimum: boolean read FPreferredSiteSizeAsSiteMinimum write SetPreferredSiteSizeAsSiteMinimum; end; TAnchorDockManagerClass = class of TAnchorDockManager; { TAnchorDockSettings } type TAnchorDockSettings = class private FAllowDragging: boolean; FChangeStamp: integer; FDockOutsideMargin: integer; FDockParentMargin: integer; FDragTreshold: integer; FFloatingWindowsOnTop: boolean; FHeaderAlignLeft: integer; FHeaderAlignTop: integer; FHeaderHint: string; FHeaderStyle: THeaderStyleName; FHeaderFlatten: boolean; FHeaderFilled: boolean; FHeaderHighlightFocused: boolean; FHideHeaderCaptionFloatingControl: boolean; FMultiLinePages: boolean; FOuterBorderAreaInPercent: integer; FOuterBorderAreaMaxPixel: integer; FPageAreaInPercent: integer; FScaleOnResize: boolean; FShowHeader: boolean; FShowHeaderCaption: boolean; FSplitterWidth: integer; FDockSitesCanBeMinimized: boolean; FFlatHeadersButtons: boolean; procedure SetAllowDragging(AValue: boolean); procedure SetDockOutsideMargin(AValue: integer); procedure SetDockParentMargin(AValue: integer); procedure SetDragTreshold(AValue: integer); procedure SetFloatingWindowsOnTop(AValue: boolean); procedure SetHeaderAlignLeft(AValue: integer); procedure SetHeaderAlignTop(AValue: integer); procedure SetHeaderHint(AValue: string); procedure SetHeaderStyle(AValue: THeaderStyleName); procedure SetHideHeaderCaptionFloatingControl(AValue: boolean); procedure SetMultiLinePages(AValue: boolean); procedure SetOuterBorderAreaInPercent(AValue: integer); procedure SetOuterBorderAreaMaxPixel(AValue: integer); procedure SetPageAreaInPercent(AValue: integer); procedure SetScaleOnResize(AValue: boolean); procedure SetShowHeader(AValue: boolean); procedure SetShowHeaderCaption(AValue: boolean); procedure SetSplitterWidth(AValue: integer); procedure SetHeaderFlatten(AValue: boolean); procedure SetHeaderFilled(AValue: boolean); procedure SetHeaderHighlightFocused(AValue: boolean); procedure SetDockSitesCanBeMinimized(AValue: boolean); procedure SetFlatHeadersButtons(AValue: boolean); public property DragTreshold: integer read FDragTreshold write SetDragTreshold; property DockOutsideMargin: integer read FDockOutsideMargin write SetDockOutsideMargin; property DockParentMargin: integer read FDockParentMargin write SetDockParentMargin; property PageAreaInPercent: integer read FPageAreaInPercent write SetPageAreaInPercent; property OuterBorderAreaMaxPixel: integer read FOuterBorderAreaMaxPixel write SetOuterBorderAreaMaxPixel default 50; property OuterBorderAreaInPercent: integer read FOuterBorderAreaInPercent write SetOuterBorderAreaInPercent default 10; property HeaderAlignTop: integer read FHeaderAlignTop write SetHeaderAlignTop; property HeaderAlignLeft: integer read FHeaderAlignLeft write SetHeaderAlignLeft; property HeaderHint: string read FHeaderHint write SetHeaderHint; property SplitterWidth: integer read FSplitterWidth write SetSplitterWidth; property ScaleOnResize: boolean read FScaleOnResize write SetScaleOnResize; property ShowHeader: boolean read FShowHeader write SetShowHeader; property ShowHeaderCaption: boolean read FShowHeaderCaption write SetShowHeaderCaption; property HideHeaderCaptionFloatingControl: boolean read FHideHeaderCaptionFloatingControl write SetHideHeaderCaptionFloatingControl; property AllowDragging: boolean read FAllowDragging write SetAllowDragging; property HeaderStyle: THeaderStyleName read FHeaderStyle write SetHeaderStyle; property HeaderFlatten: boolean read FHeaderFlatten write SetHeaderFlatten; property HeaderFilled: boolean read FHeaderFilled write SetHeaderFilled; property HeaderHighlightFocused: boolean read FHeaderHighlightFocused write SetHeaderHighlightFocused; property DockSitesCanBeMinimized: boolean read FDockSitesCanBeMinimized write SetDockSitesCanBeMinimized; property FlatHeadersButtons: boolean read FFlatHeadersButtons write SetFlatHeadersButtons; property FloatingWindowsOnTop: boolean read FFloatingWindowsOnTop write SetFloatingWindowsOnTop; property MultiLinePages: boolean read FMultiLinePages write SetMultiLinePages; procedure IncreaseChangeStamp; inline; property ChangeStamp: integer read FChangeStamp; procedure LoadFromConfig(Config: TConfigStorage); overload; procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload; procedure SaveToConfig(Config: TConfigStorage); overload; procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload; function IsEqual(Settings: TAnchorDockSettings): boolean; reintroduce; procedure Assign(Source: TAnchorDockSettings); end; TMapMinimizedControls = specialize TFPGMap ; TAnchorDockMaster = class; { TAnchorDockMaster The central instance that connects all sites and manages all global settings. Its global variable is the DockMaster. Applications only need to talk to the DockMaster. } TADCreateControlEvent = procedure(Sender: TObject; aName: string; var AControl: TControl; DoDisableAutoSizing: boolean) of object; TADShowDockMasterOptionsEvent = function(aDockMaster: TAnchorDockMaster): TModalResult; { TStyleOfForm } TStyleOfForm = record Form: TCustomForm; FormStyle: TFormStyle; class operator = (Item1, Item2: TStyleOfForm): Boolean; end; { TFormStyles } TFormStyles = class(specialize TFPGList) public procedure AddForm(const AForm: TCustomForm); function IndexOfForm(const AForm: TCustomForm): Integer; procedure RemoveForm(const AForm: TCustomForm); end; TAnchorDockMaster = class(TComponent) private FAllowDragging: boolean; FControls: TFPList; // list of TControl, custom host sites and docked controls, not helper controls (e.g. TAnchorDock*) FDockOutsideMargin: integer; FDockParentMargin: integer; FDragTreshold: integer; FFloatingWindowsOnTop: boolean; FFormStyles: TFormStyles; FHeaderAlignLeft: integer; FHeaderAlignTop: integer; FHeaderClass: TAnchorDockHeaderClass; FHeaderHint: string; FHeaderStyle: THeaderStyleName; FHeaderFlatten: boolean; FHeaderFilled: boolean; FHeaderHighlightFocused: boolean; FDockSitesCanBeMinimized: boolean; FFlatHeadersButtons: boolean; FIdleConnected: Boolean; FManagerClass: TAnchorDockManagerClass; FMainDockForm: TCustomForm; FMultiLinePages: boolean; FOnCreateControl: TADCreateControlEvent; FOnOptionsChanged: TNotifyEvent; FOnShowOptions: TADShowDockMasterOptionsEvent; FOptionsChangeStamp: int64; FOuterBorderAreaInPercent: integer; FOuterBorderAreaMaxPixel: integer; FPageAreaInPercent: integer; FPageClass: TAnchorDockPageClass; FPageControlClass: TAnchorDockPageControlClass; FQueueSimplify: Boolean; FRestoreLayouts: TAnchorDockRestoreLayouts; FRestoring: boolean; FScaleOnResize: boolean; FShowHeader: boolean; FShowHeaderCaption: boolean; FHideHeaderCaptionFloatingControl: boolean; FShowMenuItemShowHeader: boolean; FSiteClass: TAnchorDockHostSiteClass; FSplitterClass: TAnchorDockSplitterClass; FSplitterWidth: integer; FMapMinimizedControls: TMapMinimizedControls; // minimized controls and previous parent fNeedSimplify: TFPList; // list of TControl fNeedFree: TFPList; // list of TControl fSimplifying: boolean; FAllClosing: Boolean; fUpdateCount: integer; fDisabledAutosizing: TFPList; // list of TControl fTreeNameToDocker: TADNameToControl; // TAnchorDockHostSite, TAnchorDockSplitter or custom docksite fPopupMenu: TPopupMenu; // Used by RestoreLayout: WorkArea, SrcWorkArea: TRect; FOverlappingForm:TAnchorDockOverlappingForm; CurrentADHeaderStyle:TADHeaderStyle; FHeaderStyleName2ADHeaderStyle:THeaderStyleName2ADHeaderStylesMap; procedure FormFirstShow(Sender: TObject); function GetControls(Index: integer): TControl; function GetLocalizedHeaderHint: string; function GetMainDockForm: TCustomForm; procedure MarkCorrectlyLocatedControl(Tree: TAnchorDockLayoutTree); function CloseUnneededAndWronglyLocatedControls(Tree: TAnchorDockLayoutTree): boolean; function CreateNeededControls(Tree: TAnchorDockLayoutTree; DisableAutoSizing: boolean; ControlNames: TStrings): boolean; function GetNodeSite(Node: TAnchorDockLayoutTreeNode): TAnchorDockHostSite; procedure MapTreeToControls(Tree: TAnchorDockLayoutTree); function RestoreLayout(Tree: TAnchorDockLayoutTree; Scale: boolean): boolean; procedure ScreenFormAdded(Sender: TObject; Form: TCustomForm); procedure ScreenRemoveForm(Sender: TObject; Form: TCustomForm); procedure SetMainDockForm(AValue: TCustomForm); procedure SetMinimizedState(Tree: TAnchorDockLayoutTree); procedure SetOuterBorderAreaInPercent(AValue: integer); procedure SetOuterBorderAreaMaxPixel(AValue: integer); procedure UpdateHeaders; procedure SetNodeMinimizedState(ANode: TAnchorDockLayoutTreeNode); procedure EnableAllAutoSizing; procedure ClearLayoutProperties(AControl: TControl; NewAlign: TAlign = alClient); procedure PopupMenuPopup(Sender: TObject); procedure ChangeLockButtonClick(Sender: TObject); procedure RefreshFloatingWindowsOnTop; function ScaleBoundsRect(ARect: TRect; FromDPI, ToDPI: integer): TRect; function ScaleChildX(p: integer): integer; function ScaleChildY(p: integer): integer; function ScaleTopLvlX(p: integer): integer; function ScaleTopLvlY(p: integer): integer; procedure SetAllowDragging(AValue: boolean); procedure SetDockOutsideMargin(AValue: integer); procedure SetDockParentMargin(AValue: integer); procedure SetDragTreshold(AValue: integer); procedure SetHeaderHint(AValue: string); procedure SetHeaderStyle(AValue: THeaderStyleName); procedure SetPageAreaInPercent(AValue: integer); procedure SetScaleOnResize(AValue: boolean); procedure SetHeaderFlatten(AValue: boolean); procedure SetHeaderFilled(AValue: boolean); procedure SetHeaderHighlightFocused(AValue: boolean); procedure SetDockSitesCanBeMinimized(AValue: boolean); procedure SetFlatHeadersButtons(AValue: boolean); procedure SetFloatingWindowsOnTop(AValue: boolean); procedure SetMultiLinePages(AValue: boolean); procedure SetShowMenuItemShowHeader(AValue: boolean); procedure SetupSite(Site: TWinControl; ANode: TAnchorDockLayoutTreeNode; AParent: TWinControl); procedure ShowHeadersButtonClick(Sender: TObject); procedure OptionsClick(Sender: TObject); procedure SetIdleConnected(const AValue: Boolean); procedure SetQueueSimplify(const AValue: Boolean); procedure SetRestoring(const AValue: boolean); procedure OptionsChanged; protected function DoCreateControl(aName: string; DisableAutoSizing: boolean): TControl; procedure AutoSizeAllHeaders(EnableAutoSizing: boolean); procedure DisableControlAutoSizing(AControl: TControl); procedure InvalidateHeaders; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetHeaderAlignLeft(const AValue: integer); procedure SetHeaderAlignTop(const AValue: integer); procedure SetShowHeader(AValue: boolean); procedure SetShowHeaderCaption(const AValue: boolean); procedure SetHideHeaderCaptionFloatingControl(const AValue: boolean); procedure SetSplitterWidth(const AValue: integer); procedure OnIdle(Sender: TObject; var Done: Boolean); procedure StartHideOverlappingTimer; procedure StopHideOverlappingTimer; procedure AsyncSimplify({%H-}Data: PtrInt); public procedure RegisterHeaderStyle(StyleName: THeaderStyleName; DrawProc:TDrawADHeaderProc; NeedDrawHeaderAfterText,NeedHighlightText: boolean); procedure ShowOverlappingForm; procedure HideOverlappingForm(Sender: TObject); constructor Create(AOwner: TComponent); override; destructor Destroy; override; function FullRestoreLayout(Tree: TAnchorDockLayoutTree; Scale: Boolean): Boolean; function ControlCount: integer; property Controls[Index: integer]: TControl read GetControls; function IndexOfControl(const aName: string): integer; function FindControl(const aName: string): TControl; function IsMinimizedControl(AControl: TControl; out Site: TAnchorDockHostSite): Boolean; function IsSite(AControl: TControl): boolean; function IsAnchorSite(AControl: TControl): boolean; function IsCustomSite(AControl: TControl): boolean; function GetSite(AControl: TControl): TCustomForm; function GetAnchorSite(AControl: TControl): TAnchorDockHostSite; function GetControl(Site: TControl): TControl; function IsFloating(AControl: TControl): Boolean; function GetPopupMenu: TPopupMenu; function AddPopupMenuItem(AName, ACaption: string; const OnClickEvent: TNotifyEvent; AParent: TMenuItem = nil): TMenuItem; virtual; function AddRemovePopupMenuItem(Add: boolean; AName, ACaption: string; const OnClickEvent: TNotifyEvent; AParent: TMenuItem = nil): TMenuItem; virtual; // show / make a control dockable procedure MakeDockable(AControl: TControl; Show: boolean = true; BringToFront: boolean = false; AddDockHeader: boolean = true); procedure MakeDockSite(AForm: TCustomForm; Sites: TAnchors; ResizePolicy: TADMResizePolicy; AllowInside: boolean = false); procedure MakeDockPanel(APanel: TAnchorDockPanel; ResizePolicy: TADMResizePolicy); procedure MakeVisible(AControl: TControl; SwitchPages: boolean); function ShowControl(ControlName: string; BringToFront: boolean = false): TControl; procedure CloseAll; // save/restore layouts procedure SaveLayoutToConfig(Config: TConfigStorage); procedure SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree); procedure SaveSiteLayoutToTree(AControl: TWinControl; LayoutTree: TAnchorDockLayoutTree); function CreateRestoreLayout(AControl: TControl): TAnchorDockRestoreLayout; function ConfigIsEmpty(Config: TConfigStorage): boolean; function LoadLayoutFromConfig(Config: TConfigStorage; Scale: Boolean): boolean; // layout information for restoring hidden forms property RestoreLayouts: TAnchorDockRestoreLayouts read FRestoreLayouts write FRestoreLayouts; property Restoring: boolean read FRestoring write SetRestoring; property IdleConnected: Boolean read FIdleConnected write SetIdleConnected; procedure LoadSettingsFromConfig(Config: TConfigStorage); procedure SaveSettingsToConfig(Config: TConfigStorage); procedure LoadSettings(Settings: TAnchorDockSettings); procedure SaveSettings(Settings: TAnchorDockSettings); function SettingsAreEqual(Settings: TAnchorDockSettings): boolean; procedure ResetSplitters; // manual docking procedure ManualFloat(AControl: TControl); procedure ManualDock(SrcSite: TAnchorDockHostSite; TargetSite: TCustomForm; Align: TAlign; TargetControl: TControl = nil); overload; procedure ManualDock(SrcSite: TAnchorDockHostSite; TargetPanel: TAnchorDockPanel; Align: TAlign; TargetControl: TControl = nil); overload; function ManualEnlarge(Site: TAnchorDockHostSite; Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; // simplification/garbage collection procedure BeginUpdate; procedure EndUpdate; function IsReleasing(AControl: TControl): Boolean; procedure NeedSimplify(AControl: TControl); procedure NeedFree(AControl: TControl); procedure SimplifyPendingLayouts; function AutoFreedIfControlIsRemoved(AControl, RemovedControl: TControl): boolean; function CreateSite(NamePrefix: string = ''; DisableAutoSizing: boolean = true): TAnchorDockHostSite; function CreateSplitter(NamePrefix: string = ''): TAnchorDockSplitter; property QueueSimplify: Boolean read FQueueSimplify write SetQueueSimplify; property OnCreateControl: TADCreateControlEvent read FOnCreateControl write FOnCreateControl; // options property OnShowOptions: TADShowDockMasterOptionsEvent read FOnShowOptions write FOnShowOptions; property OnOptionsChanged: TNotifyEvent read FOnOptionsChanged write FOnOptionsChanged; property DragTreshold: integer read FDragTreshold write SetDragTreshold default 4; property DockOutsideMargin: integer read FDockOutsideMargin write SetDockOutsideMargin default 10; // max distance for outside mouse snapping property DockParentMargin: integer read FDockParentMargin write SetDockParentMargin default 10; // max distance for snap to parent property FloatingWindowsOnTop: boolean read FFloatingWindowsOnTop write SetFloatingWindowsOnTop default false; property PageAreaInPercent: integer read FPageAreaInPercent write SetPageAreaInPercent default 40; // size of inner mouse snapping area for page docking property OuterBorderAreaMaxPixel: integer read FOuterBorderAreaMaxPixel write SetOuterBorderAreaMaxPixel default 50; // size of area for docking to the outside of a paged area (on each border) property OuterBorderAreaInPercent: integer read FOuterBorderAreaInPercent write SetOuterBorderAreaInPercent default 10; // size of area for docking to the outside of a paged area (percent of total size) property ShowHeader: boolean read FShowHeader write SetShowHeader default true; // set to false to hide all headers property ShowMenuItemShowHeader: boolean read FShowMenuItemShowHeader write SetShowMenuItemShowHeader default false; property ShowHeaderCaption: boolean read FShowHeaderCaption write SetShowHeaderCaption default true; // set to false to remove the text in the headers property HideHeaderCaptionFloatingControl: boolean read FHideHeaderCaptionFloatingControl write SetHideHeaderCaptionFloatingControl default true; // disables ShowHeaderCaption for floating controls property HeaderAlignTop: integer read FHeaderAlignTop write SetHeaderAlignTop default 80; // move header to top, when (width/height)*100<=HeaderAlignTop property HeaderAlignLeft: integer read FHeaderAlignLeft write SetHeaderAlignLeft default 120; // move header to left, when (width/height)*100>=HeaderAlignLeft property HeaderHint: string read FHeaderHint write SetHeaderHint; // if empty it uses resourcestring adrsDragAndDockC property HeaderStyle: THeaderStyleName read FHeaderStyle write SetHeaderStyle; property HeaderFlatten: boolean read FHeaderFlatten write SetHeaderFlatten default true; property HeaderFilled: boolean read FHeaderFilled write SetHeaderFilled default true; property HeaderHighlightFocused: boolean read FHeaderHighlightFocused write SetHeaderHighlightFocused default false; property DockSitesCanBeMinimized: boolean read FDockSitesCanBeMinimized write SetDockSitesCanBeMinimized default false; property FlatHeadersButtons: boolean read FFlatHeadersButtons write SetFlatHeadersButtons default false; property SplitterWidth: integer read FSplitterWidth write SetSplitterWidth default 4; property ScaleOnResize: boolean read FScaleOnResize write SetScaleOnResize default true; // scale children when resizing a site property AllowDragging: boolean read FAllowDragging write SetAllowDragging default true; property MultiLinePages: boolean read FMultiLinePages write SetMultiLinePages default false; property OptionsChangeStamp: int64 read FOptionsChangeStamp; procedure IncreaseOptionsChangeStamp; inline; // for descendants property SplitterClass: TAnchorDockSplitterClass read FSplitterClass write FSplitterClass; property SiteClass: TAnchorDockHostSiteClass read FSiteClass write FSiteClass; property ManagerClass: TAnchorDockManagerClass read FManagerClass write FManagerClass; property HeaderClass: TAnchorDockHeaderClass read FHeaderClass write FHeaderClass; property PageControlClass: TAnchorDockPageControlClass read FPageControlClass write FPageControlClass; property PageClass: TAnchorDockPageClass read FPageClass write FPageClass; property HeaderStyleName2ADHeaderStyle:THeaderStyleName2ADHeaderStylesMap read FHeaderStyleName2ADHeaderStyle; // for floating windows on top property MainDockForm: TCustomForm read GetMainDockForm write SetMainDockForm; end; var DockMaster: TAnchorDockMaster = nil; PreferredButtonWidth: Integer = -1; PreferredButtonHeight: Integer = -1; HardcodedButtonSize: Integer = 13; ButtonBorderSpacingAround: Integer = 2; function dbgs(SiteType: TAnchorDockHostSiteType): string; overload; procedure CopyAnchorBounds(Source, Target: TControl); procedure AnchorAndChangeBounds(AControl: TControl; Side: TAnchorKind; Target: TControl); function ControlsLeftTopOnScreen(AControl: TControl): TPoint; type TAnchorControlsRect = array[TAnchorKind] of TControl; function DockedControlIsVisible(Control: TControl): boolean; function GetDockSplitter(Control: TControl; Side: TAnchorKind; out Splitter: TAnchorDockSplitter): boolean; function GetDockSplitterOrParent(Control: TControl; Side: TAnchorKind; out AnchorControl: TControl): boolean; function CountAnchoredControls(Control: TControl; Side: TAnchorKind): Integer; function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl; Side: TAnchorKind): boolean; function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind; DestControl: TControl): boolean; procedure GetAnchorControlsRect(Control: TControl; out ARect: TAnchorControlsRect); function GetEnclosingControlRect(ControlList: TFPlist; out ARect: TAnchorControlsRect): boolean; function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList; implementation const IconsFont = 'Segoe MDL2 Assets'; TestTxt = 'ABCXYZ123gqj'; FlatPinnedSym = #$EE#$A1#$80{E840};//pinned FlatCrossSym = #$EE#$9C#$91{E711};//cross EmptyMouseTimeStartX = low(Integer); MouseNoMoveDelta = 5; MouseNoMoveTime = 500; HideOverlappingFormByMouseLoseTime = 500; OppositeAnchorKind2Align: array[TAnchorKind] of TAlign = ( alBottom, // akTop, alRight, // akLeft, alLeft, // akRight, alTop // akBottom ); OppositeAnchorKind: array[TAnchorKind] of TAnchorKind = ( akBottom, // akTop, akRight, // akLeft, akLeft, // akRight, akTop // akBottom ); {AnchorKind2Align: array[TAnchorKind] of TAlign = ( alTop, // akTop, alLeft, // akLeft, alRight,// akRight, alBottom// akBottom );} OppositeAnchorKind2TADLHeaderPosition: array[TAnchorKind] of TADLHeaderPosition = ( adlhpBottom, // akTop, adlhpRight, // akLeft, adlhpLeft, // akRight, adlhpTop // akBottom ); var DockTimer: TTimer = nil; function dbgs(SiteType: TAnchorDockHostSiteType): string; overload; begin case SiteType of adhstNone: Result:='None'; adhstOneControl: Result:='OneControl'; adhstLayout: Result:='Layout'; adhstPages: Result:='Pages'; else Result:='?'{%H-}; end; end; procedure CopyAnchorBounds(Source, Target: TControl); var a: TAnchorKind; begin Target.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('CopyAnchorBounds'){$ENDIF}; try Target.BoundsRect:=Source.BoundsRect; Target.Anchors:=Source.Anchors; Target.Align:=Source.Align; for a:=low(TAnchorKind) to high(TAnchorKind) do Target.AnchorSide[a].Assign(Source.AnchorSide[a]); finally Target.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('CopyAnchorBounds'){$ENDIF}; end; end; procedure AnchorAndChangeBounds(AControl: TControl; Side: TAnchorKind; Target: TControl); begin if Target=AControl.Parent then begin AControl.AnchorParallel(Side,0,Target); case Side of akTop: AControl.Top:=0; akLeft: AControl.Left:=0; akRight: AControl.Width:=AControl.Parent.ClientWidth-AControl.Left; akBottom: AControl.Height:=AControl.Parent.ClientHeight-AControl.Top; end; end else begin AControl.AnchorToNeighbour(Side,0,Target); case Side of akTop: AControl.Top:=Target.Top+Target.Height; akLeft: AControl.Left:=Target.Left+Target.Width; akRight: AControl.Width:=Target.Left-AControl.Width; akBottom: AControl.Height:=Target.Top-AControl.Height; end; end; end; function ControlsLeftTopOnScreen(AControl: TControl): TPoint; begin if AControl.Parent<>nil then begin Result:=AControl.Parent.ClientOrigin; inc(Result.X,AControl.Left); inc(Result.Y,AControl.Top); end else begin Result:=AControl.Parent.ClientOrigin; end; end; function DockedControlIsVisible(Control: TControl): boolean; begin while Control<>nil do begin if (not Control.IsControlVisible) and (not (Control is TAnchorDockPage)) then exit(false); Control:=Control.Parent; end; Result:=true; end; function GetDockSplitter(Control: TControl; Side: TAnchorKind; out Splitter: TAnchorDockSplitter): boolean; begin Result:=false; Splitter:=nil; if not Assigned(Control) or not (Side in Control.Anchors) then exit; Splitter:=TAnchorDockSplitter(Control.AnchorSide[Side].Control); if not (Splitter is TAnchorDockSplitter) then begin Splitter:=nil; exit; end; if Splitter.Parent<>Control.Parent then exit; Result:=true; end; function GetDockSplitterOrParent(Control: TControl; Side: TAnchorKind; out AnchorControl: TControl): boolean; begin Result:=false; AnchorControl:=nil; if not (Side in Control.Anchors) then exit; AnchorControl:=Control.AnchorSide[Side].Control; if (AnchorControl is TAnchorDockSplitter) and (AnchorControl.Parent=Control.Parent) then Result:=true else if AnchorControl=Control.Parent then Result:=true; end; function CountAnchoredControls(Control: TControl; Side: TAnchorKind): Integer; { return the number of siblings, that are anchored on Side of Control For example: if Side=akLeft it will return the number of controls, which right side is anchored to the left of Control } var i: Integer; Neighbour: TControl; begin Result:=0; for i:=0 to Control.AnchoredControlCount-1 do begin Neighbour:=Control.AnchoredControls[i]; if (OppositeAnchor[Side] in Neighbour.Anchors) and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then inc(Result); end; end; function CountAndReturnOnlyOneMinimizedAnchoredControls(Control: TControl; Side: TAnchorKind): TAnchorDockHostSite; var i,Counter: Integer; Neighbour: TControl; begin Counter:=0; for i:=0 to Control.AnchoredControlCount-1 do begin Neighbour:=Control.AnchoredControls[i]; if Neighbour.Visible then if Neighbour is TAnchorDockHostSite then if (OppositeAnchor[Side] in Neighbour.Anchors) and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then begin inc(Counter); result:=TAnchorDockHostSite(Neighbour); end; end; if (Counter=1) and (result is TAnchorDockHostSite) and ((result as TAnchorDockHostSite).Minimized) then else result:=Nil; end; function ReturnAnchoredControlsSize(Control: TControl; Side: TAnchorKind): integer; var i: Integer; Neighbour: TControl; begin result:=high(integer); for i:=0 to Control.AnchoredControlCount-1 do begin Neighbour:=Control.AnchoredControls[i]; if Neighbour.Visible then if Neighbour is TAnchorDockHostSite then if (OppositeAnchor[Side] in Neighbour.Anchors) and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=Control) then begin case Side of akTop,akBottom: if Neighbour.ClientHeightEnlargeControl.Left+EnlargeControl.Width+Splitter.Width+MinControlSize; akRight: // check if right side of Neighbour can be moved Result:=Neighbour.Left+MinControlSize+Splitter.WidthEnlargeControl.Top+EnlargeControl.Height+Splitter.Height+MinControlSize; akBottom: // check if bottom side of Neighbour can be moved Result:=Neighbour.Top+MinControlSize+Splitter.Heightnil) and Check(Parent.GetControlIndex(SideControl)) then exit(true); end; for i:=0 to AControl.AnchoredControlCount-1 do begin if Checked[i] then continue; SideControl:=AControl.AnchoredControls[i]; if OppositeAnchor[Side] in SideControl.Anchors then begin if (SideControl.AnchorSide[OppositeAnchor[Side]].Control=AControl) and Check(i) then exit(true); end; end; Result:=false; end; var i: Integer; begin if (StartControl=nil) or (DestControl=nil) or (StartControl.Parent=nil) or (StartControl.Parent<>DestControl.Parent) or (StartControl=DestControl) then exit(false); Parent:=StartControl.Parent; SetLength(Checked{%H-},Parent.ControlCount); for i:=0 to length(Checked)-1 do Checked[i]:=false; Result:=Check(Parent.GetControlIndex(StartControl)); end; procedure GetAnchorControlsRect(Control: TControl; out ARect: TAnchorControlsRect); var a: TAnchorKind; begin for a:=Low(TAnchorKind) to High(TAnchorKind) do ARect[a]:=Control.AnchorSide[a].Control; end; function GetEnclosingControlRect(ControlList: TFPlist; out ARect: TAnchorControlsRect): boolean; { ARect will be the minimum TAnchorControlsRect around the controls in the list returns true, if there is such a TAnchorControlsRect. The controls in ARect will either be the Parent or a TLazDockSplitter } var Parent: TWinControl; function ControlIsValidAnchor(Control: TControl; Side: TAnchorKind): boolean; var i: Integer; begin Result:=false; if (Control=ARect[Side]) then exit(true);// this allows Parent at the beginning if not (Control is TAnchorDockSplitter) then exit;// not a splitter if (TAnchorDockSplitter(Control).ResizeAnchor in [akLeft,akRight]) <>(Side in [akLeft,akRight]) then exit;// wrong alignment if ControlList.IndexOf(Control)>=0 then exit;// is an inner control if ControlIsAnchoredIndirectly(Control,Side,ARect[Side]) then exit; // this anchor would be worse than the current maximum for i:=0 to ControlList.Count-1 do begin if not ControlIsAnchoredIndirectly(Control,Side,TControl(ControlList[i])) then begin // this anchor is not above (below, ...) the inner controls exit; end; end; Result:=true; end; var TopIndex: Integer; TopControl: TControl; RightIndex: Integer; RightControl: TControl; BottomIndex: Integer; BottomControl: TControl; LeftIndex: Integer; LeftControl: TControl; Candidates: TFPList; i: Integer; a: TAnchorKind; begin Result:=false; if (ControlList=nil) or (ControlList.Count=0) then exit; // get Parent Parent:=TControl(ControlList[0]).Parent; if Parent=nil then exit; for i:=0 to ControlList.Count-1 do if TControl(ControlList[i]).Parent<>Parent then exit; // set the default rect: the Parent Result:=true; for a:=Low(TAnchorKind) to High(TAnchorKind) do ARect[a]:=Parent; // find all possible Candidates Candidates:=TFPList.Create; try Candidates.Add(Parent); for i:=0 to Parent.ControlCount-1 do if Parent.Controls[i] is TAnchorDockSplitter then Candidates.Add(Parent.Controls[i]); // now check every possible rectangle // Note: four loops seems to be dog slow, but the checks // avoid most possibilities early for TopIndex:=0 to Candidates.Count-1 do begin TopControl:=TControl(Candidates[TopIndex]); if not ControlIsValidAnchor(TopControl,akTop) then continue; for RightIndex:=0 to Candidates.Count-1 do begin RightControl:=TControl(Candidates[RightIndex]); if (TopControl.AnchorSide[akRight].Control<>RightControl) and (RightControl.AnchorSide[akTop].Control<>TopControl) then continue; // not touching / not a corner if not ControlIsValidAnchor(RightControl,akRight) then continue; for BottomIndex:=0 to Candidates.Count-1 do begin BottomControl:=TControl(Candidates[BottomIndex]); if (RightControl.AnchorSide[akBottom].Control<>BottomControl) and (BottomControl.AnchorSide[akRight].Control<>RightControl) then continue; // not touching / not a corner if not ControlIsValidAnchor(BottomControl,akBottom) then continue; for LeftIndex:=0 to Candidates.Count-1 do begin LeftControl:=TControl(Candidates[LeftIndex]); if (BottomControl.AnchorSide[akLeft].Control<>LeftControl) and (LeftControl.AnchorSide[akBottom].Control<>BottomControl) then continue; // not touching / not a corner if (TopControl.AnchorSide[akLeft].Control<>LeftControl) and (LeftControl.AnchorSide[akTop].Control<>LeftControl) then continue; // not touching / not a corner if not ControlIsValidAnchor(LeftControl,akLeft) then continue; // found a better rectangle ARect[akLeft] :=LeftControl; ARect[akRight] :=RightControl; ARect[akTop] :=TopControl; ARect[akBottom]:=BottomControl; end; end; end; end; finally Candidates.Free; end; end; function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList; { return a list of all controls bounded by the anchors in ARect } var Parent: TWinControl; procedure Fill(AControl: TControl); var a: TAnchorKind; SideControl: TControl; i: Integer; begin if AControl=nil then exit; if AControl=Parent then exit;// do not add Parent for a:=Low(TAnchorKind) to High(TAnchorKind) do if ARect[a]=AControl then exit;// do not add boundary if Result.IndexOf(AControl)>=0 then exit;// already added Result.Add(AControl); for a:=Low(TAnchorKind) to High(TAnchorKind) do Fill(AControl.AnchorSide[a].Control); for i:=0 to Parent.ControlCount-1 do begin SideControl:=Parent.Controls[i]; for a:=Low(TAnchorKind) to High(TAnchorKind) do if SideControl.AnchorSide[a].Control=AControl then Fill(SideControl); end; end; var i: Integer; AControl: TControl; LeftTopControl: TControl; begin Result:=TFPList.Create; // find the Parent if (ARect[akLeft]=ARect[akRight]) and (ARect[akLeft] is TWinControl) then Parent:=TWinControl(ARect[akLeft]) else Parent:=ARect[akLeft].Parent; // find the left, top most control for i:=0 to Parent.ControlCount-1 do begin AControl:=Parent.Controls[i]; if (AControl.AnchorSide[akLeft].Control=ARect[akLeft]) and (AControl.AnchorSide[akTop].Control=ARect[akTop]) then begin LeftTopControl:=AControl; break; end; end; if Result.Count=0 then exit; // use flood fill to find the rest Fill(LeftTopControl); end; { TAnchorDockSettings } procedure TAnchorDockSettings.SetAllowDragging(AValue: boolean); begin if FAllowDragging=AValue then Exit; FAllowDragging:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetDockOutsideMargin(AValue: integer); begin if FDockOutsideMargin=AValue then Exit; FDockOutsideMargin:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetDockParentMargin(AValue: integer); begin if FDockParentMargin=AValue then Exit; FDockParentMargin:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetDragTreshold(AValue: integer); begin if FDragTreshold=AValue then Exit; FDragTreshold:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetFloatingWindowsOnTop(AValue: boolean); begin if FFloatingWindowsOnTop=AValue then Exit; FFloatingWindowsOnTop:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderAlignLeft(AValue: integer); begin if FHeaderAlignLeft=AValue then Exit; FHeaderAlignLeft:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderAlignTop(AValue: integer); begin if FHeaderAlignTop=AValue then Exit; FHeaderAlignTop:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderHint(AValue: string); begin if FHeaderHint=AValue then Exit; FHeaderHint:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderStyle(AValue: THeaderStyleName); begin if FHeaderStyle=AValue then Exit; // the next two lines can be removed in Lazarus 2.4.0 upwards - there should no old // environmentoptions.xml be out there anymore - see https://bugs.freepascal.org/view.php?id=38960 if AValue='Themed caption' then AValue:='ThemedCaption'; if AValue='Themed button' then AValue:='ThemedButton'; FHeaderStyle:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHideHeaderCaptionFloatingControl( AValue: boolean); begin if FHideHeaderCaptionFloatingControl=AValue then Exit; FHideHeaderCaptionFloatingControl:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetMultiLinePages(AValue: boolean); begin if FMultiLinePages = AValue then Exit; FMultiLinePages := AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetOuterBorderAreaInPercent(AValue: integer); begin if FOuterBorderAreaInPercent = AValue then Exit; FOuterBorderAreaInPercent := AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetOuterBorderAreaMaxPixel(AValue: integer); begin if FOuterBorderAreaMaxPixel = AValue then Exit; FOuterBorderAreaMaxPixel := AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetPageAreaInPercent(AValue: integer); begin if FPageAreaInPercent=AValue then Exit; FPageAreaInPercent:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetScaleOnResize(AValue: boolean); begin if FScaleOnResize=AValue then Exit; FScaleOnResize:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderFlatten(AValue: boolean); begin if FHeaderFlatten=AValue then Exit; FHeaderFlatten:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderFilled(AValue: boolean); begin if FHeaderFilled=AValue then Exit; FHeaderFilled:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHeaderHighlightFocused(AValue: boolean); begin if FHeaderHighlightFocused=AValue then Exit; FHeaderHighlightFocused:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetShowHeader(AValue: boolean); begin if FShowHeader=AValue then Exit; FShowHeader:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetShowHeaderCaption(AValue: boolean); begin if FShowHeaderCaption=AValue then Exit; FShowHeaderCaption:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetSplitterWidth(AValue: integer); begin if FSplitterWidth=AValue then Exit; FSplitterWidth:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetDockSitesCanBeMinimized(AValue: boolean); begin if FDockSitesCanBeMinimized=AValue then Exit; FDockSitesCanBeMinimized:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetFlatHeadersButtons(AValue: boolean); begin if FFlatHeadersButtons=AValue then Exit; FFlatHeadersButtons:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.Assign(Source: TAnchorDockSettings); begin FChangeStamp := Source.FChangeStamp; FAllowDragging := Source.FAllowDragging; FDockOutsideMargin := Source.FDockOutsideMargin; FDockParentMargin := Source.FDockParentMargin; FDockSitesCanBeMinimized := Source.FDockSitesCanBeMinimized; FlatHeadersButtons := Source.FlatHeadersButtons; FDragTreshold := Source.FDragTreshold; FFloatingWindowsOnTop := Source.FFloatingWindowsOnTop; FHeaderAlignLeft := Source.FHeaderAlignLeft; FHeaderAlignTop := Source.FHeaderAlignTop; FHeaderFilled := Source.FHeaderFilled; FHeaderFlatten := Source.FHeaderFlatten; FHeaderHighlightFocused := Source.FHeaderHighlightFocused; FHeaderHint := Source.FHeaderHint; FHeaderStyle := Source.FHeaderStyle; FHideHeaderCaptionFloatingControl := Source.FHideHeaderCaptionFloatingControl; FMultiLinePages := Source.FMultiLinePages; FPageAreaInPercent := Source.FPageAreaInPercent; FOuterBorderAreaMaxPixel := Source.FOuterBorderAreaMaxPixel; FOuterBorderAreaInPercent := Source.FOuterBorderAreaInPercent; FScaleOnResize := Source.FScaleOnResize; FShowHeader := Source.FShowHeader; FShowHeaderCaption := Source.FShowHeaderCaption; FSplitterWidth := Source.FSplitterWidth; end; procedure TAnchorDockSettings.IncreaseChangeStamp; begin LUIncreaseChangeStamp(fChangeStamp); end; procedure TAnchorDockSettings.LoadFromConfig(Config: TConfigStorage); begin Config.AppendBasePath('Settings/'); AllowDragging := Config.GetValue('AllowDragging',true); DockOutsideMargin := Config.GetValue('DockOutsideMargin',10); DockParentMargin := Config.GetValue('DockParentMargin',10); DockSitesCanBeMinimized := Config.GetValue('DockSitesCanBeMinimized',False); FlatHeadersButtons := Config.GetValue('FlatHeadersButtons',False); DragTreshold := Config.GetValue('DragThreshold',4); FloatingWindowsOnTop := Config.GetValue('FloatingWindowsOnTop',false); HeaderAlignLeft := Config.GetValue('HeaderAlignLeft',120); HeaderAlignTop := Config.GetValue('HeaderAlignTop',80); HeaderFilled := Config.GetValue('HeaderFilled',true); HeaderFlatten := Config.GetValue('HeaderFlatten',true); HeaderHighlightFocused := Config.GetValue('HeaderHighlightFocused',False); HeaderStyle := Config.GetValue('HeaderStyle','Frame3D'); HideHeaderCaptionFloatingControl := Config.GetValue('HideHeaderCaptionFloatingControl',true); MultiLinePages := Config.GetValue('MultiLinePages',false); PageAreaInPercent := Config.GetValue('PageAreaInPercent',40); OuterBorderAreaMaxPixel := Config.GetValue('OuterBorderAreaMaxPixel',50); OuterBorderAreaInPercent := Config.GetValue('OuterBorderAreaInPercent',10); ScaleOnResize := Config.GetValue('ScaleOnResize',true); ShowHeader := Config.GetValue('ShowHeader',true); ShowHeaderCaption := Config.GetValue('ShowHeaderCaption',true); SplitterWidth := Config.GetValue('SplitterWidth',4); Config.UndoAppendBasePath; end; procedure TAnchorDockSettings.SaveToConfig(Path: string; Config: TRttiXMLConfig); begin Config.SetDeleteValue(Path+'AllowDragging',AllowDragging,true); Config.SetDeleteValue(Path+'DockOutsideMargin',DockOutsideMargin,10); Config.SetDeleteValue(Path+'DockParentMargin',DockParentMargin,10); Config.SetDeleteValue(Path+'DockSitesCanBeMinimized',DockSitesCanBeMinimized,False); Config.SetDeleteValue(Path+'FlatHeadersButtons',FlatHeadersButtons,False); Config.SetDeleteValue(Path+'DragThreshold',DragTreshold,4); Config.SetDeleteValue(Path+'FloatingWindowsOnTop',FloatingWindowsOnTop,false); Config.SetDeleteValue(Path+'HeaderAlignLeft',HeaderAlignLeft,120); Config.SetDeleteValue(Path+'HeaderAlignTop',HeaderAlignTop,80); Config.SetDeleteValue(Path+'HeaderFilled',HeaderFilled,true); Config.SetDeleteValue(Path+'HeaderFlatten',HeaderFlatten,true); Config.SetDeleteValue(Path+'HeaderHighlightFocused',HeaderHighlightFocused,False); Config.SetDeleteValue(Path+'HeaderStyle',HeaderStyle,'Frame3D'); Config.SetDeleteValue(Path+'HideHeaderCaptionFloatingControl',HideHeaderCaptionFloatingControl,true); Config.SetDeleteValue(Path+'MultiLinePages',MultiLinePages,false); Config.SetDeleteValue(Path+'PageAreaInPercent',PageAreaInPercent,40); Config.SetDeleteValue(Path+'OuterBorderAreaMaxPixel',OuterBorderAreaMaxPixel,50); Config.SetDeleteValue(Path+'OuterBorderAreaInPercent',OuterBorderAreaInPercent,10); Config.SetDeleteValue(Path+'ScaleOnResize',ScaleOnResize,true); Config.SetDeleteValue(Path+'ShowHeader',ShowHeader,true); Config.SetDeleteValue(Path+'ShowHeaderCaption',ShowHeaderCaption,true); Config.SetDeleteValue(Path+'SplitterWidth',SplitterWidth,4); end; procedure TAnchorDockSettings.SaveToConfig(Config: TConfigStorage); begin Config.AppendBasePath('Settings/'); Config.SetDeleteValue('AllowDragging',AllowDragging,true); Config.SetDeleteValue('DockOutsideMargin',DockOutsideMargin,10); Config.SetDeleteValue('DockParentMargin',DockParentMargin,10); Config.SetDeleteValue('DockSitesCanBeMinimized',DockSitesCanBeMinimized,False); Config.SetDeleteValue('FlatHeadersButtons',DockSitesCanBeMinimized,False); Config.SetDeleteValue('DragThreshold',DragTreshold,4); Config.SetDeleteValue('FloatingWindowsOnTop',FloatingWindowsOnTop,false); Config.SetDeleteValue('HeaderAlignLeft',HeaderAlignLeft,120); Config.SetDeleteValue('HeaderAlignTop',HeaderAlignTop,80); Config.SetDeleteValue('HeaderFilled',HeaderFilled,true); Config.SetDeleteValue('HeaderFlatten',HeaderFlatten,true); Config.SetDeleteValue('HeaderHighlightFocused',HeaderHighlightFocused,False); Config.SetDeleteValue('HeaderStyle',HeaderStyle,'Frame3D'); Config.SetDeleteValue('HideHeaderCaptionFloatingControl',HideHeaderCaptionFloatingControl,true); Config.SetDeleteValue('MultiLinePages',MultiLinePages,false); Config.SetDeleteValue('PageAreaInPercent',PageAreaInPercent,40); Config.SetDeleteValue('OuterBorderAreaMaxPixel',OuterBorderAreaMaxPixel,50); Config.SetDeleteValue('OuterBorderAreaInPercent',OuterBorderAreaInPercent,10); Config.SetDeleteValue('ScaleOnResize',ScaleOnResize,true); Config.SetDeleteValue('ShowHeader',ShowHeader,true); Config.SetDeleteValue('ShowHeaderCaption',ShowHeaderCaption,true); Config.SetDeleteValue('SplitterWidth',SplitterWidth,4); Config.UndoAppendBasePath; end; function TAnchorDockSettings.IsEqual(Settings: TAnchorDockSettings): boolean; begin Result:=(AllowDragging=Settings.AllowDragging) and (DockOutsideMargin=Settings.DockOutsideMargin) and (DockParentMargin=Settings.DockParentMargin) and (DockSitesCanBeMinimized=Settings.DockSitesCanBeMinimized) and (FlatHeadersButtons=Settings.FlatHeadersButtons) and (DragTreshold=Settings.DragTreshold) and (FloatingWindowsOnTop=Settings.FloatingWindowsOnTop) and (HeaderAlignLeft=Settings.HeaderAlignLeft) and (HeaderAlignTop=Settings.HeaderAlignTop) and (HeaderFilled=Settings.HeaderFilled) and (HeaderFlatten=Settings.HeaderFlatten) and (HeaderHighlightFocused=Settings.HeaderHighlightFocused) and (HeaderHint=Settings.HeaderHint) and (HeaderStyle=Settings.HeaderStyle) and (HideHeaderCaptionFloatingControl=Settings.HideHeaderCaptionFloatingControl) and (MultiLinePages=Settings.MultiLinePages) and (PageAreaInPercent=Settings.PageAreaInPercent) and (OuterBorderAreaMaxPixel=Settings.OuterBorderAreaMaxPixel) and (OuterBorderAreaInPercent=Settings.OuterBorderAreaInPercent) and (ScaleOnResize=Settings.ScaleOnResize) and (ShowHeader=Settings.ShowHeader) and (ShowHeaderCaption=Settings.ShowHeaderCaption) and (SplitterWidth=Settings.SplitterWidth) ; end; procedure TAnchorDockSettings.LoadFromConfig(Path: string; Config: TRttiXMLConfig); begin AllowDragging := Config.GetValue(Path+'AllowDragging',true); DockOutsideMargin := Config.GetValue(Path+'DockOutsideMargin',10); DockParentMargin := Config.GetValue(Path+'DockParentMargin',10); DockSitesCanBeMinimized := Config.GetValue(Path+'DockSitesCanBeMinimized',false); FlatHeadersButtons := Config.GetValue(Path+'FlatHeadersButtons',false); DragTreshold := Config.GetValue(Path+'DragThreshold',4); FloatingWindowsOnTop := Config.GetValue(Path+'FloatingWindowsOnTop',false); ; HeaderAlignLeft := Config.GetValue(Path+'HeaderAlignLeft',120); HeaderAlignTop := Config.GetValue(Path+'HeaderAlignTop',80); HeaderFilled := Config.GetValue(Path+'HeaderFilled',true); HeaderFlatten := Config.GetValue(Path+'HeaderFlatten',true); HeaderHighlightFocused := Config.GetValue(Path+'HeaderHighlightFocused',false); HeaderStyle := Config.GetValue(Path+'HeaderStyle','Frame3D'); HideHeaderCaptionFloatingControl := Config.GetValue(Path+'HideHeaderCaptionFloatingControl',true); MultiLinePages := Config.GetValue(Path+'MultiLinePages',false); PageAreaInPercent := Config.GetValue(Path+'PageAreaInPercent',40); OuterBorderAreaMaxPixel := Config.GetValue(Path+'OuterBorderAreaMaxPixel',50); OuterBorderAreaInPercent := Config.GetValue(Path+'OuterBorderAreaInPercent',10); ScaleOnResize := Config.GetValue(Path+'ScaleOnResize',true); ShowHeader := Config.GetValue(Path+'ShowHeader',true); ShowHeaderCaption := Config.GetValue(Path+'ShowHeaderCaption',true); SplitterWidth := Config.GetValue(Path+'SplitterWidth',4); end; { TStyleOfForm } class operator TStyleOfForm. = (Item1, Item2: TStyleOfForm): Boolean; begin Result := (Item1.Form = Item2.Form) and (Item1.FormStyle = Item2.FormStyle); end; { TFormStyles } procedure TFormStyles.AddForm(const AForm: TCustomForm); var AStyleOfForm: TStyleOfForm; begin if not Assigned(AForm) then Exit; if IndexOfForm(AForm) >= 0 then Exit; AStyleOfForm.Form := AForm; AStyleOfForm.FormStyle := AForm.FormStyle; Add(AStyleOfForm); end; function TFormStyles.IndexOfForm(const AForm: TCustomForm): Integer; var i: Integer; begin for i := 0 to Count - 1 do if Self[i].Form = AForm then Exit(i); Result := -1; end; procedure TFormStyles.RemoveForm(const AForm: TCustomForm); var AIndex: Integer; begin AIndex := IndexOfForm(AForm); if AIndex < 0 then Exit; Delete(AIndex); end; { TAnchorDockMaster } function TAnchorDockMaster.GetControls(Index: integer): TControl; begin Result:=TControl(FControls[Index]); end; procedure TAnchorDockMaster.FormFirstShow(Sender: TObject); var AForm: TCustomForm absolute Sender; IsMainDockForm: Boolean; begin if not (Sender is TCustomForm) then Exit; if fsModal in AForm.FormState then Exit; if AForm.FormStyle in fsAllStayOnTop then Exit; if not FloatingWindowsOnTop then Exit; IsMainDockForm := (AForm = MainDockForm) or (AForm.IsParentOf(MainDockForm)) or (GetParentForm(AForm) = MainDockForm); if IsMainDockForm then AForm.FormStyle := fsNormal else AForm.FormStyle := fsStayOnTop; {$IFDEF VerboseADFloatingWindowsOnTop} DebugLn('TAnchorDockMaster.FormFirstShow ', DbgSName(AForm), ': ', DbgS(AForm.FormStyle)); {$ENDIF} end; function TAnchorDockMaster.GetLocalizedHeaderHint: string; begin if HeaderHint<>'' then Result:=HeaderHint else Result:=adrsDragAndDockC; end; function TAnchorDockMaster.GetMainDockForm: TCustomForm; begin if not Assigned(FMainDockForm) then FMainDockForm := Application.MainForm; // Workaround: if FloatingWindowsOnTop is loaded on MainForm.Create // Application.MainForm is not set now, but already in Screen.Forms // see https://bugs.freepascal.org/view.php?id=19272 if not Assigned(FMainDockForm) and (Screen.FormCount > 0) then FMainDockForm := Screen.Forms[0]; Result := FMainDockForm; end; procedure TAnchorDockMaster.SetHeaderAlignLeft(const AValue: integer); begin if FHeaderAlignLeft=AValue then exit; FHeaderAlignLeft:=AValue; FHeaderAlignTop:=Min(FHeaderAlignLeft-1,FHeaderAlignTop); OptionsChanged; end; procedure TAnchorDockMaster.SetHeaderAlignTop(const AValue: integer); begin if FHeaderAlignTop=AValue then exit; FHeaderAlignTop:=AValue; FHeaderAlignLeft:=Max(FHeaderAlignTop+1,FHeaderAlignLeft); OptionsChanged; end; procedure TAnchorDockMaster.MarkCorrectlyLocatedControl(Tree: TAnchorDockLayoutTree); var Counter:integer; function GetRealParent(Node:TAnchorDockLayoutTreeNode): TAnchorDockLayoutTreeNode; begin Result := Node; while Assigned(Result.Parent) do begin Result := Result.Parent; fTreeNameToDocker[Node.Name]; if Result.NodeType in [adltnControl,adltnCustomSite] then exit end; end; function GetDockParent(Control: TControl): TControl; begin Control := Control.Parent; while (Control <> nil) and (Control.Parent <> nil) do begin if not (Control is TAnchorDockHostSite) then Break; Control := Control.Parent; end; Result := Control; end; procedure RealChildrenCount(AWinControl: TWinControl; var aCount:integer); var i: integer; ACountedControl: TControl; begin for i:=0 to AWinControl.ControlCount-1 do begin ACountedControl:=AWinControl.Controls[i]; if not (ACountedControl is TAnchorDockHostSite) then if not (ACountedControl is TAnchorDockHeader) then if not (ACountedControl is TAnchorDockPageControl) then if ACountedControl.IsVisible then inc(aCount); if (ACountedControl is TAnchorDockHostSite) and ACountedControl.IsVisible then RealChildrenCount(ACountedControl as TWinControl, aCount); end; end; function CheckNode(Node: TAnchorDockLayoutTreeNode; var ControlsCount: integer): TADLControlLocation; var i: Integer; AControl,AParent: TControl; SubControlsCount,RealSubControlsCount: integer; begin AControl:=nil; AParent:=nil; Result:=adlclWrongly; if Node.IsSplitter then begin inc(ControlsCount); exit(adlclCorrect); end else if Node=Tree.Root then Result:=adlclCorrect else begin AControl:=FindControl(Node.Name); AParent:=FindControl(GetRealParent(Node).Name); if Node.NodeType=adltnLayout then Result:=adlclCorrect else if AControl is TAnchorDockPanel then Result:=adlclCorrect; end; if AControl<>nil then if not (AControl is TAnchorDockHostSite) then inc(ControlsCount); if Result=adlclWrongly then exit; if AControl=nil then AControl:=AParent; SubControlsCount:=0; for i:=0 to Node.Count-1 do begin Result:=CheckNode(Node[i],SubControlsCount); if Result=adlclWrongly then exit; end; RealSubControlsCount:=0; if (AControl is TAnchorDockHostSite) or (AControl is TAnchorDockPanel) then begin RealChildrenCount(AControl as TWinControl,RealSubControlsCount); if SubControlsCount<>RealSubControlsCount then Exit(adlclWrongly); end; ControlsCount:=ControlsCount+SubControlsCount; if Result=adlclWrongly then exit; for i:=0 to Node.Count-1 do begin Node[i].ControlLocation:=adlclCorrect; end; end; begin // Compare dock tree and actual layout of controls // and mark controls which location coincides with tree // these controls can be not closed in CloseUnneededAndWronglyLocatedControls Counter:=0; Tree.Root.ControlLocation:=CheckNode(Tree.Root,Counter); end; function TAnchorDockMaster.CloseUnneededAndWronglyLocatedControls(Tree: TAnchorDockLayoutTree ): boolean; function GetParentAnchorDockPageControl(aControl: TControl):TAnchorDockPageControl; begin while aControl<>nil do begin if aControl is TAnchorDockPageControl then exit(aControl as TAnchorDockPageControl); aControl:=aControl.Parent; end; Result:=nil; end; var i: Integer; AControl: TControl; TreeNodeControl: TAnchorDockLayoutTreeNode; ParentAnchorDockPageControl:TAnchorDockPageControl; begin i:=ControlCount-1; while i>=0 do begin AControl:=Controls[i]; TreeNodeControl:=Tree.Root.FindChildNode(AControl.Name,true); if DockedControlIsVisible(AControl) and (Application.MainForm<>AControl) and (not(AControl is TAnchorDockPanel)) and ((Tree.Root.FindChildNode(AControl.Name,true)=nil) or (TreeNodeControl.ControlLocation=adlclWrongly)) then begin ParentAnchorDockPageControl:=GetParentAnchorDockPageControl(AControl); DisableControlAutoSizing(AControl); // AControl is currently on a visible site, but not in the Tree // => close site if AControl.HostDockSite <> nil then begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockMaster.CloseUnneededControls Control=',DbgSName(AControl),' Site=',AControl.HostDockSite.Name]); {$ENDIF} if AControl.HostDockSite is TAnchorDockHostSite then begin if not TAnchorDockHostSite(AControl.HostDockSite).CloseSite then begin if FControls.IndexOf(AControl)<0 then AControl:=nil; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockMaster.CloseUnneededControls CloseSite failed Control=',DbgSName(AControl)]); {$ENDIF} exit(false); end; end; end; if FControls.IndexOf(AControl)>=0 then begin // the control is still there if AControl.HostDockSite<>nil then begin AControl.HostDockSite.Visible:=false; AControl.HostDockSite.Parent:=nil; end else begin AControl.Visible:=False; AControl.Parent:=nil; end; end; if ParentAnchorDockPageControl<>nil then if ParentAnchorDockPageControl.Parent<>nil then ParentAnchorDockPageControl.Parent.Free; end; i:=Min(i,ControlCount)-1; end; Result:=true; end; function TAnchorDockMaster.CreateNeededControls(Tree: TAnchorDockLayoutTree; DisableAutoSizing: boolean; ControlNames: TStrings): boolean; procedure CreateControlsForNode(Node: TAnchorDockLayoutTreeNode); var i: Integer; AControl: TControl; begin if (Node.NodeType in [adltnControl,adltnCustomSite]) and (Node.Name<>'') then begin AControl:=FindControl(Node.Name); if AControl<>nil then begin //debugln(['CreateControlsForNode ',Node.Name,' already exists']); if DisableAutoSizing then DisableControlAutoSizing(AControl); end else begin //debugln(['CreateControlsForNode ',Node.Name,' needs creation']); AControl:=DoCreateControl(Node.Name,true); if AControl<>nil then begin try if DisableAutoSizing and (fDisabledAutosizing.IndexOf(AControl)<0) then begin fDisabledAutosizing.Add(AControl); AControl.FreeNotification(Self); end; if Node.NodeType=adltnControl then MakeDockable(AControl,false) else if not IsCustomSite(AControl) then raise EAnchorDockLayoutError.Create('not a docksite: '+DbgSName(AControl)); finally if not DisableAutoSizing then AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; end; end else begin debugln(['CreateControlsForNode ',Node.Name,' failed to create']); end; end; if AControl<>nil then ControlNames.Add(AControl.Name); end; for i:=0 to Node.Count-1 do CreateControlsForNode(Node[i]); end; begin Result:=false; CreateControlsForNode(Tree.Root); Result:=true; end; procedure TAnchorDockMaster.MapTreeToControls(Tree: TAnchorDockLayoutTree); procedure MapHostDockSites(Node: TAnchorDockLayoutTreeNode); // map in TreeNameToDocker each control name to its HostDockSite or custom dock site var i: Integer; AControl: TControl; begin if Node.IsSplitter then exit; if (Node.NodeType=adltnControl) then begin AControl:=FindControl(Node.Name); if (AControl<>nil) and (AControl.HostDockSite is TAnchorDockHostSite) then fTreeNameToDocker[Node.Name]:=AControl.HostDockSite; // ignore kids exit; end; if (Node.NodeType=adltnCustomSite) then begin AControl:=FindControl(Node.Name); if IsCustomSite(AControl) or (AControl is TAnchorDockPanel) then fTreeNameToDocker[Node.Name]:=AControl; end; for i:=0 to Node.Count-1 do MapHostDockSites(Node[i]); // recursive end; procedure MapTopLevelSites(Node: TAnchorDockLayoutTreeNode); // map in TreeNameToDocker each RootWindow node name to a site with a // corresponding control // For example: if there is control on a complex site (SiteA), and the control // has a node in the Tree, then the root node of the tree node is mapped to // the SiteA. This way the corresponding root forms are kept which reduces // flickering. function FindMappedControl(ChildNode: TAnchorDockLayoutTreeNode): TCustomForm; var i: Integer; begin if ChildNode.NodeType in [adltnControl,adltnCustomSite] then Result:=TCustomForm(fTreeNameToDocker[ChildNode.Name]) else for i:=0 to ChildNode.Count-1 do begin Result:=FindMappedControl(ChildNode[i]); // search recursive if Result<>nil then exit; end; end; var i: Integer; RootSite: TCustomForm; Site: TCustomForm; begin if Node.IsSplitter then exit; if Node.IsRootWindow then begin if Node.Name='' then exit; if Node.NodeType=adltnControl then exit; // Node is a complex site if fTreeNameToDocker[Node.Name]<>nil then exit; // and not yet mapped to a site Site:=FindMappedControl(Node); if Site=nil then exit; // and there is sub node mapped to a site (anchor or custom) RootSite:=GetParentForm(Site); if not (RootSite is TAnchorDockHostSite) then exit; // and the mapped site has a root site if fTreeNameToDocker.ControlToName(RootSite)<>'' then exit; // and the root site is not yet mapped // => map the root node to the root site fTreeNameToDocker[Node.Name]:=RootSite; end else for i:=0 to Node.Count-1 do MapTopLevelSites(Node[i]); // recursive end; procedure MapBottomUp(Node: TAnchorDockLayoutTreeNode); { map the other nodes to existing sites The heuristic works like this: if a child node was mapped to a site and the site has a parent site then map this node to this parent site. } var i: Integer; BestSite: TControl; begin if Node.IsSplitter then exit; BestSite:=fTreeNameToDocker[Node.Name]; for i:=0 to Node.Count-1 do begin MapBottomUp(Node[i]); // recursive if BestSite=nil then BestSite:=fTreeNameToDocker[Node[i].Name]; end; if (fTreeNameToDocker[Node.Name]=nil) and (BestSite<>nil) then begin // search the parent site of a child site repeat if BestSite is TAnchorDockPanel then begin if fTreeNameToDocker.ControlToName(BestSite)='' then fTreeNameToDocker[Node.Name]:=BestSite; break; end; BestSite:=BestSite.Parent; if BestSite is TAnchorDockHostSite then begin if fTreeNameToDocker.ControlToName(BestSite)='' then fTreeNameToDocker[Node.Name]:=BestSite; break; end; until (BestSite=nil); end; end; procedure MapSplitters(Node: TAnchorDockLayoutTreeNode); { map the splitter nodes to existing splitters The heuristic works like this: If a node is mapped to a site and the node is at Side anchored to a splitter node and the site is anchored at Side to a splitter then map the splitter node to the splitter. } var i: Integer; Side: TAnchorKind; Site: TControl; SplitterNode: TAnchorDockLayoutTreeNode; Splitter: TControl; begin if Node.IsSplitter then exit; for i:=0 to Node.Count-1 do MapSplitters(Node[i]); // recursive if Node.Parent=nil then exit; // node is a child node Site:=fTreeNameToDocker[Node.Name]; if Site=nil then exit; // node is mapped to a site // check each side for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin if Node.Anchors[Side]='' then continue; Splitter:=Site.AnchorSide[Side].Control; if (not (Splitter is TAnchorDockSplitter)) or (Splitter.Parent<>Site.Parent) then continue; SplitterNode:=Node.Parent.FindChildNode(Node.Anchors[Side],false); if (SplitterNode=nil) then continue; // this Side of node is anchored to a splitter node if fTreeNameToDocker[SplitterNode.Name]<>nil then continue; // the SplitterNode is not yet mapped if fTreeNameToDocker.ControlToName(Splitter)<>'' then continue; // there is an unmapped splitter anchored to the Site // => map the splitter to the splitter node // Note: Splitter.Name can be different from SplitterNode.Name ! fTreeNameToDocker[SplitterNode.Name]:=Splitter; end; end; begin MapHostDockSites(Tree.Root); MapTopLevelSites(Tree.Root); MapBottomUp(Tree.Root); MapSplitters(Tree.Root); end; function SrcRectValid(const r: TRect): boolean; begin Result:=(r.Left=0) and (ANode.Monitor0 then Restore(ANode[0],TCustomForm(AControl)); end else if ANode.IsSplitter then begin // restore splitter Splitter:=TAnchorDockSplitter(fTreeNameToDocker[ANode.Name]); if Splitter=nil then begin Splitter:=CreateSplitter; fTreeNameToDocker[ANode.Name]:=Splitter; end; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.RestoreLayout.Restore Splitter Node.Name=',aNode.Name,' ',dbgs(aNode.NodeType),' Splitter=',DbgSName(Splitter)]); {$ENDIF} Splitter.Parent:=AParent; NewBounds:=ScaleBoundsRect(ANode.BoundsRect,ANode.PixelsPerInch,Screen.PixelsPerInch); if SrcRectValid(SrcWorkArea) then NewBounds:=Rect(ScaleChildX(NewBounds.Left),ScaleChildY(NewBounds.Top), ScaleChildX(NewBounds.Right),ScaleChildY(NewBounds.Bottom)); Splitter.DockRestoreBounds:=NewBounds; Splitter.BoundsRect:=NewBounds; if ANode.NodeType=adltnSplitterVertical then begin Splitter.ResizeAnchor:=akLeft; Splitter.AnchorSide[akLeft].Control:=nil; Splitter.AnchorSide[akRight].Control:=nil; end else begin Splitter.ResizeAnchor:=akTop; Splitter.AnchorSide[akTop].Control:=nil; Splitter.AnchorSide[akBottom].Control:=nil; end; Result:=Splitter; Splitter.AsyncUpdateDockBounds:=true; end else if ANode.NodeType=adltnLayout then begin // restore layout Site:=GetNodeSite(ANode); {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.RestoreLayout.Restore Layout Node.Name=',aNode.Name,' ChildCount=',aNode.Count]); {$ENDIF} Site.BeginUpdateLayout; try SetupSite(Site,ANode,AParent); Site.FSiteType:=adhstLayout; Site.Header.Parent:=nil; // create children for i:=0 to ANode.Count-1 do Restore(ANode[i],Site); // anchor children for i:=0 to ANode.Count-1 do begin ChildNode:=ANode[i]; AControl:=fTreeNameToDocker[ChildNode.Name]; {$IFDEF VerboseAnchorDockRestore} debugln([' Restore layout child anchors Site=',DbgSName(Site),' ChildNode.Name=',ChildNode.Name,' Control=',DbgSName(AControl)]); {$ENDIF} if AControl=nil then continue; for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin if ((ChildNode.NodeType=adltnSplitterHorizontal) and (Side in [akTop,akBottom])) or ((ChildNode.NodeType=adltnSplitterVertical) and (Side in [akLeft,akRight])) then continue; AnchorControl:=nil; if ChildNode.Anchors[Side]<>'' then begin AnchorControl:=fTreeNameToDocker[ChildNode.Anchors[Side]]; if AnchorControl=nil then debugln(['WARNING: TAnchorDockMaster.RestoreLayout.Restore: Node=',ChildNode.Name,' Anchor[',dbgs(Side),']=',ChildNode.Anchors[Side],' not found']); end; if AnchorControl<>nil then AControl.AnchorToNeighbour(Side,0,AnchorControl) else AControl.AnchorParallel(Side,0,Site); end; end; // free unneeded helper controls (e.g. splitters) for i:=Site.ControlCount-1 downto 0 do begin AControl:=Site.Controls[i]; if fTreeNameToDocker.ControlToName(AControl)<>'' then continue; if AControl is TAnchorDockSplitter then begin AControl.Free; end; end; finally Site.EndUpdateLayout; end; Result:=Site; end else if ANode.NodeType=adltnPages then begin // restore pages Site:=GetNodeSite(ANode); {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.RestoreLayout.Restore Pages Node.Name=',aNode.Name,' ChildCount=',aNode.Count]); {$ENDIF} Site.BeginUpdateLayout; j:=0; try SetupSite(Site,ANode,AParent); Site.FSiteType:=adhstPages; //Site.Header.Parent:=nil; if Site.Pages=nil then Site.CreatePages; Site.Pages.TabPosition:=ANode.TabPosition; for i:=0 to ANode.Count-1 do begin aPageName:=ANode[i].Name; if j>=Site.Pages.PageCount then Site.Pages.Pages.Add(aPageName); aPage:=Site.Pages.Page[j]; inc(j); AControl:=Restore(ANode[i],aPage); if AControl=nil then continue; AControl.Align:=alClient; for Side:=Low(TAnchorKind) to high(TAnchorKind) do AControl.AnchorSide[Side].Control:=nil; end; Site.Pages.PageIndex:=ANode.PageIndex; finally while Site.Pages.PageCount>j do Site.Pages.Page[Site.Pages.PageCount-1].Free; Site.SimplifyPages; Site.EndUpdateLayout; end; Result:=Site; end else begin // create children for i:=0 to ANode.Count-1 do Restore(ANode[i],AParent); end; end; begin Result:=true; WorkArea:=Rect(0,0,0,0); SrcWorkArea:=WorkArea; Restore(Tree.Root,nil); Restoring:=true; end; procedure TAnchorDockMaster.ScreenFormAdded(Sender: TObject; Form: TCustomForm); begin if Form is THintWindow then exit; FFormStyles.AddForm(Form); Form.AddHandlerFirstShow(@FormFirstShow); end; procedure TAnchorDockMaster.ScreenRemoveForm(Sender: TObject; Form: TCustomForm); begin FFormStyles.RemoveForm(Form); end; procedure TAnchorDockMaster.SetMainDockForm(AValue: TCustomForm); begin if FMainDockForm = AValue then Exit; FMainDockForm := AValue; RefreshFloatingWindowsOnTop; end; function TAnchorDockMaster.DoCreateControl(aName: string; DisableAutoSizing: boolean): TControl; begin Result:=nil; OnCreateControl(Self,aName,Result,DisableAutoSizing); if Result=nil then debugln(['TAnchorDockMaster.DoCreateControl WARNING: control not found: "',aName,'"']); if (Result<>nil) and (Result.Name<>aName) then raise Exception.Create('TAnchorDockMaster.DoCreateControl'+Format( adrsRequestedButCreated, [aName, Result.Name])); end; procedure TAnchorDockMaster.DisableControlAutoSizing(AControl: TControl); begin if fDisabledAutosizing.IndexOf(AControl)>=0 then exit; //debugln(['TAnchorDockMaster.DisableControlAutoSizing ',DbgSName(AControl)]); fDisabledAutosizing.Add(AControl); AControl.FreeNotification(Self); AControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; end; procedure TAnchorDockMaster.EnableAllAutoSizing; var i: Integer; AControl: TControl; begin i:=fDisabledAutosizing.Count-1; while (i>=0) do begin AControl:=TControl(fDisabledAutosizing[i]); //debugln(['TAnchorDockMaster.EnableAllAutoSizing ',DbgSName(AControl)]); fDisabledAutosizing.Delete(i); AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; i:=Min(i,fDisabledAutosizing.Count)-1; end; end; procedure TAnchorDockMaster.ClearLayoutProperties(AControl: TControl; NewAlign: TAlign); var a: TAnchorKind; begin AControl.AutoSize:=false; AControl.Align:=NewAlign; AControl.BorderSpacing.Around:=0; AControl.BorderSpacing.Left:=0; AControl.BorderSpacing.Top:=0; AControl.BorderSpacing.Right:=0; AControl.BorderSpacing.Bottom:=0; AControl.BorderSpacing.InnerBorder:=0; for a:=Low(TAnchorKind) to High(TAnchorKind) do AControl.AnchorSide[a].Control:=nil; end; procedure TAnchorDockMaster.PopupMenuPopup(Sender: TObject); var Popup: TPopupMenu; ChangeLockItem: TMenuItem; ShowHeadersItem: TMenuItem; begin if not (Sender is TPopupMenu) then exit; Popup:=TPopupMenu(Sender); Popup.Items.Clear; // top popup menu item can be clicked by accident, so use something simple: // lock/unlock ChangeLockItem:=AddPopupMenuItem('AnchorDockMasterChangeLockMenuItem', adrsLocked,@ChangeLockButtonClick); ChangeLockItem.Checked:=not AllowDragging; ChangeLockItem.ShowAlwaysCheckable:=true; if Popup.PopupComponent is TAnchorDockHeader then TAnchorDockHeader(Popup.PopupComponent).PopupMenuPopup(Sender) else if Popup.PopupComponent is TAnchorDockPageControl then TAnchorDockPageControl(Popup.PopupComponent).PopupMenuPopup(Sender) else if Popup.PopupComponent is TAnchorDockSplitter then TAnchorDockSplitter(Popup.PopupComponent).PopupMenuPopup(Sender); if ShowMenuItemShowHeader or (not ShowHeader) then begin ShowHeadersItem:=AddPopupMenuItem('AnchorDockMasterShowHeaderMenuItem', adrsShowHeaders, @ShowHeadersButtonClick); ShowHeadersItem.Checked:=ShowHeader; ShowHeadersItem.ShowAlwaysCheckable:=true; end; if Assigned(OnShowOptions) then AddPopupMenuItem('OptionsMenuItem', adrsDockingOptions, @OptionsClick); end; procedure TAnchorDockMaster.ResetSplitters; var I: Integer; S: TAnchorDockSplitter; begin for I := 0 to ComponentCount-1 do if Components[I] is TAnchorDockSplitter then begin S := TAnchorDockSplitter(Components[I]); S.UpdateDockBounds; S.UpdatePercentPosition; end; end; function TAnchorDockMaster.FullRestoreLayout(Tree: TAnchorDockLayoutTree; Scale: Boolean): Boolean; var ControlNames: TStringListUTF8Fast; begin Result:=false; ControlNames:=TStringListUTF8Fast.Create; fTreeNameToDocker:=TADNameToControl.Create; try // close all unneeded and wrongly allocated forms/controls (not helper controls like splitters) MarkCorrectlyLocatedControl(Tree); if not CloseUnneededAndWronglyLocatedControls(Tree) then exit; BeginUpdate; try // create all needed forms/controls (not helper controls like splitters) if not CreateNeededControls(Tree,true,ControlNames) then exit; // simplify layouts ControlNames.Sort; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.FullRestoreLayout controls: ']); debugln(ControlNames.Text); {$ENDIF} // if some forms/controls could not be created the layout needs to be adapted Tree.Root.Simplify(ControlNames,false); // reuse existing sites to reduce flickering MapTreeToControls(Tree); {$IFDEF VerboseAnchorDockRestore} fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.FullRestoreLayout Map'); {$ENDIF} // create sites, move controls RestoreLayout(Tree,Scale); SetMinimizedState(Tree); finally EndUpdate; end; finally // clean up FreeAndNil(fTreeNameToDocker); ControlNames.Free; // commit (this can raise an exception, when it triggers events) EnableAllAutoSizing; end; ResetSplitters; // reset splitters' DockBounds after EnableAllAutoSizing. fixes issue #18538 {$IFDEF VerboseAnchorDockRestore} DebugWriteChildAnchors(Application.MainForm,true,false); {$ENDIF} Result:=true; end; procedure TAnchorDockMaster.SetHideHeaderCaptionFloatingControl( const AValue: boolean); var Site: TAnchorDockHostSite; i: Integer; begin if AValue=HideHeaderCaptionFloatingControl then exit; fHideHeaderCaptionFloatingControl:=AValue; for i:=0 to ComponentCount-1 do begin Site:=TAnchorDockHostSite(Components[i]); if not (Site is TAnchorDockHostSite) then continue; Site.UpdateDockCaption; end; OptionsChanged; end; procedure TAnchorDockMaster.SetSplitterWidth(const AValue: integer); var i: Integer; Splitter: TAnchorDockSplitter; begin if (AValue<1) or (AValue=SplitterWidth) then exit; FSplitterWidth:=AValue; for i:=0 to ComponentCount-1 do begin Splitter:=TAnchorDockSplitter(Components[i]); if not (Splitter is TAnchorDockSplitter) then continue; if not Splitter.CustomWidth then begin if Splitter.ResizeAnchor in [akLeft,akRight] then Splitter.Width:=SplitterWidth else Splitter.Height:=SplitterWidth; end; end; OptionsChanged; end; procedure TAnchorDockMaster.StartHideOverlappingTimer; begin if not DockTimer.Enabled then begin DockTimer.Interval:=HideOverlappingFormByMouseLoseTime; DockTimer.OnTimer:=@HideOverlappingForm; DockTimer.Enabled:=true; end; end; procedure TAnchorDockMaster.StopHideOverlappingTimer; begin DockTimer.Enabled:=False; DockTimer.Interval:=0; DockTimer.OnTimer:=nil; end; function IsParentControl(aParent, aControl: TControl): boolean; begin while (aControl <> nil) and (aControl.Parent <> nil) do begin if (aControl=aParent) then exit(true); aControl := aControl.Parent; end; result:=aControl=aParent; end; procedure TAnchorDockMaster.OnIdle(Sender: TObject; var Done: Boolean); var MousePos: TPoint; Bounds:Trect; begin if Done then ; Restoring:=false; if FOverlappingForm=nil then IdleConnected:=false else begin MousePos:=Point(0, 0); GetCursorPos(MousePos); Bounds.TopLeft:=FOverlappingForm.ClientToScreen(point(0,0)); Bounds.BottomRight:=FOverlappingForm.ClientToScreen(point(FOverlappingForm.Width,FOverlappingForm.Height)); if not IsParentControl(FOverlappingForm, GetCaptureControl) then begin if not PtInRect(Bounds,MousePos) then StartHideOverlappingTimer else StopHideOverlappingTimer; end; end; end; procedure TAnchorDockMaster.AsyncSimplify(Data: PtrInt); begin FQueueSimplify:=false; SimplifyPendingLayouts; end; procedure TAnchorDockMaster.ChangeLockButtonClick(Sender: TObject); begin AllowDragging:=not AllowDragging; end; procedure TAnchorDockMaster.RefreshFloatingWindowsOnTop; var i, AIndex: Integer; AForm, ParentForm: TCustomForm; IsMainDockForm: Boolean; AFormStyle: TFormStyle; begin for i := 0 to Screen.FormCount - 1 do begin AForm := Screen.Forms[i]; if AForm.FormStyle = fsSplash then continue; ParentForm := GetParentForm(AForm); if FFloatingWindowsOnTop then begin IsMainDockForm := (AForm = MainDockForm) or (AForm.IsParentOf(MainDockForm)) or (ParentForm = MainDockForm); if IsMainDockForm then AFormStyle := fsNormal else AFormStyle := fsStayOnTop; end else begin AIndex := FFormStyles.IndexOfForm(AForm); if AIndex >= 0 then AFormStyle := FFormStyles[AIndex].FormStyle else AFormStyle := fsNormal; end; if ParentForm is TAnchorDockHostSite then begin ParentForm.FormStyle := AFormStyle; {$IFDEF VerboseADFloatingWindowsOnTop} DebugLn('TAnchorDockMaster.RefreshFloatingWindowsOnTop ', DbgSName(ParentForm), '(', DbgSName(AForm), '): ', DbgS(AFormStyle)); {$ENDIF} end else begin AForm.FormStyle := AFormStyle; {$IFDEF VerboseADFloatingWindowsOnTop} DebugLn('TAnchorDockMaster.RefreshFloatingWindowsOnTop ', DbgSName(AForm), ': ', DbgS(AFormStyle)); {$ENDIF} end; end; end; function TAnchorDockMaster.ScaleBoundsRect(ARect: TRect; FromDPI, ToDPI: integer): TRect; begin if not Application.Scaled or (FromDPI <= 0) or (ToDPI <= 0) then Result := ARect else begin Result.Left :=MulDiv(ARect.Left ,ToDPI,FromDPI); Result.Top :=MulDiv(ARect.Top ,ToDPI,FromDPI); Result.Width :=MulDiv(ARect.Width ,ToDPI,FromDPI); Result.Height:=MulDiv(ARect.Height,ToDPI,FromDPI); end; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.ScaleBoundsRect FromDPI=',FromDPI,' ToDPI=',ToDPI,' FromRect[',dbgs(ARect),'] ToRect[',dbgs(Result),']']); {$ENDIF} end; procedure TAnchorDockMaster.SetAllowDragging(AValue: boolean); begin if FAllowDragging=AValue then Exit; FAllowDragging:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetDockOutsideMargin(AValue: integer); begin if FDockOutsideMargin=AValue then Exit; FDockOutsideMargin:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetDockParentMargin(AValue: integer); begin if FDockParentMargin=AValue then Exit; FDockParentMargin:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetDragTreshold(AValue: integer); begin if FDragTreshold=AValue then Exit; FDragTreshold:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetHeaderHint(AValue: string); begin if FHeaderHint=AValue then Exit; FHeaderHint:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetHeaderStyle(AValue: THeaderStyleName); begin if FHeaderStyle=AValue then Exit; FHeaderStyle:=AValue; FHeaderStyleName2ADHeaderStyle.TryGetData(uppercase(AValue),CurrentADHeaderStyle); OptionsChanged; InvalidateHeaders; end; procedure TAnchorDockMaster.SetPageAreaInPercent(AValue: integer); begin if FPageAreaInPercent=AValue then Exit; FPageAreaInPercent:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetScaleOnResize(AValue: boolean); begin if FScaleOnResize=AValue then Exit; FScaleOnResize:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.SetHeaderFlatten(AValue: boolean); begin if FHeaderFlatten=AValue then Exit; FHeaderFlatten:=AValue; OptionsChanged; InvalidateHeaders; end; procedure TAnchorDockMaster.SetHeaderFilled(AValue: boolean); begin if FHeaderFilled=AValue then Exit; FHeaderFilled:=AValue; OptionsChanged; InvalidateHeaders; end; procedure TAnchorDockMaster.SetHeaderHighlightFocused(AValue: boolean); begin if FHeaderHighlightFocused=AValue then Exit; FHeaderHighlightFocused:=AValue; OptionsChanged; InvalidateHeaders; end; procedure TAnchorDockMaster.SetDockSitesCanBeMinimized(AValue: boolean); begin if FDockSitesCanBeMinimized=AValue then Exit; FDockSitesCanBeMinimized:=AValue; UpdateHeaders; InvalidateHeaders; EnableAllAutoSizing; OptionsChanged; end; procedure TAnchorDockMaster.SetFlatHeadersButtons(AValue: boolean); begin if FFlatHeadersButtons=AValue then Exit; FFlatHeadersButtons:=AValue; AutoSizeAllHeaders(True); InvalidateHeaders; OptionsChanged; end; procedure TAnchorDockMaster.SetFloatingWindowsOnTop(AValue: boolean); begin if FFloatingWindowsOnTop = AValue then Exit; FFloatingWindowsOnTop := AValue; RefreshFloatingWindowsOnTop; OptionsChanged; end; procedure TAnchorDockMaster.SetMultiLinePages(AValue: boolean); var Site: TAnchorDockHostSite; i: Integer; begin if FMultiLinePages=AValue then Exit; FMultiLinePages:=AValue; for i:=0 to ComponentCount-1 do begin Site:=TAnchorDockHostSite(Components[i]); if not (Site is TAnchorDockHostSite) then continue; if Assigned(Site.Pages) then begin DisableControlAutoSizing(Site); Site.Pages.MultiLine:=AValue; end; end; EnableAllAutoSizing; OptionsChanged; end; procedure TAnchorDockMaster.SetShowMenuItemShowHeader(AValue: boolean); begin if FShowMenuItemShowHeader=AValue then Exit; FShowMenuItemShowHeader:=AValue; OptionsChanged; end; procedure TAnchorDockMaster.ShowHeadersButtonClick(Sender: TObject); begin ShowHeader:=not ShowHeader; end; procedure TAnchorDockMaster.OptionsClick(Sender: TObject); begin if Assigned(OnShowOptions) then OnShowOptions(Self); end; procedure TAnchorDockMaster.SetIdleConnected(const AValue: Boolean); begin if FIdleConnected=AValue then exit; FIdleConnected:=AValue; if IdleConnected then Application.AddOnIdleHandler(@OnIdle,true) else Application.RemoveOnIdleHandler(@OnIdle); end; procedure TAnchorDockMaster.SetQueueSimplify(const AValue: Boolean); begin if FQueueSimplify=AValue then exit; FQueueSimplify:=AValue; if FQueueSimplify then Application.QueueAsyncCall(@AsyncSimplify,0) else Application.RemoveAsyncCalls(Self); end; procedure TAnchorDockMaster.SetRestoring(const AValue: boolean); var AComponent: TComponent; i: Integer; begin if FRestoring=AValue then exit; FRestoring:=AValue; if FRestoring then begin IdleConnected:=true; end else begin for i:=0 to ComponentCount-1 do begin AComponent:=Components[i]; if AComponent is TAnchorDockHostSite then TAnchorDockHostSite(AComponent).DockRestoreBounds:=Rect(0,0,0,0) else if AComponent is TAnchorDockSplitter then TAnchorDockSplitter(AComponent).DockRestoreBounds:=Rect(0,0,0,0) end; end; end; procedure TAnchorDockMaster.OptionsChanged; begin IncreaseOptionsChangeStamp; if Assigned(OnOptionsChanged) then OnOptionsChanged(Self); end; procedure TAnchorDockMaster.SetShowHeader(AValue: boolean); var i: Integer; Site: TAnchorDockHostSite; begin if FShowHeader=AValue then exit; FShowHeader:=AValue; for i:=0 to ComponentCount-1 do begin Site:=TAnchorDockHostSite(Components[i]); if not (Site is TAnchorDockHostSite) then continue; if (Site.Header<>nil) then begin DisableControlAutoSizing(Site); Site.UpdateHeaderShowing; if Site.Minimized then if not AValue then site.MinimizeSite; end; end; EnableAllAutoSizing; OptionsChanged; end; procedure TAnchorDockMaster.SetShowHeaderCaption(const AValue: boolean); var i: Integer; Site: TAnchorDockHostSite; begin if FShowHeaderCaption=AValue then exit; FShowHeaderCaption:=AValue; for i:=0 to ComponentCount-1 do begin Site:=TAnchorDockHostSite(Components[i]); if not (Site is TAnchorDockHostSite) then continue; Site.UpdateDockCaption; end; OptionsChanged; end; procedure TAnchorDockMaster.Notification(AComponent: TComponent; Operation: TOperation); var AControl: TControl; begin inherited Notification(AComponent, Operation); if Operation=opRemove then begin if AComponent is TControl then begin AControl:=TControl(AComponent); FControls.Remove(AControl); fNeedSimplify.Remove(AControl); fNeedFree.Remove(AControl); fDisabledAutosizing.Remove(AControl); if fTreeNameToDocker<>nil then fTreeNameToDocker.RemoveControl(AControl); end; end; end; procedure TAnchorDockMaster.InvalidateHeaders; var i: Integer; Site: TAnchorDockHostSite; begin for i:=0 to ComponentCount-1 do begin Site:=TAnchorDockHostSite(Components[i]); if not (Site is TAnchorDockHostSite) then continue; if (Site.Header<>nil) and (Site.Header.Parent<>nil) then Site.Header.Invalidate; end; end; procedure TAnchorDockMaster.AutoSizeAllHeaders(EnableAutoSizing: boolean); var i: Integer; Site: TAnchorDockHostSite; begin for i:=0 to ComponentCount-1 do begin Site:=TAnchorDockHostSite(Components[i]); if not (Site is TAnchorDockHostSite) then continue; if (Site.Header<>nil) and (Site.Header.Parent<>nil) then begin Site.Header.InvalidatePreferredSize; DisableControlAutoSizing(Site.Header); if Site.Header.CloseButton<>nil then begin Site.Header.CloseButton.InvalidatePreferredSize; DisableControlAutoSizing(Site.Header.CloseButton); end; if Site.Header.MinimizeButton<>nil then begin Site.Header.MinimizeButton.InvalidatePreferredSize; DisableControlAutoSizing(Site.Header.MinimizeButton); end; Site.Header.AdjustSize; end; end; if EnableAutoSizing then EnableAllAutoSizing; end; procedure TAnchorDockMaster.RegisterHeaderStyle(StyleName: THeaderStyleName; DrawProc:TDrawADHeaderProc; NeedDrawHeaderAfterText,NeedHighlightText: boolean); var TempStyle:TADHeaderStyle; begin TempStyle.DrawProc:=DrawProc; TempStyle.StyleDesc.NeedDrawHeaderAfterText:=NeedDrawHeaderAfterText; TempStyle.StyleDesc.NeedHighlightText:=NeedHighlightText; TempStyle.StyleDesc.Name:=StyleName; FHeaderStyleName2ADHeaderStyle.AddOrSetData(uppercase(StyleName), TempStyle); if FHeaderStyleName2ADHeaderStyle.Count=1 then begin CurrentADHeaderStyle:=TempStyle; HeaderStyle:=StyleName; end; end; procedure TAnchorDockMaster.ShowOverlappingForm; begin FOverlappingForm.Show; IdleConnected:=true; end; procedure TAnchorDockMaster.HideOverlappingForm(Sender: TObject); begin StopHideOverlappingTimer; FOverlappingForm.Hide; FOverlappingForm.AnchorDockHostSite.HideMinimizedControl; IdleConnected:=false; end; constructor TAnchorDockMaster.Create(AOwner: TComponent); begin inherited Create(AOwner); FFormStyles:=TFormStyles.Create; FMainDockForm:=nil; FControls:=TFPList.Create; FAllowDragging:=true; FDragTreshold:=4; FDockOutsideMargin:=10; FDockParentMargin:=10; FFloatingWindowsOnTop:=false; FPageAreaInPercent:=40; FOuterBorderAreaMaxPixel:=50; FOuterBorderAreaInPercent:=10; FHeaderAlignTop:=80; HeaderAlignLeft:=120; FHeaderHint:=''; FMultiLinePages:=false; FShowHeader:=true; FShowHeaderCaption:=true; FHideHeaderCaptionFloatingControl:=true; FSplitterWidth:=4; FScaleOnResize:=true; FMapMinimizedControls:=TMapMinimizedControls.Create; fNeedSimplify:=TFPList.Create; fNeedFree:=TFPList.Create; fDisabledAutosizing:=TFPList.Create; FSplitterClass:=TAnchorDockSplitter; FSiteClass:=TAnchorDockHostSite; FManagerClass:=TAnchorDockManager; FHeaderClass:=TAnchorDockHeader; FHeaderFlatten:=true; FHeaderFilled:=true; FPageControlClass:=TAnchorDockPageControl; FPageClass:=TAnchorDockPage; FRestoreLayouts:=TAnchorDockRestoreLayouts.Create; FHeaderHighlightFocused:=false; FDockSitesCanBeMinimized:=false; FFlatHeadersButtons:=False; FOverlappingForm:=nil; FAllClosing:=False; FHeaderStyleName2ADHeaderStyle:=THeaderStyleName2ADHeaderStylesMap.create; Screen.AddHandlerFormAdded(@ScreenFormAdded); Screen.AddHandlerRemoveForm(@ScreenRemoveForm); end; destructor TAnchorDockMaster.Destroy; var AControl: TControl; i, j: Integer; begin if Assigned(FFormStyles) and not Application.Terminated then for i:=FFormStyles.Count-1 downto 0 do begin FFormStyles[i].Form.RemoveAllHandlersOfObject(Self); end; Screen.RemoveHandlerFormAdded(@ScreenFormAdded); Screen.RemoveHandlerRemoveForm(@ScreenRemoveForm); QueueSimplify:=false; FreeAndNil(FRestoreLayouts); FreeAndNil(fPopupMenu); FreeAndNil(fTreeNameToDocker); if FControls.Count>0 then begin while ControlCount>0 do begin AControl:=Controls[ControlCount-1]; debugln(['TAnchorDockMaster.Destroy: still in list: ',DbgSName(AControl),' Caption="',AControl.Caption,'"']); AControl.Free; end; end; FreeAndNil(fNeedSimplify); FreeAndNil(FControls); FreeAndNil(fNeedFree); FreeAndNil(FMapMinimizedControls); FreeAndNil(fDisabledAutosizing); {$IFDEF VerboseAnchorDocking} for i:=0 to ComponentCount-1 do begin debugln(['TAnchorDockMaster.Destroy ',i,'/',ComponentCount,' ',DbgSName(Components[i])]); end; {$ENDIF} for i:=0 to ComponentCount-1 do begin for j:=0 to ComponentCount-1 do begin if i<>j then TControl(Components[i]).RemoveAllHandlersOfObject(TControl(Components[j])); end; end; FreeAndNil(FHeaderStyleName2ADHeaderStyle); FreeAndNil(FFormStyles); inherited Destroy; end; function TAnchorDockMaster.ControlCount: integer; begin Result:=FControls.Count; end; function TAnchorDockMaster.IndexOfControl(const aName: string): integer; begin Result:=ControlCount-1; while (Result>=0) and (Controls[Result].Name<>aName) do dec(Result); end; function TAnchorDockMaster.FindControl(const aName: string): TControl; var i: LongInt; begin i:=IndexOfControl(aName); if i>=0 then Result:=Controls[i] else Result:=nil; end; function TAnchorDockMaster.IsMinimizedControl(AControl: TControl; out Site: TAnchorDockHostSite): Boolean; var AIndex: Integer; begin AIndex:=FMapMinimizedControls.IndexOf(AControl); if AIndex<0 then begin Result:=False; Site:=nil; end else begin Result:=True; Site:=TAnchorDockHostSite(FMapMinimizedControls[AControl]); end; end; function TAnchorDockMaster.IsSite(AControl: TControl): boolean; begin Result:=(AControl is TAnchorDockHostSite) or IsCustomSite(AControl); end; function TAnchorDockMaster.IsAnchorSite(AControl: TControl): boolean; begin Result:=AControl is TAnchorDockHostSite; end; function TAnchorDockMaster.IsCustomSite(AControl: TControl): boolean; begin Result:=(AControl is TCustomForm) // also checks for nil and (AControl.Parent=nil) and (TCustomForm(AControl).DockManager is TAnchorDockManager); end; function TAnchorDockMaster.GetSite(AControl: TControl): TCustomForm; begin Result:=nil; if AControl=nil then exit else if IsCustomSite(AControl) then Result:=TCustomForm(AControl) else if AControl is TAnchorDockHostSite then Result:=TAnchorDockHostSite(AControl) else if (AControl.HostDockSite is TAnchorDockHostSite) then Result:=TAnchorDockHostSite(AControl.HostDockSite); end; function TAnchorDockMaster.GetAnchorSite(AControl: TControl): TAnchorDockHostSite; begin Result:=nil; if AControl=nil then Result:=nil else if AControl is TAnchorDockHostSite then Result:=TAnchorDockHostSite(AControl) else if (AControl.HostDockSite is TAnchorDockHostSite) then Result:=TAnchorDockHostSite(AControl.HostDockSite); end; function TAnchorDockMaster.GetControl(Site: TControl): TControl; var AnchorSite: TAnchorDockHostSite; begin Result:=nil; if IsCustomSite(Site) then Result:=Site else if Site is TAnchorDockHostSite then begin AnchorSite:=TAnchorDockHostSite(Site); if AnchorSite.SiteType=adhstOneControl then Result:=AnchorSite.GetOneControl; end else if (Site<>nil) and (Site.HostDockSite is TAnchorDockHostSite) and (TAnchorDockHostSite(Site.HostDockSite).SiteType=adhstOneControl) then Result:=Site; end; function TAnchorDockMaster.IsFloating(AControl: TControl): Boolean; begin if AControl is TAnchorDockHostSite then begin Result:=(TAnchorDockHostSite(AControl).SiteType=adhstOneControl) and (AControl.Parent=nil); end else if (AControl.HostDockSite is TAnchorDockHostSite) then begin Result:=(TAnchorDockHostSite(AControl.HostDockSite).SiteType=adhstOneControl) and (AControl.HostDockSite.Parent=nil); end else Result:=AControl.Parent=nil; end; function TAnchorDockMaster.GetPopupMenu: TPopupMenu; begin if fPopupMenu=nil then begin fPopupMenu:=TPopupMenu.Create(Self); fPopupMenu.OnPopup:=@PopupMenuPopup; end; Result:=fPopupMenu; end; function TAnchorDockMaster.AddPopupMenuItem(AName, ACaption: string; const OnClickEvent: TNotifyEvent; AParent: TMenuItem): TMenuItem; begin Result:=TMenuItem(fPopupMenu.FindComponent(AName)); if Result=nil then begin Result:=TMenuItem.Create(fPopupMenu); Result.Name:=AName; if AParent=nil then fPopupMenu.Items.Add(Result) else AParent.Add(Result); end; Result.Caption:=ACaption; Result.OnClick:=OnClickEvent; end; function TAnchorDockMaster.AddRemovePopupMenuItem(Add: boolean; AName, ACaption: string; const OnClickEvent: TNotifyEvent; AParent: TMenuItem ): TMenuItem; begin if Add then Result:=AddPopupMenuItem(AName,ACaption,OnClickEvent,AParent) else begin Result:=TMenuItem(fPopupMenu.FindComponent(AName)); if Result<>nil then FreeAndNil(Result); end; end; procedure TAnchorDockMaster.MakeDockable(AControl: TControl; Show: boolean; BringToFront: boolean; AddDockHeader: boolean); var Site: TAnchorDockHostSite; begin if AControl.Name='' then raise Exception.Create('TAnchorDockMaster.MakeDockable '+ adrsMissingControlName); if (AControl is TCustomForm) and (fsModal in TCustomForm(AControl).FormState) then raise Exception.Create('TAnchorDockMaster.MakeDockable '+ adrsModalFormsCanNotBeMadeDockable); if IsCustomSite(AControl) then raise Exception.Create('TAnchorDockMaster.MakeDockable '+ adrsControlIsAlreadyADocksite); Site:=nil; AControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.DisableControlAutoSizing'){$ENDIF}; try if AControl is TAnchorDockHostSite then begin // already a site Site:=TAnchorDockHostSite(AControl); end else if AControl.Parent=nil then if IsMinimizedControl(AControl, Site) then begin Site.AsyncMinimizeSite(0); end else begin if FControls.IndexOf(AControl)<0 then begin FControls.Add(AControl); AControl.FreeNotification(Self); end; // create docksite Site:=CreateSite; try try Site.BoundsRect:=AControl.BoundsRect; ClearLayoutProperties(AControl); // dock AControl.ManualDock(Site); AControl.Visible:=true; if not AddDockHeader then Site.Header.Parent:=nil; except FreeAndNil(Site); raise; end; finally if Site<>nil then Site.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; end; end else if AControl.Parent is TAnchorDockHostSite then begin // AControl is already docked => show site Site:=TAnchorDockHostSite(AControl.Parent); AControl.Visible:=true; end else begin raise Exception.Create('TAnchorDockMaster.MakeDockable '+Format( adrsNotSupportedHasParent, [DbgSName(AControl), DbgSName(AControl)])); end; site.UpdateHeaderShowing; if (Site<>nil) and Show then MakeVisible(Site,BringToFront); finally AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.DisableControlAutoSizing'){$ENDIF}; end; // BringToFront if Show and BringToFront and (Site<>nil) then begin GetParentForm(Site).BringToFront; Site.SetFocus; end; end; procedure TAnchorDockMaster.MakeDockSite(AForm: TCustomForm; Sites: TAnchors; ResizePolicy: TADMResizePolicy; AllowInside: boolean); var AManager: TAnchorDockManager; begin if AForm.Name='' then raise Exception.Create('TAnchorDockMaster.MakeDockSite '+ adrsMissingControlName); if AForm.DockManager<>nil then raise Exception.Create('TAnchorDockMaster.MakeDockSite DockManager<>nil'); if AForm.Parent<>nil then raise Exception.Create('TAnchorDockMaster.MakeDockSite Parent='+DbgSName(AForm.Parent)); if fsModal in AForm.FormState then raise Exception.Create('TAnchorDockMaster.MakeDockSite '+ adrsModalFormsCanNotBeMadeDockable); if Sites=[] then raise Exception.Create('TAnchorDockMaster.MakeDockSite Sites=[]'); AForm.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockSite'){$ENDIF}; try if FControls.IndexOf(AForm)<0 then begin FControls.Add(AForm); AForm.FreeNotification(Self); end; AManager:=ManagerClass.Create(AForm); AManager.DockableSites:=Sites; AManager.InsideDockingAllowed:=AllowInside; AManager.ResizePolicy:=ResizePolicy; AForm.DockManager:=AManager; AForm.UseDockManager:=true; AForm.DockSite:=true; finally AForm.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockSite'){$ENDIF}; end; end; procedure TAnchorDockMaster.MakeDockPanel(APanel:TAnchorDockPanel; ResizePolicy: TADMResizePolicy); var AManager: TAnchorDockManager; begin if APanel.Name='' then raise Exception.Create('TAnchorDockMaster.MakeDockPanel '+ adrsMissingControlName); if APanel.DockManager<>nil then raise Exception.Create('TAnchorDockMaster.MakeDockPanel DockManager<>nil'); APanel.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockPanel'){$ENDIF}; try if FControls.IndexOf(APanel)<0 then begin FControls.Add(APanel); APanel.FreeNotification(Self); end; AManager:=ManagerClass.Create(APanel); AManager.DockableSites:=[]; AManager.InsideDockingAllowed:=true; AManager.ResizePolicy:=ResizePolicy; APanel.DockManager:=AManager; APanel.UseDockManager:=true; APanel.DockSite:=true; finally APanel.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockPanel'){$ENDIF}; end; end; procedure TAnchorDockMaster.MakeVisible(AControl: TControl; SwitchPages: boolean); begin while AControl<>nil do begin if FMapMinimizedControls.IndexOf(AControl)>=0 then begin AControl:=TAnchorDockHostSite(FMapMinimizedControls[AControl]); TAnchorDockHostSite(AControl).MinimizeSite; end; AControl.Visible:=true; if SwitchPages and (AControl is TAnchorDockPage) then TAnchorDockPageControl(AControl.Parent).PageIndex:= TAnchorDockPage(AControl).PageIndex; AControl:=AControl.Parent; end; end; function TAnchorDockMaster.ShowControl(ControlName: string; BringToFront: boolean): TControl; begin Result:=DoCreateControl(ControlName,false); if Result=nil then exit; MakeDockable(Result,true,BringToFront); end; procedure TAnchorDockMaster.CloseAll; var i: Integer; AForm: TCustomForm; AControl: TWinControl; begin FAllClosing:=True; // hide all forms i:=Screen.CustomFormCount-1; while i>=0 do begin AForm:=GetParentForm(Screen.CustomForms[i]); if Assigned(AForm)then AForm.Hide; i:=Min(i,Screen.CustomFormCount)-1; end; // close all forms except the MainForm i:=Screen.CustomFormCount-1; while i>=0 do begin AForm:=Screen.CustomForms[i]; if (AForm<>Application.MainForm) and not AForm.IsParentOf(Application.MainForm) then begin AControl:=AForm; while (AControl.Parent<>nil) and (AControl.Parent<>Application.MainForm) do begin AControl:=AControl.Parent; if AControl is TCustomForm then AForm:=TCustomForm(AControl); end; AForm.Close; end; i:=Min(i,Screen.CustomFormCount)-1; end; FAllClosing:=False; end; procedure TAnchorDockMaster.SaveLayoutToConfig(Config: TConfigStorage); var Tree: TAnchorDockLayoutTree; begin Tree:=TAnchorDockLayoutTree.Create; try Config.AppendBasePath('MainConfig/'); SaveMainLayoutToTree(Tree); Tree.SaveToConfig(Config); Config.UndoAppendBasePath; Config.AppendBasePath('Restores/'); RestoreLayouts.SaveToConfig(Config); Config.UndoAppendBasePath; {$IFDEF VerboseAnchorDocking} WriteDebugLayout('TAnchorDockMaster.SaveLayoutToConfig ',Tree.Root); {$ENDIF} //DebugWriteChildAnchors(Tree.Root); finally Tree.Free; end; end; function GetParentFormOrDockPanel(Control: TControl; TopForm:Boolean=true): TCustomForm; var oldControl: TControl; begin oldControl:=Control; while (Control <> nil) and (Control.Parent <> nil) do begin if (Control is TAnchorDockPanel) then Break; Control := Control.Parent; end; if Control is TCustomForm then Result := TCustomForm(Control) else if Control is TAnchorDockPanel then Result := TCustomForm(Control) else Result := nil; if not TopForm then begin if Control is TAnchorDockPanel then exit; Control:=oldControl; while (Control <> nil) and (Control.Parent <> nil) do begin Control := Control.Parent; if (Control is TCustomForm) then Break; end; Result := TCustomForm(Control); end; end; procedure TAnchorDockMaster.SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree); var i: Integer; AControl: TControl; Site: TAnchorDockHostSite; SavedSites: TFPList; LayoutNode: TAnchorDockLayoutTreeNode; AFormOrDockPanel: TWinControl; VisibleControls: TStringListUTF8Fast; procedure SaveFormOrDockPanel(theFormOrDockPanel: TWinControl; SaveChildren: boolean; AMinimized:boolean); begin // custom dock site LayoutNode:=LayoutTree.NewNode(LayoutTree.Root); LayoutNode.NodeType:=adltnCustomSite; LayoutNode.Assign(theFormOrDockPanel,theFormOrDockPanel is TAnchorDockPanel,AMinimized); // can have one normal dock site if SaveChildren then begin Site:=TAnchorDockManager(theFormOrDockPanel.DockManager).GetChildSite; if Site<>nil then begin LayoutNode:=LayoutTree.NewNode(LayoutNode); Site.SaveLayout(LayoutTree,LayoutNode); {if Site.BoundSplitter<>nil then begin LayoutNode:=LayoutTree.NewNode(LayoutNode); Site.BoundSplitter.SaveLayout(LayoutNode); end;} end; end; end; begin SavedSites:=TFPList.Create; VisibleControls:=TStringListUTF8Fast.Create; try for i:=0 to ControlCount-1 do begin AControl:=Controls[i]; if not DockedControlIsVisible(AControl) then continue; VisibleControls.Add(AControl.Name); AFormOrDockPanel:=GetParentFormOrDockPanel(AControl); if AFormOrDockPanel=nil then continue; if SavedSites.IndexOf(AFormOrDockPanel)>=0 then continue; SavedSites.Add(AFormOrDockPanel); {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.SaveMainLayoutToTree AForm=',DbgSName(AFormOrDockPanel)]); DebugWriteChildAnchors(AFormOrDockPanel,true,true); {$ENDIF} if AFormOrDockPanel is TAnchorDockPanel then begin SaveFormOrDockPanel(GetParentFormOrDockPanel(AFormOrDockPanel),true,false); //LayoutNode:=LayoutTree.NewNode(LayoutTree.Root); //TAnchorDockPanel(AFormOrDockPanel).SaveLayout(LayoutTree,LayoutNode); end else if AFormOrDockPanel is TAnchorDockHostSite then begin Site:=TAnchorDockHostSite(AFormOrDockPanel); LayoutNode:=LayoutTree.NewNode(LayoutTree.Root); Site.SaveLayout(LayoutTree,LayoutNode); end else if IsCustomSite(AFormOrDockPanel) then begin SaveFormOrDockPanel(AFormOrDockPanel,true,false); end else raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl)); end; // remove invisible controls LayoutTree.Root.Simplify(VisibleControls,false); finally VisibleControls.Free; SavedSites.Free; end; end; procedure TAnchorDockMaster.SaveSiteLayoutToTree(AControl: TWinControl; LayoutTree: TAnchorDockLayoutTree); var LayoutNode: TAnchorDockLayoutTreeNode; Site: TAnchorDockHostSite; begin if AControl is TAnchorDockHostSite then begin Site:=TAnchorDockHostSite(AControl); Site.SaveLayout(LayoutTree,LayoutTree.Root); end else if AControl is TAnchorDockPanel then begin (AControl as TAnchorDockPanel).SaveLayout(LayoutTree,LayoutTree.Root); end else if IsCustomSite(AControl) then begin LayoutTree.Root.NodeType:=adltnCustomSite; LayoutTree.Root.Assign(AControl,false,false); // can have one normal dock site Site:=TAnchorDockManager(AControl.DockManager).GetChildSite; if Site<>nil then begin LayoutNode:=LayoutTree.NewNode(LayoutTree.Root); Site.SaveLayout(LayoutTree,LayoutNode); end; end else raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl)); end; function TAnchorDockMaster.CreateRestoreLayout(AControl: TControl ): TAnchorDockRestoreLayout; { Create a restore layout for AControl and its child controls. It contains the whole parent structure so that the restore knows where to put AControl. } procedure AddControlNames(SubControl: TControl; RestoreLayout: TAnchorDockRestoreLayout); var i: Integer; begin if (FControls.IndexOf(SubControl)>=0) and not RestoreLayout.HasControlName(SubControl.Name) then RestoreLayout.ControlNames.Add(SubControl.Name); if SubControl is TWinControl then for i:=0 to TWinControl(SubControl).ControlCount-1 do AddControlNames(TWinControl(SubControl).Controls[i],RestoreLayout); end; var AForm: TCustomForm; begin if not IsSite(AControl) then raise Exception.Create('TAnchorDockMaster.CreateRestoreLayout: not a site '+DbgSName(AControl)); AForm:=GetParentFormOrDockPanel(AControl); Result:=TAnchorDockRestoreLayout.Create(TAnchorDockLayoutTree.Create); if AForm=nil then exit; SaveSiteLayoutToTree(AForm,Result.Layout); AddControlNames(AControl,Result); end; function TAnchorDockMaster.ConfigIsEmpty(Config: TConfigStorage): boolean; begin Result:=Config.GetValue('MainConfig/Nodes/ChildCount',0)=0; end; function TAnchorDockMaster.LoadLayoutFromConfig(Config: TConfigStorage; Scale: Boolean): boolean; var Tree: TAnchorDockLayoutTree; ControlNames: TStringListUTF8Fast; begin Result:=false; ControlNames:=TStringListUTF8Fast.Create; fTreeNameToDocker:=TADNameToControl.Create; Tree:=TAnchorDockLayoutTree.Create; try // load layout Config.AppendBasePath('MainConfig/'); try Tree.LoadFromConfig(Config); finally Config.UndoAppendBasePath; end; // load restore layouts for hidden forms Config.AppendBasePath('Restores/'); try RestoreLayouts.LoadFromConfig(Config); finally Config.UndoAppendBasePath; end; {$IFDEF VerboseAnchorDockRestore} WriteDebugLayout('TAnchorDockMaster.LoadLayoutFromConfig ',Tree.Root); DebugWriteChildAnchors(Tree.Root); {$ENDIF} // close all unneeded and wrongly allocated forms/controls (not helper controls like splitters) MarkCorrectlyLocatedControl(Tree); if not CloseUnneededAndWronglyLocatedControls(Tree) then exit; BeginUpdate; try // create all needed forms/controls (not helper controls like splitters) if not CreateNeededControls(Tree,true,ControlNames) then exit; // simplify layouts ControlNames.Sort; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.LoadLayoutFromConfig controls: ']); debugln(ControlNames.Text); {$ENDIF} // if some forms/controls could not be created the layout needs to be adapted Tree.Root.Simplify(ControlNames,false); // reuse existing sites to reduce flickering MapTreeToControls(Tree); {$IFDEF VerboseAnchorDockRestore} fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.LoadLayoutFromConfig Map'); {$ENDIF} // create sites, move controls RestoreLayout(Tree,Scale); SetMinimizedState(Tree); finally EndUpdate; end; finally // clean up FreeAndNil(fTreeNameToDocker); ControlNames.Free; Tree.Free; // commit (this can raise an exception) EnableAllAutoSizing; end; {$IFDEF VerboseAnchorDockRestore} if Assigned(Application.MainForm) then DebugWriteChildAnchors(Application.MainForm,true,false) else if (ControlCount>0) and (Controls[0] is TWinControl) then DebugWriteChildAnchors(TWinControl(Controls[0]),true,false); {$ENDIF} Result:=true; end; procedure TAnchorDockMaster.LoadSettingsFromConfig(Config: TConfigStorage); var Settings: TAnchorDockSettings; begin Settings:=TAnchorDockSettings.Create; try Settings.LoadFromConfig(Config); LoadSettings(Settings); finally Settings.Free; end; end; procedure TAnchorDockMaster.SaveSettingsToConfig(Config: TConfigStorage); var Settings: TAnchorDockSettings; begin Settings:=TAnchorDockSettings.Create; try SaveSettings(Settings); Settings.SaveToConfig(Config); finally Settings.Free; end; end; procedure TAnchorDockMaster.LoadSettings(Settings: TAnchorDockSettings); begin AllowDragging := Settings.AllowDragging; DockOutsideMargin := Settings.DockOutsideMargin; DockParentMargin := Settings.DockParentMargin; DockSitesCanBeMinimized := Settings.DockSitesCanBeMinimized; {$IF DEFINED(MSWINDOWS)} if Win32MajorVersion>=10 then FlatHeadersButtons := Settings.FlatHeadersButtons else FlatHeadersButtons := False; {$ELSE} FlatHeadersButtons := False; {$ENDIF} DragTreshold := Settings.DragTreshold; FloatingWindowsOnTop := Settings.FloatingWindowsOnTop; PageAreaInPercent := Settings.PageAreaInPercent; OuterBorderAreaMaxPixel := Settings.OuterBorderAreaMaxPixel; OuterBorderAreaInPercent := Settings.OuterBorderAreaInPercent; HeaderAlignLeft := Settings.HeaderAlignLeft; HeaderAlignTop := Settings.HeaderAlignTop; HeaderFilled := Settings.HeaderFilled; HeaderFlatten := Settings.HeaderFlatten; HeaderHighlightFocused := Settings.HeaderHighlightFocused; HeaderStyle := Settings.HeaderStyle; HideHeaderCaptionFloatingControl := Settings.HideHeaderCaptionFloatingControl; MultiLinePages := Settings.MultiLinePages; ScaleOnResize := Settings.ScaleOnResize; ShowHeader := Settings.ShowHeader; ShowHeaderCaption := Settings.ShowHeaderCaption; SplitterWidth := Settings.SplitterWidth; end; procedure TAnchorDockMaster.SaveSettings(Settings: TAnchorDockSettings); begin Settings.AllowDragging := AllowDragging; Settings.DockOutsideMargin := DockOutsideMargin; Settings.DockParentMargin := DockParentMargin; Settings.DockSitesCanBeMinimized := DockSitesCanBeMinimized; Settings.FlatHeadersButtons := FlatHeadersButtons; Settings.DragTreshold := DragTreshold; Settings.FloatingWindowsOnTop := FloatingWindowsOnTop; Settings.PageAreaInPercent := PageAreaInPercent; Settings.OuterBorderAreaMaxPixel := OuterBorderAreaMaxPixel; Settings.OuterBorderAreaInPercent := OuterBorderAreaInPercent; Settings.HeaderAlignLeft := HeaderAlignLeft; Settings.HeaderAlignTop := HeaderAlignTop; Settings.HeaderFilled := HeaderFilled; Settings.HeaderFlatten := HeaderFlatten; Settings.HeaderHighlightFocused := HeaderHighlightFocused; Settings.HeaderStyle := HeaderStyle; Settings.HideHeaderCaptionFloatingControl := HideHeaderCaptionFloatingControl; Settings.MultiLinePages := MultiLinePages; Settings.ScaleOnResize := ScaleOnResize; Settings.ShowHeader := ShowHeader; Settings.ShowHeaderCaption := ShowHeaderCaption; Settings.SplitterWidth := SplitterWidth; end; function TAnchorDockMaster.SettingsAreEqual(Settings: TAnchorDockSettings ): boolean; var Cur: TAnchorDockSettings; begin Cur:=TAnchorDockSettings.Create; try SaveSettings(Cur); Result:=Cur.IsEqual(Settings); finally Cur.Free; end; end; procedure TAnchorDockMaster.ManualFloat(AControl: TControl); var Site: TAnchorDockHostSite; begin Site:=GetAnchorSite(AControl); if Site=nil then exit; Site.Undock; end; procedure TAnchorDockMaster.ManualDock(SrcSite: TAnchorDockHostSite; TargetSite: TCustomForm; Align: TAlign; TargetControl: TControl); var Site: TAnchorDockHostSite; aManager: TAnchorDockManager; DockObject: TDragDockObject; begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockMaster.ManualDock SrcSite=',DbgSName(SrcSite),' TargetSite=',DbgSName(TargetSite),' Align=',dbgs(Align),' TargetControl=',DbgSName(TargetControl)]); {$ENDIF} if SrcSite=TargetSite then exit; if SrcSite.IsParentOf(TargetSite) then raise Exception.Create('TAnchorDockMaster.ManualDock SrcSite.IsParentOf(TargetSite)'); if TargetSite.IsParentOf(SrcSite) then raise Exception.Create('TAnchorDockMaster.ManualDock TargetSite.IsParentOf(SrcSite)'); if IsCustomSite(TargetSite) then begin aManager:=TAnchorDockManager(TargetSite.DockManager); Site:=aManager.GetChildSite; if Site=nil then begin // dock as first site into custom dock site {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockMaster.ManualDock dock as first site into custom dock site: SrcSite=',DbgSName(SrcSite),' TargetSite=',DbgSName(TargetSite),' Align=',dbgs(Align)]); {$ENDIF} BeginUpdate; try DockObject := TDragDockObject.Create(SrcSite); try DockObject.DropAlign:=Align; DockObject.DockRect:=SrcSite.BoundsRect; DockObject.Control.Dock(TargetSite, SrcSite.BoundsRect); aManager.InsertControl(DockObject); finally DockObject.Free; end; finally EndUpdate; end; exit; end; // else: dock into child site of custom dock site end else begin // dock to or into TargetSite if not (TargetSite is TAnchorDockHostSite) then raise Exception.Create('TAnchorDockMaster.ManualDock invalid TargetSite'); Site:=TAnchorDockHostSite(TargetSite); end; if AutoFreedIfControlIsRemoved(Site,SrcSite) then raise Exception.Create('TAnchorDockMaster.ManualDock TargetSite depends on SrcSite'); BeginUpdate; try Site.ExecuteDock(SrcSite,TargetControl,Align); finally EndUpdate; end; end; procedure TAnchorDockMaster.ManualDock(SrcSite: TAnchorDockHostSite; TargetPanel: TAnchorDockPanel; Align: TAlign; TargetControl: TControl); var Site: TAnchorDockHostSite; aManager: TAnchorDockManager; DockObject: TDragDockObject; begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockMaster.ManualDock SrcSite=',DbgSName(SrcSite),' TargetPanel=',DbgSName(TargetPanel),' Align=',dbgs(Align),' TargetControl=',DbgSName(TargetControl)]); {$ENDIF} if SrcSite.IsParentOf(TargetPanel) then raise Exception.Create('TAnchorDockMaster.ManualDock SrcSite.IsParentOf(TargetSite)'); if TargetPanel.IsParentOf(SrcSite) then raise Exception.Create('TAnchorDockMaster.ManualDock TargetSite.IsParentOf(SrcSite)'); aManager:=TAnchorDockManager(TargetPanel.DockManager); Site:=aManager.GetChildSite; if Site=nil then begin // dock as first site into AnchorDockPanel {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockMaster.ManualDock dock as first site into AnchorDockPanel: SrcSite=',DbgSName(SrcSite),' TargetPanel=',DbgSName(TargetPanel),' Align=',dbgs(Align)]); {$ENDIF} BeginUpdate; try DockObject := TDragDockObject.Create(SrcSite); try DockObject.DropAlign:=alClient; DockObject.DockRect:=SrcSite.BoundsRect; DockObject.Control.Dock(TargetPanel, SrcSite.BoundsRect); aManager.InsertControl(DockObject); finally DockObject.Free; end; finally EndUpdate; end; exit; end; if AutoFreedIfControlIsRemoved(Site,SrcSite) then raise Exception.Create('TAnchorDockMaster.ManualDock TargetPanel depends on SrcSite'); BeginUpdate; try Site.ExecuteDock(SrcSite,TargetControl,Align); finally EndUpdate; end; end; function TAnchorDockMaster.ManualEnlarge(Site: TAnchorDockHostSite; Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; begin Result:=(Site<>nil) and Site.EnlargeSide(Side,OnlyCheckIfPossible); end; procedure TAnchorDockMaster.BeginUpdate; begin inc(fUpdateCount); end; procedure TAnchorDockMaster.EndUpdate; begin if fUpdateCount<=0 then RaiseGDBException(''); dec(fUpdateCount); if fUpdateCount=0 then begin SimplifyPendingLayouts; UpdateHeaders; InvalidateHeaders; end; end; function TAnchorDockMaster.IsReleasing(AControl: TControl): Boolean; begin Result := fNeedFree.IndexOf(AControl) >= 0; end; procedure TAnchorDockMaster.NeedSimplify(AControl: TControl); begin if Self=nil then exit; if csDestroying in ComponentState then exit; if csDestroying in AControl.ComponentState then exit; if fNeedSimplify=nil then exit; if fNeedSimplify.IndexOf(AControl)>=0 then exit; if not ((AControl is TAnchorDockHostSite) or (AControl is TAnchorDockPage)) then exit; if Application.Terminated then exit; //debugln(['TAnchorDockMaster.NeedSimplify ',DbgSName(AControl),' Caption="',AControl.Caption,'"']); fNeedSimplify.Add(AControl); AControl.FreeNotification(Self); QueueSimplify:=true; end; procedure TAnchorDockMaster.NeedFree(AControl: TControl); begin //debugln(['TAnchorDockMaster.NeedFree ',DbgSName(AControl),' ',csDestroying in AControl.ComponentState]); if IsReleasing(AControl) then exit; if csDestroying in AControl.ComponentState then exit; fNeedFree.Add(AControl); AControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; AControl.Parent:=nil; AControl.Visible:=false; end; procedure TAnchorDockMaster.SimplifyPendingLayouts; var AControl: TControl; Changed: Boolean; i: Integer; begin if fSimplifying or (fUpdateCount>0) then exit; fSimplifying:=true; try // simplify layout (do not free controls in this step, only mark them) repeat Changed:=false; i:=fNeedSimplify.Count-1; while i>=0 do begin AControl:=TControl(fNeedSimplify[i]); if (csDestroying in AControl.ComponentState) or IsReleasing(AControl) then begin fNeedSimplify.Delete(i); Changed:=true; end else if (AControl is TAnchorDockHostSite) then begin //debugln(['TAnchorDockMaster.SimplifyPendingLayouts ',DbgSName(AControl),' ',dbgs(TAnchorDockHostSite(AControl).SiteType),' UpdatingLayout=',TAnchorDockHostSite(AControl).UpdatingLayout]); if not TAnchorDockHostSite(AControl).UpdatingLayout then begin fNeedSimplify.Delete(i); Changed:=true; if TAnchorDockHostSite(AControl).SiteType=adhstNone then begin //debugln(['TAnchorDockMaster.SimplifyPendingLayouts free empty site: ',dbgs(pointer(AControl)),' Caption="',AControl.Caption,'"']); NeedFree(AControl); end else begin TAnchorDockHostSite(AControl).Simplify; end; end; end else if AControl is TAnchorDockPage then begin fNeedSimplify.Delete(i); Changed:=true; NeedFree(AControl); end else RaiseGDBException('TAnchorDockMaster.SimplifyPendingLayouts inconsistency'); i:=Min(fNeedSimplify.Count,i)-1; end; until not Changed; // free unneeded controls for i := fNeedFree.Count - 1 downto 0 do if not (csDestroying in TControl(fNeedFree[i]).ComponentState) then Application.ReleaseComponent(TComponent(fNeedFree[i])); fNeedFree.Clear; finally fSimplifying:=false; end; end; function TAnchorDockMaster.AutoFreedIfControlIsRemoved(AControl, RemovedControl: TControl): boolean; { returns true if the simplification algorithm will automatically free AControl when RemovedControl is removed Some sites are dummy sites that were autocreated. They will be auto freed if not needed anymore. 1. A TAnchorDockPage has a TAnchorDockHostSite as child. If the child is freed the page will be freed. 2. When a TAnchorDockPageControl has only one page left the content is moved up and the pagecontrol and page will be freed. 3. When a adhstLayout site has only one child site left, the content is moved up and the child site will be freed. 4. When the control of a adhstOneControl site is freed the site will be freed. } var ParentSite: TAnchorDockHostSite; Page: TAnchorDockPage; PageControl: TAnchorDockPageControl; OtherPage: TAnchorDockPage; Site, Site1, Site2: TAnchorDockHostSite; begin Result:=false; if (RemovedControl=nil) or (AControl=nil) then exit; while RemovedControl<>nil do begin if RemovedControl=AControl then exit(true); if RemovedControl is TAnchorDockPage then begin // a page will be removed Page:=TAnchorDockPage(RemovedControl); if not (Page.Parent is TAnchorDockPageControl) then exit; PageControl:=TAnchorDockPageControl(Page.Parent); if PageControl.PageCount>2 then exit; if PageControl.PageCount=2 then begin // this pagecontrol will be replaced by the content of the other page if PageControl=AControl then exit(true); if PageControl.Page[0]=Page then OtherPage:=PageControl.DockPages[1] else OtherPage:=PageControl.DockPages[0]; // the other page will be removed (its content will be moved up) if OtherPage=AControl then exit(true); if (OtherPage.ControlCount>0) then begin if (OtherPage.Controls[0] is TAnchorDockHostSite) and (OtherPage.Controls[0]=RemovedControl) then exit(true); // the site of the other page will be removed (its content moved up) end; exit; end; // the last page of the pagecontrol is freed => the pagecontrol will be removed too end else if RemovedControl is TAnchorDockPageControl then begin // the pagecontrol will be removed if not (RemovedControl.Parent is TAnchorDockHostSite) then exit; // a pagecontrol is always the only child of a site // => the site will be removed too end else if RemovedControl is TAnchorDockHostSite then begin // a site will be removed Site:=TAnchorDockHostSite(RemovedControl); if Site.Parent is TAnchorDockPage then begin // a page has only one site // => the page will be removed too end else if Site.Parent is TAnchorDockHostSite then begin ParentSite:=TAnchorDockHostSite(Site.Parent); if (ParentSite.SiteType=adhstOneControl) or ParentSite.IsOneSiteLayout(Site) then begin // the control of a OneControl site is removed => the ParentSite is freed too end else if ParentSite.SiteType=adhstLayout then begin if ParentSite.IsTwoSiteLayout(Site1,Site2) then begin // when there are two sites and one of them is removed // the content of the other will be moved up and then both sites are // removed if (Site1=AControl) or (Site2=AControl) then exit(true); end; exit; // removing only site will not free the layout end else begin raise Exception.Create('TAnchorDockMaster.AutoFreedIfControlIsRemoved ParentSiteType='+dbgs(ParentSite.SiteType)+' ChildSiteType='+dbgs(Site.SiteType)); end; end else exit; // other classes will never be auto freed end else begin // control is not a site => check if control is in a OneControl site if not (RemovedControl.Parent is TAnchorDockHostSite) then exit; ParentSite:=TAnchorDockHostSite(RemovedControl.Parent); if (ParentSite.SiteType<>adhstOneControl) then exit; if ParentSite.GetOneControl<>RemovedControl then exit; // the control of a OneControl site is removed => the site is freed too end; RemovedControl:=RemovedControl.Parent; end; end; function TAnchorDockMaster.CreateSite(NamePrefix: string; DisableAutoSizing: boolean): TAnchorDockHostSite; var i: Integer; NewName: String; begin Result:=TAnchorDockHostSite(SiteClass.NewInstance); {$IFDEF DebugDisableAutoSizing} if DisableAutoSizing then Result.DisableAutoSizing(ADAutoSizingReason) else Result.DisableAutoSizing('TAnchorDockMaster.CreateSite'); {$ELSE} Result.DisableAutoSizing; {$ENDIF}; try Result.CreateNew(Self,1); i:=0; repeat inc(i); NewName:=NamePrefix+AnchorDockSiteName+IntToStr(i); until (Screen.FindForm(NewName)=nil) and (FindComponent(NewName)=nil); Result.Name:=NewName; finally if not DisableAutoSizing then Result.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.CreateSite'){$ENDIF}; end; end; function TAnchorDockMaster.CreateSplitter(NamePrefix: string): TAnchorDockSplitter; var i: Integer; NewName: String; begin Result:=SplitterClass.Create(Self); i:=0; repeat inc(i); NewName:=NamePrefix+AnchorDockSplitterName+IntToStr(i); until FindComponent(NewName)=nil; Result.Name:=NewName; end; procedure TAnchorDockMaster.IncreaseOptionsChangeStamp; begin LUIncreaseChangeStamp64(FOptionsChangeStamp); end; procedure TAnchorDockMaster.UpdateHeaders; var i: Integer; AControl: TControl; begin for i:=0 to ControlCount-1 do begin AControl:=Controls[i]; while Assigned(AControl) do begin if AControl is TAnchorDockHostSite then TAnchorDockHostSite(AControl).UpdateHeaderShowing; AControl:=AControl.Parent; end; end; end; { TAnchorDockHostSite } procedure TAnchorDockHostSite.SetHeaderSide(const AValue: TAnchorKind); begin if FHeaderSide=AValue then exit; FHeaderSide:=AValue; end; function TAnchorDockHostSite.GetMinimized: Boolean; begin Result:=Assigned(FMinimizedControl); end; procedure TAnchorDockHostSite.CheckFormStyle; var AControl: TControl; AForm: TCustomForm absolute AControl; IsMainDockForm: Boolean; begin AControl := GetOneControl; if not (AControl is TCustomForm) then Exit; if AForm.FormStyle in fsAllStayOnTop then begin FormStyle := AForm.FormStyle; Exit; end; if not DockMaster.FloatingWindowsOnTop then Exit; IsMainDockForm := (AForm = DockMaster.MainDockForm) or (AForm.IsParentOf(DockMaster.MainDockForm)) or (GetParentForm(AForm) = DockMaster.MainDockForm); if IsMainDockForm then Exit; FormStyle := fsStayOnTop; end; procedure TAnchorDockHostSite.FirstShow(Sender: TObject); begin if Sender <> Self then Exit; CheckFormStyle; end; procedure TAnchorDockHostSite.ChildVisibleChanged(Sender: TObject); var AControl: TControl; begin if Sender is TControl then begin AControl:=TControl(Sender); if not (csDestroying in ComponentState) then begin if (not AControl.Visible) and (not Minimized) and (not ((AControl is TAnchorDockHeader) or (AControl is TAnchorDockSplitter) or (AControl is TAnchorDockHostSite))) then begin //debugln(['TAnchorDockHostSite.ChildVisibleChanged START ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl),' UpdatingLayout=',UpdatingLayout]); if (SiteType=adhstOneControl) then Hide else if (SiteType=adhstLayout) then begin RemoveControlFromLayout(AControl); UpdateDockCaption; end; //debugln(['TAnchorDockHostSite.ChildVisibleChanged END ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl)]); end; end; end; end; procedure TAnchorDockHostSite.DoEnter; begin inherited; if Assigned(FHeader) then FHeader.FFocused:=true; invalidate; end; procedure TAnchorDockHostSite.DoExit; begin inherited; if Assigned(FHeader) then FHeader.FFocused:=false; invalidate; end; procedure TAnchorDockHostSite.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation=opRemove then begin if AComponent=Pages then FPages:=nil; if AComponent=Header then FHeader:=nil; if AComponent=BoundSplitter then FBoundSplitter:=nil; end; end; function TAnchorDockHostSite.DoDockClientMsg(DragDockObject: TDragDockObject; aPosition: TPoint): boolean; begin if aPosition.X=0 then ; if (DockManager <> nil) and (DockManager is TAnchorDockManager) and ((DockManager as TAnchorDockManager).RedirectToHostSite <> nil) then Result := (DockManager as TAnchorDockManager).RedirectToHostSite.DoDockClientMsg(DragDockObject, aPosition) else Result:=ExecuteDock(DragDockObject.Control,DragDockObject.DropOnControl, DragDockObject.DropAlign); end; function TAnchorDockHostSite.ExecuteDock(NewControl, DropOnControl: TControl; DockAlign: TAlign): boolean; begin if UpdatingLayout then exit; //debugln(['TAnchorDockHostSite.ExecuteDock Self="',Caption,'" Control=',DbgSName(NewControl),' DropOnControl=',DbgSName(DropOnControl),' Align=',dbgs(DockAlign)]); DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock HostSite'){$ENDIF}; try BeginUpdateLayout; try DockMaster.SimplifyPendingLayouts; NewControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock NewControl'){$ENDIF}; if (NewControl.Parent=Self) and (SiteType=adhstLayout) then begin // change of layout, one child is docked to the outer side RemoveControlFromLayout(NewControl); end else if (NewControl.Parent=Parent) and (Parent is TAnchorDockHostSite) and (TAnchorDockHostSite(Parent).SiteType=adhstLayout) then begin // change of layout, one sibling is moved TAnchorDockHostSite(Parent).RemoveControlFromLayout(NewControl); end; if SiteType=adhstNone then begin // make a control dockable by docking it into a TAnchorDockHostSite; Result:=DockFirstControl(NewControl); end else if DockAlign=alClient then begin // page docking if SiteType=adhstOneControl then begin if Parent is TAnchorDockPage then begin // add as sibling page Result:=(Parent.Parent.Parent as TAnchorDockHostSite).DockAnotherPage(NewControl,nil); end else // create pages Result:=DockSecondPage(NewControl); end else if SiteType=adhstPages then // add as sibling page Result:=DockAnotherPage(NewControl,DropOnControl); end else if DockAlign in [alLeft,alTop,alRight,alBottom] then begin // anchor docking if SiteType=adhstOneControl then begin if Parent is TAnchorDockHostSite then begin // add site as sibling Result:=TAnchorDockHostSite(Parent).DockAnotherControl(Self,NewControl, DockAlign,DropOnControl<>nil); end else // create layout Result:=DockSecondControl(NewControl,DockAlign,DropOnControl<>nil); end else if SiteType=adhstLayout then begin // add site as sibling Result:=DockAnotherControl(nil,NewControl,DockAlign,DropOnControl<>nil); end else if SiteType=adhstPages then begin Result:=DockSecondControl(NewControl,DockAlign,DropOnControl<>nil); end; end; NewControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock NewControl'){$ENDIF}; finally EndUpdateLayout; end; finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock HostSite'){$ENDIF}; end; end; function TAnchorDockHostSite.DockFirstControl(NewControl: TControl): boolean; var DestRect: TRect; begin if SiteType<>adhstNone then RaiseGDBException('TAnchorDockHostSite.DockFirstControl inconsistency'); // create adhstOneControl DestRect := ClientRect; NewControl.Dock(Self, DestRect); FSiteType:=adhstOneControl; if NewControl is TCustomForm then begin Icon.Assign(TCustomForm(NewControl).Icon); end; Result:=true; end; function TAnchorDockHostSite.DockSecondControl(NewControl: TControl; DockAlign: TAlign; Inside: boolean): boolean; { Convert a adhstOneControl into a adhstLayout by docking NewControl at a side (DockAlign). If Inside=true this DockSite is not expanded and both controls share the old space. If Inside=false this DockSite is expanded. } var OldSite: TAnchorDockHostSite; OldControl: TControl; OldSiteType: TAnchorDockHostSiteType; begin Result:=true; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.DockSecondControl Self="',Caption,'" AControl=',DbgSName(NewControl),' Align=',dbgs(DockAlign),' Inside=',Inside]); {$ENDIF} if not (SiteType in [adhstOneControl, adhstPages]) then RaiseGDBException('TAnchorDockHostSite.DockSecondControl inconsistency: not adhstOneControl'); if not (DockAlign in [alLeft,alTop,alRight,alBottom]) then RaiseGDBException('TAnchorDockHostSite.DockSecondControl inconsistency: DockAlign='+dbgs(DockAlign)); OldSiteType := FSiteType; FSiteType:=adhstLayout; // remove header (keep it for later use) Header.Parent:=nil; // put the OldControl into a site of its own (OldSite) and dock OldSite OldControl:=GetOneControl; OldSite:=MakeSite(OldControl); OldSite.FPages := FPages; OldSite.FSiteType := OldSiteType; AddCleanControl(OldSite); FPages := nil; if not(OldControl is TAnchorDockHostSite) then OldSite.Header.FHeaderPosition:=Header.FHeaderPosition; OldSite.AnchorClient(0); // the LCL will compute the bounds later after EnableAutoSizing // but the bounds are needed now => set them manually OldSite.BoundsRect:=Rect(0,0,ClientWidth,ClientHeight); Result:=DockAnotherControl(OldSite,NewControl,DockAlign,Inside); {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.DockSecondControl END Self="',Caption,'" AControl=',DbgSName(NewControl),' Align=',dbgs(DockAlign),' Inside=',Inside]); {$ENDIF} end; function TAnchorDockHostSite.DockAnotherControl(Sibling, NewControl: TControl; DockAlign: TAlign; Inside: boolean): boolean; var Splitter: TAnchorDockSplitter; a: TAnchorKind; NewSite: TAnchorDockHostSite; NewBounds: TRect; MainAnchor: TAnchorKind; i: Integer; NewSiblingWidth: Integer; NewSiblingHeight: Integer; NewSize: LongInt; BoundsIncreased: Boolean; NewParentBounds: TRect; begin Result:=false; if SiteType<>adhstLayout then RaiseGDBException('TAnchorDockHostSite.DockAnotherControl inconsistency'); if not (DockAlign in [alLeft,alTop,alRight,alBottom]) then RaiseGDBException('TAnchorDockHostSite.DockAnotherControl inconsistency'); // add a splitter Splitter:=DockMaster.CreateSplitter; if DockAlign in [alLeft,alRight] then begin Splitter.ResizeAnchor:=akLeft; Splitter.Width:=DockMaster.SplitterWidth; end else begin Splitter.ResizeAnchor:=akTop; Splitter.Height:=DockMaster.SplitterWidth; end; Splitter.Parent:=Self; // dock the NewControl NewSite:=MakeSite(NewControl); AddCleanControl(NewSite); BoundsIncreased:=false; if (not Inside) then begin if (Parent=nil) then begin // expand Self NewBounds:=BoundsRect; case DockAlign of alLeft: begin dec(NewBounds.Left,NewSite.Width+Splitter.Width); MoveAllControls(NewSite.Width+Splitter.Width,0); end; alRight: inc(NewBounds.Right,NewSite.Width+Splitter.Width); alTop: begin dec(NewBounds.Top,NewSite.Height+Splitter.Height); MoveAllControls(0,NewSite.Height+Splitter.Height); end; alBottom: inc(NewBounds.Bottom,NewSite.Height+Splitter.Height); end; BoundsRect:=NewBounds; BoundsIncreased:=true; end else if DockMaster.IsCustomSite(Parent) then begin // Parent is a custom docksite // => expand Self and Parent // expand Parent (the custom docksite) NewParentBounds:=Parent.BoundsRect; NewBounds:=BoundsRect; case DockAlign of alLeft: begin i:=NewSite.Width+Splitter.Width; dec(NewParentBounds.Left,i); dec(NewBounds.Left,i); MoveAllControls(i,0); end; alRight: begin i:=NewSite.Width+Splitter.Width; inc(NewBounds.Right,i); inc(NewParentBounds.Right,i); end; alTop: begin i:=NewSite.Height+Splitter.Height; dec(NewBounds.Top,i); dec(NewParentBounds.Top,i); MoveAllControls(0,i); end; alBottom: begin i:=NewSite.Height+Splitter.Height; inc(NewParentBounds.Bottom,i); inc(NewBounds.Bottom,i); end; end; Parent.BoundsRect:=NewParentBounds; BoundsRect:=NewBounds; BoundsIncreased:=true; TAnchorDockManager(Parent.DockManager).FSiteClientRect:=Parent.ClientRect; end; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.DockAnotherControl AFTER ENLARGE ',Caption]); //DebugWriteChildAnchors(Self,true,true); {$ENDIF} end; // anchors MainAnchor:=MainAlignAnchor[DockAlign]; if Inside and (Sibling<>nil) then begin { Example: insert right of Sibling # # ################ ######################## -------+# -------+#+-------+# Sibling|# -----> Sibling|#|NewSite|# -------+# -------+#+-------+# ################ ######################## # # } for a:=low(TAnchorKind) to high(TAnchorKind) do begin if a in AnchorAlign[DockAlign] then begin NewSite.AnchorSide[a].Assign(Sibling.AnchorSide[a]); end else begin NewSite.AnchorToNeighbour(a,0,Splitter); end; end; Sibling.AnchorToNeighbour(MainAnchor,0,Splitter); if DockAlign in [alLeft,alRight] then begin Splitter.AnchorSide[akTop].Assign(Sibling.AnchorSide[akTop]); Splitter.AnchorSide[akBottom].Assign(Sibling.AnchorSide[akBottom]); // resize and move // the NewSite gets at maximum half the space // Many bounds are later set by the LCL anchoring. When docking several // controls at once the bounds are needed earlier. NewSize:=Max(1,Min(NewSite.Width,Sibling.Width div 2)); NewBounds:=Rect(0,0,NewSize,Sibling.Height); NewSiblingWidth:=Max(1,Sibling.Width-NewSize-Splitter.Width); if DockAlign=alLeft then begin // alLeft: NewControl, Splitter, Sibling Splitter.SetBounds(Sibling.Left+NewSize,Sibling.Top, Splitter.Width,Sibling.Height); Types.OffsetRect(NewBounds,Sibling.Left,Sibling.Top); Sibling.SetBounds(Splitter.Left+Splitter.Width,Sibling.Top, NewSiblingWidth,Sibling.Height); end else begin // alRight: Sibling, Splitter, NewControl Sibling.Width:=NewSiblingWidth; Splitter.SetBounds(Sibling.Left+Sibling.Width,Sibling.Top, Splitter.Width,Sibling.Height); Types.OffsetRect(NewBounds,Splitter.Left+Splitter.Width,Sibling.Top); end; NewSite.BoundsRect:=NewBounds; end else begin Splitter.AnchorSide[akLeft].Assign(Sibling.AnchorSide[akLeft]); Splitter.AnchorSide[akRight].Assign(Sibling.AnchorSide[akRight]); // resize and move // the NewSite gets at maximum half the space // Many bounds are later set by the LCL anchoring. When docking several // controls at once the bounds are needed earlier. NewSize:=Max(1,Min(NewSite.Height,Sibling.Height div 2)); NewSiblingHeight:=Max(1,Sibling.Height-NewSize-Splitter.Height); if DockAlign=alTop then begin // alTop: NewControl, Splitter, Sibling Splitter.SetBounds(Sibling.Left,Sibling.Top+NewSize, Sibling.Width,Splitter.Height); NewSite.SetBounds(Sibling.Left,Sibling.Top,Sibling.Width,NewSize); Sibling.SetBounds(Sibling.Left,Splitter.Top+Splitter.Height, Sibling.Width,NewSiblingHeight); end else begin // alBottom: Sibling, Splitter, NewControl Sibling.Height:=NewSiblingHeight; Splitter.SetBounds(Sibling.Left,Sibling.Top+Sibling.Height, Sibling.Width,Splitter.Height); NewSite.SetBounds(Sibling.Left,Splitter.Top+Splitter.Height, Sibling.Width,NewSize); end; end; end else begin { Example: insert right of all siblings ########## ####################### --------+# --------+#+----------+# SiblingA|# SiblingA|#| |# --------+# --------+#| |# ########## -----> ##########|NewControl|# --------+# --------+#| |# SiblingB|# SiblingB|#| |# --------+# --------+#+----------+# ########## ####################### } if DockAlign in [alLeft,alRight] then NewSize:=NewSite.Width else NewSize:=NewSite.Height; for i:=0 to ControlCount-1 do begin Sibling:=Controls[i]; if Sibling.AnchorSide[MainAnchor].Control=Self then begin // this Sibling is anchored to the docked site // anchor it to the splitter Sibling.AnchorToNeighbour(MainAnchor,0,Splitter); if not BoundsIncreased then begin // the NewSite gets at most half the space if DockAlign in [alLeft,alRight] then NewSize:=Min(NewSize,Sibling.Width div 2) else NewSize:=Min(NewSize,Sibling.Height div 2); end; end; end; NewSize:=Max(1,NewSize); // anchor Splitter and NewSite a:=ClockwiseAnchor[MainAnchor]; Splitter.AnchorParallel(a,0,Self); Splitter.AnchorParallel(OppositeAnchor[a],0,Self); NewSite.AnchorParallel(a,0,Self); NewSite.AnchorParallel(OppositeAnchor[a],0,Self); NewSite.AnchorParallel(MainAnchor,0,Self); NewSite.AnchorToNeighbour(OppositeAnchor[MainAnchor],0,Splitter); // Many bounds are later set by the LCL anchoring. When docking several // controls at once the bounds are needed earlier. if DockAlign in [alLeft,alRight] then begin if DockAlign=alLeft then begin // alLeft: NewSite, Splitter, other siblings Splitter.SetBounds(NewSize,0,Splitter.Width,ClientHeight); NewSite.SetBounds(0,0,NewSize,ClientHeight); end else begin // alRight: other siblings, Splitter, NewSite NewSite.SetBounds(ClientWidth-NewSize,0,NewSize,ClientHeight); Splitter.SetBounds(NewSite.Left-Splitter.Width,0,Splitter.Width,ClientHeight); end; end else begin if DockAlign=alTop then begin // alTop: NewSite, Splitter, other siblings Splitter.SetBounds(0,NewSize,ClientWidth,Splitter.Height); NewSite.SetBounds(0,0,ClientWidth,NewSize); end else begin // alBottom: other siblings, Splitter, NewSite NewSite.SetBounds(0,ClientHeight-NewSize,ClientWidth,NewSize); Splitter.SetBounds(0,NewSite.Top-Splitter.Height,ClientWidth,Splitter.Height); end; end; // shrink siblings for i:=0 to ControlCount-1 do begin Sibling:=Controls[i]; if Sibling.AnchorSide[MainAnchor].Control=Splitter then begin NewBounds:=Sibling.BoundsRect; case DockAlign of alLeft: NewBounds.Left:=Splitter.Left+Splitter.Width; alRight: NewBounds.Right:=Splitter.Left; alTop: NewBounds.Top:=Splitter.Top+Splitter.Height; alBottom: NewBounds.Bottom:=Splitter.Top; end; NewBounds.Right:=Max(NewBounds.Left+1,NewBounds.Right); NewBounds.Bottom:=Max(NewBounds.Top+1,NewBounds.Bottom); Sibling.BoundsRect:=NewBounds; end; end; end; //debugln(['TAnchorDockHostSite.DockAnotherControl ',DbgSName(Self)]); //DebugWriteChildAnchors(Self,true,true); Result:=true; end; procedure TAnchorDockHostSite.CreatePages; begin if FPages<>nil then RaiseGDBException(''); FPages:=DockMaster.PageControlClass.Create(nil); // do not own it, pages can be moved to another site FPages.FreeNotification(Self); FPages.Parent:=Self; FPages.Align:=alClient; FPages.MultiLine:=DockMaster.MultiLinePages; end; procedure TAnchorDockHostSite.FreePages; begin FreeAndNil(FPages); end; function TAnchorDockHostSite.DockSecondPage(NewControl: TControl): boolean; var OldControl: TControl; OldSite: TAnchorDockHostSite; begin {$IFDEF VerboseAnchorDockPages} debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" AControl=',DbgSName(NewControl)]); {$ENDIF} if SiteType<>adhstOneControl then RaiseGDBException('TAnchorDockHostSite.DockSecondPage inconsistency'); FSiteType:=adhstPages; CreatePages; // remove header (keep it for later use) {$IFDEF VerboseAnchorDockPages} debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" removing header ...']); {$ENDIF} Header.Parent:=nil; // put the OldControl into a page of its own {$IFDEF VerboseAnchorDockPages} debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" move oldcontrol to site of its own ...']); {$ENDIF} OldControl:=GetOneControl; OldSite:=MakeSite(OldControl); OldSite.HostDockSite:=nil; {$IFDEF VerboseAnchorDockPages} debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" adding oldcontrol site ...']); {$ENDIF} FPages.Pages.Add(OldSite.Caption); OldSite.Parent:=FPages.Page[0]; OldSite.Align:=alClient; OldSite.Visible:=true; Result:=DockAnotherPage(NewControl,nil); end; function TAnchorDockHostSite.DockAnotherPage(NewControl: TControl; InFrontOf: TControl): boolean; var NewSite: TAnchorDockHostSite; NewIndex: LongInt; begin {$IFDEF VerboseAnchorDockPages} debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" make new control (',DbgSName(NewControl),') dockable ...']); {$ENDIF} if SiteType<>adhstPages then RaiseGDBException('TAnchorDockHostSite.DockAnotherPage inconsistency'); NewSite:=MakeSite(NewControl); //debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" adding newcontrol site ...']); NewIndex:=FPages.PageCount; if (InFrontOf is TAnchorDockPage) and (InFrontOf.Parent=Pages) then NewIndex:=TAnchorDockPage(InFrontOf).PageIndex; Pages.Pages.Insert(NewIndex,NewSite.Caption); //debugln(['TAnchorDockHostSite.DockAnotherPage ',DbgSName(FPages.Page[1])]); NewSite.Parent:=FPages.Page[NewIndex]; NewSite.Align:=alClient; NewSite.Visible:=true; FPages.PageIndex:=NewIndex; Result:=true; end; procedure TAnchorDockHostSite.AddCleanControl(AControl: TControl; TheAlign: TAlign); var a: TAnchorKind; begin AControl.Parent:=Self; AControl.Align:=TheAlign; AControl.Anchors:=[akLeft,akTop,akRight,akBottom]; for a:=Low(TAnchorKind) to high(TAnchorKind) do AControl.AnchorSide[a].Control:=nil; AControl.Visible:=true; end; procedure TAnchorDockHostSite.RemoveControlFromLayout(AControl: TControl); procedure RemoveControlBoundSplitter(Splitter: TAnchorDockSplitter; Side: TAnchorKind); var i: Integer; Sibling: TControl; NewBounds: TRect; begin //debugln(['RemoveControlBoundSplitter START ',DbgSName(Splitter)]); { Example: Side=akRight # # ##################### ######### ---+S+--------+# ---+# ---+S|AControl|# ---> ---+# ---+S+--------+# ---+# ##################### ######### } for i:=Splitter.AnchoredControlCount-1 downto 0 do begin Sibling:=Splitter.AnchoredControls[i]; if Sibling.AnchorSide[Side].Control=Splitter then begin // anchor Sibling to next Sibling.AnchorSide[Side].Assign(AControl.AnchorSide[Side]); // enlarge Sibling NewBounds:=Sibling.BoundsRect; case Side of akTop: NewBounds.Top:=AControl.Top; akLeft: NewBounds.Left:=AControl.Left; akRight: NewBounds.Right:=AControl.Left+AControl.Width; akBottom: NewBounds.Bottom:=AControl.Top+AControl.Height; end; if (sibling is TAnchorDockHostSite) then if (sibling as TAnchorDockHostSite).Minimized then begin DockMaster.FMapMinimizedControls.Remove((sibling as TAnchorDockHostSite).FMinimizedControl); (sibling as TAnchorDockHostSite).FMinimizedControl.Parent:=(sibling as TAnchorDockHostSite); (sibling as TAnchorDockHostSite).FMinimizedControl.Visible:=True; (sibling as TAnchorDockHostSite).FMinimizedControl:=nil; (sibling as TAnchorDockHostSite).UpdateHeaderAlign; end; Sibling.BoundsRect:=NewBounds; end; end; //debugln(['RemoveControlBoundSplitter ',DbgSName(Splitter)]); Splitter.Free; ClearChildControlAnchorSides(AControl); //DebugWriteChildAnchors(GetParentForm(Self),true,true); end; procedure ConvertToOneControlType(OnlySiteLeft: TAnchorDockHostSite); var a: TAnchorKind; NewBounds: TRect; p: TPoint; i: Integer; Sibling: TControl; NewParentBounds: TRect; begin BeginUpdateLayout; try // remove splitter for i:=ControlCount-1 downto 0 do begin Sibling:=Controls[i]; if Sibling is TAnchorDockSplitter then Sibling.Free else if Sibling is TAnchorDockHostSite then for a:=low(TAnchorKind) to high(TAnchorKind) do Sibling.AnchorSide[a].Control:=nil; end; if (Parent=nil) then begin // shrink this site NewBounds:=OnlySiteLeft.BoundsRect; p:=ClientOrigin; Types.OffsetRect(NewBounds,p.x,p.y); BoundsRect:=NewBounds; end else if DockMaster.IsCustomSite(Parent) then begin // parent is a custom dock site // shrink this site and the parent NewParentBounds:=Parent.BoundsRect; case Align of alTop: begin inc(NewParentBounds.Top,Height-OnlySiteLeft.Height); Width:=Parent.ClientWidth; Height:=OnlySiteLeft.Height; end; alBottom: begin dec(NewParentBounds.Bottom,Height-OnlySiteLeft.Height); Width:=Parent.ClientWidth; Height:=OnlySiteLeft.Height; end; alLeft: begin inc(NewParentBounds.Left,Width-OnlySiteLeft.Width); Width:=OnlySiteLeft.Width; Height:=Parent.ClientHeight; end; alRight: begin dec(NewParentBounds.Right,Width-OnlySiteLeft.Width); Width:=OnlySiteLeft.Width; Height:=Parent.ClientHeight; end; end; Parent.BoundsRect:=NewParentBounds; end; // change type FSiteType:=adhstOneControl; OnlySiteLeft.Align:=alClient; Header.Parent:=Self; if OnlySiteLeft.Minimized then begin DockMaster.FMapMinimizedControls.Remove(OnlySiteLeft.FMinimizedControl); OnlySiteLeft.FMinimizedControl.Parent:=OnlySiteLeft; OnlySiteLeft.FMinimizedControl.Visible:=True; OnlySiteLeft.FMinimizedControl:=nil; UpdateHeaderAlign; end; UpdateHeaderAlign; //debugln(['TAnchorDockHostSite.RemoveControlFromLayout.ConvertToOneControlType AFTER CONVERT "',Caption,'" to onecontrol OnlySiteLeft="',OnlySiteLeft.Caption,'"']); //DebugWriteChildAnchors(GetParentForm(Self),true,true); DockMaster.NeedSimplify(Self); finally EndUpdateLayout; end; end; var Side: TAnchorKind; Splitter: TAnchorDockSplitter; OnlySiteLeft: TAnchorDockHostSite; Sibling: TControl; SplitterCount: Integer; begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.RemoveControlFromLayout Self="',Caption,'" AControl=',DbgSName(AControl),'="',AControl.Caption,'"']); {$ENDIF} if SiteType<>adhstLayout then RaiseGDBException('TAnchorDockHostSite.RemoveControlFromLayout inconsistency'); if IsOneSiteLayout(OnlySiteLeft) then begin ClearChildControlAnchorSides(AControl); ConvertToOneControlType(OnlySiteLeft); exit; end; // remove a splitter and fill the gap SplitterCount:=0; for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin Sibling:=AControl.AnchorSide[OppositeAnchor[Side]].Control; if Sibling is TAnchorDockSplitter then begin inc(SplitterCount); Splitter:=TAnchorDockSplitter(Sibling); if Splitter.SideAnchoredControlCount(Side)=1 then begin // Splitter is only used by AControl at Side RemoveControlBoundSplitter(Splitter,Side); exit; end; end; end; if SplitterCount=4 then begin RemoveSpiralSplitter(AControl); exit; end; ClearChildControlAnchorSides(AControl); end; procedure TAnchorDockHostSite.RemoveMinimizedControl; begin FMinimizedControl:=nil; DockMaster.FMapMinimizedControls.Remove(FMinimizedControl); end; procedure TAnchorDockHostSite.RemoveSpiralSplitter(AControl: TControl); { Merge two splitters and delete one of them. Prefer the pair with shortest distance between. For example: 3 3 111111111111113 3 2+--------+3 3 2|AControl|3 ---> 111111111 2+--------+3 2 24444444444444 2 2 2 Everything anchored to 4 is now anchored to 1. And right side of 1 is now anchored to where the right side of 4 was anchored. } var Splitters: array[TAnchorKind] of TAnchorDockSplitter; Side: TAnchorKind; Keep: TAnchorKind; DeleteSplitter: TAnchorDockSplitter; i: Integer; Sibling: TControl; NextSide: TAnchorKind; NewBounds: TRect; begin for Side:=low(TAnchorKind) to high(TAnchorKind) do Splitters[Side]:=AControl.AnchorSide[Side].Control as TAnchorDockSplitter; // Prefer the pair with shortest distance between if (Splitters[akRight].Left-Splitters[akLeft].Left) <(Splitters[akBottom].Top-Splitters[akTop].Top) then Keep:=akLeft else Keep:=akTop; DeleteSplitter:=Splitters[OppositeAnchor[Keep]]; // transfer anchors from the deleting splitter to the kept splitter for i:=0 to ControlCount-1 do begin Sibling:=Controls[i]; for Side:=low(TAnchorKind) to high(TAnchorKind) do begin if Sibling.AnchorSide[Side].Control=DeleteSplitter then Sibling.AnchorSide[Side].Control:=Splitters[Keep]; end; end; // longen kept splitter NextSide:=ClockwiseAnchor[Keep]; if Splitters[Keep].AnchorSide[NextSide].Control<>Splitters[NextSide] then NextSide:=OppositeAnchor[NextSide]; Splitters[Keep].AnchorSide[NextSide].Control:= DeleteSplitter.AnchorSide[NextSide].Control; case NextSide of akTop: Splitters[Keep].Top:=DeleteSplitter.Top; akLeft: Splitters[Keep].Left:=DeleteSplitter.Left; akRight: Splitters[Keep].Width:=DeleteSplitter.Left+DeleteSplitter.Width-Splitters[Keep].Left; akBottom: Splitters[Keep].Height:=DeleteSplitter.Top+DeleteSplitter.Height-Splitters[Keep].Top; end; // move splitter to the middle if Keep=akLeft then Splitters[Keep].Left:=(Splitters[Keep].Left+DeleteSplitter.Left) div 2 else Splitters[Keep].Top:=(Splitters[Keep].Top+DeleteSplitter.Top) div 2; // adjust all anchored controls for i:=0 to ControlCount-1 do begin Sibling:=Controls[i]; for Side:=low(TAnchorKind) to high(TAnchorKind) do begin if Sibling.AnchorSide[Side].Control=Splitters[Keep] then begin NewBounds:=Sibling.BoundsRect; case Side of akTop: NewBounds.Top:=Splitters[Keep].Top+Splitters[Keep].Height; akLeft: NewBounds.Left:=Splitters[Keep].Left+Splitters[Keep].Width; akRight: NewBounds.Right:=Splitters[Keep].Left; akBottom: NewBounds.Bottom:=Splitters[Keep].Top; end; Sibling.BoundsRect:=NewBounds; end; end; end; // delete the splitter DeleteSplitter.Free; ClearChildControlAnchorSides(AControl); end; procedure TAnchorDockHostSite.ClearChildControlAnchorSides(AControl: TControl); var Side: TAnchorKind; Sibling: TControl; begin for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin Sibling:=AControl.AnchorSide[Side].Control; if (Sibling=nil) then continue; if (Sibling.Parent=Self) then AControl.AnchorSide[Side].Control:=nil; end; end; procedure TAnchorDockHostSite.Simplify; var AControl: TControl; begin if (Pages<>nil) and (Pages.PageCount=1) then SimplifyPages else if (SiteType=adhstOneControl) then begin AControl:=GetOneControl; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.Simplify ',DbgSName(Self),' ',DbgSName(AControl)]); {$ENDIF} if AControl is TAnchorDockHostSite then SimplifyOneControl else if ((AControl=nil) or (csDestroying in AControl.ComponentState)) then DockMaster.NeedFree(Self); end; end; procedure TAnchorDockHostSite.SimplifyPages; var Page: TAnchorDockPage; Site: TAnchorDockHostSite; begin if Pages=nil then exit; if DockMaster.IsReleasing(Pages) then exit; if Pages.PageCount=1 then begin {$IFDEF VerboseAnchorDockPages} debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=1']); {$ENDIF} DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyPages'){$ENDIF}; BeginUpdateLayout; try // move the content of the Page to the place where Pages is Page:=Pages.DockPages[0]; Site:=Page.GetSite; Site.Parent:=Self; if Site<>nil then CopyAnchorBounds(Pages,Site); if SiteType=adhstPages then FSiteType:=adhstOneControl; // free Pages DockMaster.NeedFree(Pages); if SiteType=adhstOneControl then SimplifyOneControl; finally EndUpdateLayout; EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyPages'){$ENDIF}; end; //debugln(['TAnchorDockHostSite.SimplifyPages END Self="',Caption,'"']); //DebugWriteChildAnchors(GetParentForm(Self),true,true); end else if Pages.PageCount=0 then begin //debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=0 Self=',dbgs(Pointer(Self))]); FSiteType:=adhstNone; FreePages; DockMaster.NeedSimplify(Self); end; end; procedure TAnchorDockHostSite.SimplifyOneControl; var Site: TAnchorDockHostSite; i: Integer; Child, PlaceHolder: TControl; a: TAnchorKind; begin if SiteType<>adhstOneControl then exit; if not IsOneSiteLayout(Site) then exit; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.SimplifyOneControl Self="',Caption,'" Site="',Site.Caption,'"']); {$ENDIF} DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyOneControl'){$ENDIF}; BeginUpdateLayout; try // move the content of Site up and free Site // Note: it is not possible to do it the other way round, because moving a // form to screen changes the z order and focus FSiteType:=Site.SiteType; // header Header.Align:=Site.Header.Align; Header.HeaderPosition:=Site.Header.HeaderPosition; Header.Caption:=Site.Header.Caption; UpdateHeaderShowing; Caption:=Site.Caption; Site.BeginUpdateLayout; // move controls from Site to Self // when a site is moved to a other parent, we have to insert a place holder // on old site or the splitters will be removed, see issue #34937 i:=Site.ControlCount-1; while i>=0 do begin Child:=Site.Controls[i]; if (Child.Owner<>Site) then begin if not (Child is TAnchorDockSplitter) then begin PlaceHolder:=TAnchorDockHostSite.CreateNew(Site); PlaceHolder.Parent:=Site; PlaceHolder.Anchors:=Child.Anchors; for a:=Low(TAnchorKind) to High(TAnchorKind) do PlaceHolder.AnchorSide[a].Control:=Child.AnchorSide[a].Control; PlaceHolder.SetBounds(Child.Left, Child.Top, Child.Width, Child.Height); PlaceHolder.Name:='_'+Child.Name; PlaceHolder.Visible:=Child.Visible; end; Child.Parent:=Self; if Child=Site.Pages then begin FPages:=Site.Pages; Site.FPages:=nil; end; if Child.HostDockSite=Site then Child.HostDockSite:=Self; for a:=low(TAnchorKind) to high(TAnchorKind) do begin if Child.AnchorSide[a].Control=Site then Child.AnchorSide[a].Control:=Self; end; end; i:=Min(i,Site.ControlCount)-1; end; for i:=0 to ControlCount-1 do begin Child:=Controls[i]; PlaceHolder:=TControl(Site.FindComponent('_'+Child.Name)); if not Assigned(PlaceHolder) then continue; for a:=Low(TAnchorKind) to High(TAnchorKind) do if PlaceHolder.AnchorSide[a].Control<>Site then Child.AnchorSide[a].Control:=PlaceHolder.AnchorSide[a].Control; end; Site.EndUpdateLayout; // delete Site Site.FSiteType:=adhstNone; DockMaster.NeedFree(Site); finally EndUpdateLayout; EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyOneControl'){$ENDIF}; end; //debugln(['TAnchorDockHostSite.SimplifyOneControl END Self="',Caption,'"']); //DebugWriteChildAnchors(GetParentForm(Self),true,true); end; function TAnchorDockHostSite.GetOneControl: TControl; var i: Integer; begin for i:=0 to ControlCount-1 do begin Result:=Controls[i]; if Result.Owner<>Self then exit; end; result:=FMinimizedControl; //Result:=nil; end; function TAnchorDockHostSite.GetSiteCount: integer; var i: Integer; Child: TControl; begin Result:=0; for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if not (Child is TAnchorDockHostSite) then continue; if not Child.IsControlVisible then continue; inc(Result); end; end; function TAnchorDockHostSite.GetParentHostSite: TAnchorDockHostSite; var p: TWinControl; begin if IsDockedPage then p := Parent.Parent.Parent else p := Parent; if p is TAnchorDockHostSite then Result := TAnchorDockHostSite(p) else Result := nil; end; function TAnchorDockHostSite.GetParentHostSiteOfTabbed(ASide: TAlign): TAnchorDockHostSite; var p: TWinControl; h: TAnchorDockHostSite; begin h := Self; if ASide in [alTop,alBottom,alLeft,alRight] then while (h.Parent <> nil) and (h.Parent is TAnchorDockHostSite) and (not (h.Parent as TAnchorDockHostSite).ControlHasSplitter(h, ASide)) do h := h.Parent as TAnchorDockHostSite; if h.IsDockedPage then p := h.Parent.Parent.Parent else p := Self.Parent; if p is TAnchorDockHostSite then Result := TAnchorDockHostSite(p) else Result := nil; end; function TAnchorDockHostSite.IsOneSiteLayout(out Site: TAnchorDockHostSite ): boolean; var i: Integer; Child: TControl; begin Site:=nil; for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if not (Child is TAnchorDockHostSite) then continue; if not Child.IsControlVisible then continue; if Site<>nil then exit(false); Site:=TAnchorDockHostSite(Child); end; Result:=Site<>nil; end; function TAnchorDockHostSite.IsTwoSiteLayout(out Site1, Site2: TAnchorDockHostSite): boolean; var i: Integer; Child: TControl; begin Site1:=nil; Site2:=nil; for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if not (Child is TAnchorDockHostSite) then continue; if not Child.IsControlVisible then continue; if Site1=nil then Site1:=TAnchorDockHostSite(Child) else if Site2=nil then Site2:=TAnchorDockHostSite(Child) else exit(false); end; Result:=Site2<>nil; end; function TAnchorDockHostSite.ControlHasSplitter(AControl: TControl; ASide: TAlign): boolean; var Sibling: TControl; begin Sibling:=AControl.AnchorSide[MainAlignAnchor[ASide]].Control; Result := (Sibling <> nil) and (Sibling is TAnchorDockSplitter); end; function TAnchorDockHostSite.IsDockedPage(ASide: TAlign): boolean; var h: TWinControl; begin h := Parent; h := Self; if ASide in [alTop,alBottom,alLeft,alRight] then while (h.Parent <> nil) and (h.Parent is TAnchorDockHostSite) and (not (h.Parent as TAnchorDockHostSite).ControlHasSplitter(h, ASide)) do h := h.Parent; Result := (h.Parent is TAnchorDockPage) and (h.Parent.Parent is TAnchorDockPageControl ) and (h.Parent.Parent.Parent is TAnchorDockHostSite); end; function TAnchorDockHostSite.NestedDockedPageCount(ASide: TAlign): integer; var p: TAnchorDockHostSite; begin Result := 0; p := Self; while (p <> nil) and p.IsDockedPage(ASide) do begin inc(Result); p := p.GetParentHostSiteOfTabbed(ASide); end; end; function TAnchorDockHostSite.GetUniqueSplitterName: string; var i: Integer; begin i:=0; repeat inc(i); Result:=AnchorDockSplitterName+IntToStr(i); until FindComponent(Result)=nil; end; function TAnchorDockHostSite.MakeSite(AControl: TControl): TAnchorDockHostSite; begin if AControl is TAnchorDockHostSite then Result:=TAnchorDockHostSite(AControl) else begin Result:=DockMaster.CreateSite; try AControl.ManualDock(Result,nil,alClient); finally Result.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; end; end; end; procedure TAnchorDockHostSite.MoveAllControls(dx, dy: integer); // move all children, except the sides that are anchored to parent left,top var i: Integer; Child: TControl; NewBounds: TRect; begin for i:=0 to ControlCount-1 do begin Child:=Controls[i]; NewBounds:=Child.BoundsRect; Types.OffsetRect(NewBounds,dx,dy); if Child.AnchorSideLeft.Control=Self then NewBounds.Left:=0; if Child.AnchorSideTop.Control=Self then NewBounds.Top:=0; Child.BoundsRect:=NewBounds; end; end; procedure TAnchorDockHostSite.AlignControls(AControl: TControl; var ARect: TRect); var i: Integer; Child: TControl; Splitter: TAnchorDockSplitter; begin inherited AlignControls(AControl, ARect); if csDestroying in ComponentState then exit; if DockMaster.ScaleOnResize and (not UpdatingLayout) and (not DockMaster.Restoring) then begin // scale splitters for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if not Child.IsControlVisible then continue; if Child is TAnchorDockSplitter then begin Splitter:=TAnchorDockSplitter(Child); //debugln(['TAnchorDockHostSite.AlignControls ',Caption,' ',DbgSName(Splitter),' OldBounds=',dbgs(Splitter.BoundsRect),' BaseBounds=',dbgs(Splitter.DockBounds),' BaseParentSize=',dbgs(Splitter.DockParentClientSize),' ParentSize=',ClientWidth,'x',ClientHeight]); Splitter.SetBoundsPercentually; //debugln(['TAnchorDockHostSite.AlignControls ',Caption,' ',DbgSName(Child),' NewBounds=',dbgs(Child.BoundsRect)]); end; end; end; end; function TAnchorDockHostSite.CheckIfOneControlHidden: boolean; var Child: TControl; begin Result:=false; //debugln(['TAnchorDockHostSite.CheckIfOneControlHidden ',DbgSName(Self),' UpdatingLayout=',UpdatingLayout,' Visible=',Visible,' Parent=',DbgSName(Parent),' csDestroying=',csDestroying in ComponentState,' SiteType=',dbgs(SiteType)]); if UpdatingLayout or (not IsControlVisible) or (csDestroying in ComponentState) or (SiteType<>adhstOneControl) then exit; Child:=GetOneControl; if (Child=nil) then exit; if Child.IsControlVisible then exit; // docked child was hidden/closed Result:=true; // => undock BeginUpdateLayout; DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CheckIfOneControlHidden'){$ENDIF}; try {$IFDEF VerboseAnchorDocking} 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]); {$ENDIF} Visible:=false; Parent:=nil; finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CheckIfOneControlHidden'){$ENDIF}; end; EndUpdateLayout; if (not (Child is TCustomForm)) or (csDestroying in Child.ComponentState) then Release; end; procedure TAnchorDockHostSite.DoDock(NewDockSite: TWinControl; var ARect: TRect); begin inherited DoDock(NewDockSite, ARect); if DockMaster <> nil then DockMaster.SimplifyPendingLayouts; end; procedure TAnchorDockHostSite.SetParent(NewParent: TWinControl); var OldCaption: string; OldParent: TWinControl; begin OldParent:=Parent; if NewParent=OldParent then exit; inherited SetParent(NewParent); OldCaption:=Caption; UpdateDockCaption; if OldCaption<>Caption then begin // UpdateDockCaption has not updated parents => do it now if Parent is TAnchorDockHostSite then TAnchorDockHostSite(Parent).UpdateDockCaption; if Parent is TAnchorDockPage then TAnchorDockPage(Parent).UpdateDockCaption; end; UpdateHeaderShowing; if (BoundSplitter<>nil) and (BoundSplitter.Parent<>Parent) then begin //debugln(['TAnchorDockHostSite.SetParent freeing splitter: ',DbgSName(BoundSplitter)]); FreeAndNil(FBoundSplitter); end; if Parent=nil then BorderStyle:=bsSizeable else BorderStyle:=bsNone; end; function TAnchorDockHostSite.HeaderNeedsShowing: boolean; begin Result:=(SiteType<>adhstLayout) and (not (Parent is TAnchorDockPage)) and Assigned(DockMaster) and DockMaster.ShowHeader; end; procedure TAnchorDockHostSite.DoClose(var CloseAction: TCloseAction); var AControl: TControl; AForm: TCustomForm absolute AControl; begin if (GetSiteCount=0) and not DockMaster.FAllClosing then begin AControl:=GetOneControl; if (AControl is TCustomForm) then begin AForm.Close; if csDestroying in AForm.ComponentState then CloseAction:=caFree else if AForm.Visible then CloseAction:=caNone; end; end; inherited DoClose(CloseAction); end; function TAnchorDockHostSite.CanUndock: boolean; begin Result:=Parent<>nil; end; procedure TAnchorDockHostSite.Undock; var p: TPoint; begin if Parent=nil then exit; DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Undock'){$ENDIF}; try p := Point(0,0); p := ClientToScreen(p); Parent:=nil; SetBounds(p.x,p.y,Width,Height); finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Undock'){$ENDIF}; end; end; function TAnchorDockHostSite.CanMerge: boolean; begin Result:=(SiteType=adhstLayout) and (Parent is TAnchorDockHostSite) and (TAnchorDockHostSite(Parent).SiteType=adhstLayout); end; procedure TAnchorDockHostSite.Merge; { Move all child controls to parent and delete this site } var ParentSite: TAnchorDockHostSite; i: Integer; Child: TControl; Side: TAnchorKind; begin ParentSite:=Parent as TAnchorDockHostSite; if (SiteType<>adhstLayout) or (ParentSite.SiteType<>adhstLayout) then RaiseGDBException(''); ParentSite.BeginUpdateLayout; DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Merge'){$ENDIF}; try for i := ControlCount - 1 downto 0 do begin Child := Controls[i]; if Child.Owner <> Self then begin Child.Parent := ParentSite; Child.SetBounds(Child.Left + Left, Child.Top + Top, Child.Width, Child.Height); for Side := Low(TAnchorKind) to High(TAnchorKind) do if Child.AnchorSide[Side].Control = Self then Child.AnchorSide[Side].Assign(AnchorSide[Side]); end; end; Parent:=nil; DockMaster.NeedFree(Self); finally ParentSite.EndUpdateLayout; // not needed, because this site is freed: EnableAutoSizing; end; end; function TAnchorDockHostSite.EnlargeSide(Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; { Shrink one splitter, enlarge the other splitter. |#| |# |#| |# |#| Control |# |#| |# --+#+---------+# --> --+#| Control |# ===============# ===#| |# --------------+# --+#| |# A |# A|#| |# --------------+# --+#+---------+# ================== =================== Move one neighbor splitter, enlarge Control, resize one splitter, rotate the other splitter. |#| |#| |#| |#| |#| Control |#| |#| |#| --+#+---------+#+-- --> --+#| Control |#+-- =================== ===#| |#=== --------+#+-------- --+#| |#+-- |#| B |#| |#|B |#+-------- |#| |#+-- A |#========= A|#| |#=== |#+-------- |#| |#+-- |#| C |#| |#|C --------+#+-------- --+#+---------+#+-- =================== =================== } begin Result:=true; if EnlargeSideResizeTwoSplitters(Side,ClockwiseAnchor[Side], OnlyCheckIfPossible) then exit; if EnlargeSideResizeTwoSplitters(Side,OppositeAnchor[ClockwiseAnchor[Side]], OnlyCheckIfPossible) then exit; if EnlargeSideRotateSplitter(Side,OnlyCheckIfPossible) then exit; Result:=false; end; function TAnchorDockHostSite.EnlargeSideResizeTwoSplitters(ShrinkSplitterSide, EnlargeSpitterSide: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; { Shrink one neighbor control, enlarge Self. Two splitters are resized. For example: ShrinkSplitterSide=akBottom, EnlargeSpitterSide=akLeft |#| |# |#| |# |#| Self |# |#| |# --+#+--------+# --> --+#| Self |# ==============# ===#| |# -------------+# --+#| |# A |# A|#| |# -------------+# --+#+--------+# ================= ================== } var ParentSite: TAnchorDockHostSite; ShrinkSplitter: TAnchorDockSplitter; EnlargeSplitter: TAnchorDockSplitter; KeptSide: TAnchorKind; KeptAnchorControl: TControl; Sibling: TControl; ShrinkControl: TControl; i: Integer; begin Result:=false; if not (Parent is TAnchorDockHostSite) then exit; ParentSite:=TAnchorDockHostSite(Parent); if not OnlyCheckIfPossible then begin ParentSite.BeginUpdateLayout; ParentSite.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideResizeTwoSplitters'){$ENDIF}; end; try // check ShrinkSplitter ShrinkSplitter:=TAnchorDockSplitter(AnchorSide[ShrinkSplitterSide].Control); if not (ShrinkSplitter is TAnchorDockSplitter) then exit; // check if EnlargeSpitterSide is a neighbor ShrinkSplitterSide if (EnlargeSpitterSide<>ClockwiseAnchor[ShrinkSplitterSide]) and (EnlargeSpitterSide<>OppositeAnchor[ClockwiseAnchor[ShrinkSplitterSide]]) then exit; // check EnlargeSpitter EnlargeSplitter:=TAnchorDockSplitter(AnchorSide[EnlargeSpitterSide].Control); if not (EnlargeSplitter is TAnchorDockSplitter) then exit; // check if KeptSide is anchored to a splitter or parent KeptSide:=OppositeAnchor[EnlargeSpitterSide]; KeptAnchorControl:=AnchorSide[KeptSide].Control; if not ((KeptAnchorControl=ParentSite) or (KeptAnchorControl is TAnchorDockSplitter)) then exit; // check if ShrinkSplitter is anchored/stops at KeptAnchorControl if ShrinkSplitter.AnchorSide[KeptSide].Control<>KeptAnchorControl then exit; // check if there is a control to shrink ShrinkControl:=nil; for i:=0 to ShrinkSplitter.AnchoredControlCount-1 do begin Sibling:=ShrinkSplitter.AnchoredControls[i]; if (Sibling.AnchorSide[OppositeAnchor[ShrinkSplitterSide]].Control=ShrinkSplitter) and (Sibling.AnchorSide[KeptSide].Control=KeptAnchorControl) then begin ShrinkControl:=Sibling; break; end; end; if ShrinkControl=nil then exit; if OnlyCheckIfPossible then begin // check if ShrinkControl is large enough for shrinking case EnlargeSpitterSide of akTop: if ShrinkControl.Top>=EnlargeSplitter.Top then exit; akLeft: if ShrinkControl.Left>=EnlargeSplitter.Left then exit; akRight: if ShrinkControl.Left+ShrinkControl.Width <=EnlargeSplitter.Left+EnlargeSplitter.Width then exit; akBottom: if ShrinkControl.Top+ShrinkControl.Height <=EnlargeSplitter.Top+EnlargeSplitter.Height then exit; end; end else begin // do it // enlarge the EnlargeSplitter and Self AnchorAndChangeBounds(EnlargeSplitter,ShrinkSplitterSide, ShrinkControl.AnchorSide[ShrinkSplitterSide].Control); AnchorAndChangeBounds(Self,ShrinkSplitterSide, ShrinkControl.AnchorSide[ShrinkSplitterSide].Control); // shrink the ShrinkSplitter and ShrinkControl AnchorAndChangeBounds(ShrinkSplitter,KeptSide,EnlargeSplitter); AnchorAndChangeBounds(ShrinkControl,KeptSide,EnlargeSplitter); end; finally if not OnlyCheckIfPossible then begin ParentSite.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideResizeTwoSplitters'){$ENDIF}; ParentSite.EndUpdateLayout; end; end; Result:=true; end; function TAnchorDockHostSite.EnlargeSideRotateSplitter(Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; { Shrink splitter at Side, enlarge both neighbor splitters, rotate the splitter behind, enlarge Control, shrink controls at rotate splitter |#| |#| |#| |#| |#| Control |#| |#| |#| --+#+---------+#+-- --> --+#| Control |#+-- =================== ===#| |#=== --------+#+-------- --+#| |#+-- |#| B |#| |#|B |#+-------- |#| |#+-- A |#========= A|#| |#=== |#+-------- |#| |#+-- |#| C |#| |#|C --------+#+-------- --+#+---------+#+-- =================== =================== } var Splitter: TAnchorDockSplitter; CWSide: TAnchorKind; CWSplitter: TAnchorDockSplitter; CCWSide: TAnchorKind; i: Integer; Sibling: TControl; BehindSide: TAnchorKind; RotateSplitter: TAnchorDockSplitter; CCWSplitter: TAnchorDockSplitter; begin Result:=false; // check if there is a splitter at Side Splitter:=TAnchorDockSplitter(AnchorSide[Side].Control); if not (Splitter is TAnchorDockSplitter) then exit; // check if there is a splitter at clockwise Side CWSide:=ClockwiseAnchor[Side]; CWSplitter:=TAnchorDockSplitter(AnchorSide[CWSide].Control); if not (CWSplitter is TAnchorDockSplitter) then exit; // check if there is a splitter at counter clockwise Side CCWSide:=OppositeAnchor[CWSide]; CCWSplitter:=TAnchorDockSplitter(AnchorSide[CCWSide].Control); if not (CCWSplitter is TAnchorDockSplitter) then exit; // check if neighbor splitters end at Splitter if CWSplitter.AnchorSide[Side].Control<>Splitter then exit; if CCWSplitter.AnchorSide[Side].Control<>Splitter then exit; // find the rotate splitter behind Splitter BehindSide:=OppositeAnchor[Side]; RotateSplitter:=nil; for i:=0 to Splitter.AnchoredControlCount-1 do begin Sibling:=Splitter.AnchoredControls[i]; if Sibling.AnchorSide[BehindSide].Control<>Splitter then continue; if not (Sibling is TAnchorDockSplitter) then continue; if Side in [akLeft,akRight] then begin if Sibling.TopTop+Height then continue; end else begin if Sibling.LeftLeft+Width then continue; end; if RotateSplitter=nil then RotateSplitter:=TAnchorDockSplitter(Sibling) else // there are multiple splitters behind exit; end; if RotateSplitter=nil then exit; // check that all siblings at RotateSplitter are large enough to shrink for i:=0 to RotateSplitter.AnchoredControlCount-1 do begin Sibling:=RotateSplitter.AnchoredControls[i]; if Side in [akLeft,akRight] then begin if (Sibling.Top>Top-DockMaster.SplitterWidth) and (Sibling.Top+Sibling.HeightLeft-DockMaster.SplitterWidth) and (Sibling.Left+Sibling.WidthTop then continue; akTop: if Sibling.Left>Left then continue; akBottom: if Sibling.Leftnil then exit; FBoundSplitter:=DockMaster.CreateSplitter; BoundSplitter.FreeNotification(Self); BoundSplitter.Align:=Align; BoundSplitter.Parent:=Parent; if Disabled then begin BoundSplitter.Width:=0; BoundSplitter.Height:=0; BoundSplitter.Visible:=false; end; end; procedure TAnchorDockHostSite.PositionBoundSplitter; begin case Align of alTop: BoundSplitter.SetBounds(0,Height,Parent.ClientWidth,BoundSplitter.Height); alBottom: BoundSplitter.SetBounds(0,Parent.ClientHeight-Height-BoundSplitter.Height, Parent.ClientWidth,BoundSplitter.Height); alLeft: BoundSplitter.SetBounds(Width,0,BoundSplitter.Width,Parent.ClientHeight); alRight: BoundSplitter.SetBounds(Parent.ClientWidth-Width-BoundSplitter.Width,0 ,BoundSplitter.Width,Parent.ClientHeight); end; end; function TAnchorDockHostSite.CloseQuery: boolean; function Check(AControl: TWinControl): boolean; var i: Integer; Child: TControl; begin for i:=0 to AControl.ControlCount-1 do begin Child:=AControl.Controls[i]; if Child is TWinControl then begin if Child is TCustomForm then begin if not TCustomForm(Child).CloseQuery then exit(false); end else begin if not Check(TWinControl(Child)) then exit(false); end; end; end; Result:=true; end; begin Result:=Check(Self); end; function CheckOposite(Side:TAnchorKind;AControl: TControl;out Splitter: TAnchorDockSplitter; out SplitterAnchorKind:TAnchorKind):boolean; begin result:=GetDockSplitter(AControl,Side,Splitter); if result then begin if CountAnchoredControls(Splitter,OppositeAnchor[Side])=1 then begin SplitterAnchorKind:=Side; exit; end; end; result:=false end; function FindNearestSpliter(AControl: TControl;out Splitter: TAnchorDockSplitter;out SplitterAnchorKind:TAnchorKind):boolean; begin result:=CheckOposite(akTop,AControl,Splitter,SplitterAnchorKind); if result then exit; result:=CheckOposite(akRight,AControl,Splitter,SplitterAnchorKind); if result then exit; result:=CheckOposite(akBottom,AControl,Splitter,SplitterAnchorKind); if result then exit; result:=CheckOposite(akLeft,AControl,Splitter,SplitterAnchorKind); end; function TAnchorDockHostSite.CanBeMinimized(out Splitter: TAnchorDockSplitter; out SplitterAnchorKind:TAnchorKind):boolean; var //AControl: TControl; OpositeDockHostSite:TAnchorDockHostSite; OpositeSplitter: TAnchorDockSplitter; begin result:=false; if FindNearestSpliter(self,Splitter,SplitterAnchorKind) then begin OpositeDockHostSite:=CountAndReturnOnlyOneMinimizedAnchoredControls(Splitter,SplitterAnchorKind); if (Splitter.Enabled and (OpositeDockHostSite=nil)) then begin result:=true; if CheckOposite(OppositeAnchorKind[SplitterAnchorKind],self,OpositeSplitter,SplitterAnchorKind) then if Assigned(OpositeSplitter) then if not OpositeSplitter.Enabled then result:=false; end; end; end; procedure TAnchorDockHostSite.MinimizeSite; begin //Application.QueueAsyncCall(@AsyncMinimizeSite,0); AsyncMinimizeSite(0); end; procedure TAnchorDockHostSite.AsyncMinimizeSite(Data: PtrInt); var AControl: TControl; Splitter: TAnchorDockSplitter; SplitterAnchorKind:TAnchorKind; MaxSize:integer; begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.MinimizeSite ',DbgSName(Self),' SiteType=',dbgs(SiteType)]); {$ENDIF} if Minimized then AControl:=FMinimizedControl else AControl:=GetOneControl; if CanBeMinimized(Splitter,SplitterAnchorKind) or Minimized then begin if not Minimized then begin FMinimizedControl:=AControl; AControl.Visible:=False; AControl.Parent:=nil; DockMaster.FMapMinimizedControls.Add(AControl,Self); end else begin MaxSize:=ReturnAnchoredControlsSize(Splitter,SplitterAnchorKind); case SplitterAnchorKind of akTop: if AControl.Height>=MaxSize+Height then Splitter.FPercentPosition:=1-(MaxSize+Height)/(Splitter.Parent.ClientHeight*2); akBottom: if AControl.Height>=MaxSize+Height then Splitter.FPercentPosition:=(MaxSize+Height)/(Splitter.Parent.ClientHeight*2); akLeft: if AControl.Width>=MaxSize+Width then Splitter.FPercentPosition:=1-(MaxSize+Width)/(Splitter.Parent.ClientWidth*2); akRight: if AControl.Width>=MaxSize+Width then Splitter.FPercentPosition:=(MaxSize+Width)/(Splitter.Parent.ClientWidth*2); end; AControl.Parent:=self; AControl.Visible:=True; FMinimizedControl:=nil; DockMaster.FMapMinimizedControls.Remove(AControl); end; Splitter.Enabled:=AControl.Visible; UpdateHeaderAlign; dockmaster.UpdateHeaders; dockmaster.InvalidateHeaders; Splitter.SetBoundsPercentually; end; end; procedure TAnchorDockHostSite.ShowMinimizedControl; var Splitter: TAnchorDockSplitter; SplitterAnchorKind:TAnchorKind; SpliterRect,OverlappingFormRect:TRect; begin if FindNearestSpliter(self,Splitter,SplitterAnchorKind) then begin SpliterRect:=Splitter.GetSpliterBoundsWithUnminimizedDockSites; OverlappingFormRect:=BoundsRect; case SplitterAnchorKind of akTop:OverlappingFormRect.Top:=SpliterRect.Bottom; akLeft:OverlappingFormRect.Left:=SpliterRect.Right; akRight:OverlappingFormRect.Right:=SpliterRect.Left; akBottom:OverlappingFormRect.Bottom:=SpliterRect.Top; end; DockMaster.FOverlappingForm:=TAnchorDockOverlappingForm.CreateNew(self); DockMaster.FOverlappingForm.BoundsRect:=OverlappingFormRect; DockMaster.FOverlappingForm.Parent:=GetParentFormOrDockPanel(self,false); DockMaster.FOverlappingForm.AnchorDockHostSite:=self; header.Parent:=DockMaster.FOverlappingForm; FMinimizedControl.Parent:=DockMaster.FOverlappingForm.Panel; FMinimizedControl.Show; DockMaster.ShowOverlappingForm; end; end; procedure TAnchorDockHostSite.HideMinimizedControl; begin FMinimizedControl.Hide; header.Parent:=self; header.UpdateHeaderControls; FMinimizedControl.Parent:=nil; FreeAndNil(DockMaster.FOverlappingForm); end; function TAnchorDockHostSite.CloseSite: boolean; var AControl: TControl; AForm: TCustomForm; IsMainForm: Boolean; CloseAction: TCloseAction; NeedEnableAutoSizing: Boolean; i: Integer; begin Result:=CloseQuery; if not Result then exit; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.CloseSite ',DbgSName(Self),' SiteType=',dbgs(SiteType)]); {$ENDIF} case SiteType of adhstNone: begin Release; exit; end; adhstOneControl: begin DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF}; NeedEnableAutoSizing:=true; try AControl:=GetOneControl; if AControl is TCustomForm then begin AForm:=TCustomForm(AControl); IsMainForm := (Application.MainForm = AForm) or (AForm.IsParentOf(Application.MainForm)); if IsMainForm then CloseAction := caFree else CloseAction := caHide; // ToDo: TCustomForm(AControl).DoClose(CloseAction); case CloseAction of caHide: Hide; caMinimize: WindowState := wsMinimized; caFree: begin // if form is MainForm, then terminate the application // the owner of the MainForm is the application, // so the Application will take care of free-ing the form // and Release is not necessary if IsMainForm then Application.Terminate else begin NeedEnableAutoSizing:=false; Release; AForm.Release; exit; end; end; end; end else begin AControl.Visible:=false; NeedEnableAutoSizing:=false; Release; exit; end; Visible:=false; Parent:=nil; finally if NeedEnableAutoSizing then EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF}; end; end; adhstPages: begin DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF}; NeedEnableAutoSizing:=true; try if Minimized then begin // close all pages for i:=Pages.PageCount-1 downto 0 do begin AControl:=Pages.DockPages[Pages.PageCount-1].GetSite; if AControl is TAnchorDockHostSite then TAnchorDockHostSite(AControl).CloseSite; Pages.Pages.Delete(i); end; Release; end else begin // just close current page AControl:=Pages.DockPages[Pages.PageIndex].GetSite; if AControl is TAnchorDockHostSite then TAnchorDockHostSite(AControl).CloseSite; Pages.Pages.Delete(Pages.PageIndex); end; finally if NeedEnableAutoSizing then EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF}; end; end; end; end; procedure TAnchorDockHostSite.RemoveControl(AControl: TControl); begin //debugln(['TAnchorDockHostSite.RemoveControl ',DbgSName(Self),'=',Caption,' ',DbgSName(AControl)]); DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.RemoveControl'){$ENDIF}; try AControl.RemoveHandlerOnVisibleChanged(@ChildVisibleChanged); inherited RemoveControl(AControl); if not (csDestroying in ComponentState) then begin if (not ((AControl is TAnchorDockHeader) or (AControl is TAnchorDockSplitter))) then begin //debugln(['TAnchorDockHostSite.RemoveControl START ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl),' UpdatingLayout=',UpdatingLayout]); if (SiteType=adhstLayout) then RemoveControlFromLayout(AControl) else DockMaster.NeedSimplify(Self); UpdateDockCaption; //debugln(['TAnchorDockHostSite.RemoveControl END ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl)]); end; end; finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.RemoveControl'){$ENDIF}; end; end; procedure TAnchorDockHostSite.InsertControl(AControl: TControl; Index: integer); begin DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.InsertControl'){$ENDIF}; try inherited InsertControl(AControl, Index); if not ((AControl is TAnchorDockSplitter) or (AControl is TAnchorDockHeader)) then UpdateDockCaption; AControl.AddHandlerOnVisibleChanged(@ChildVisibleChanged); finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.InsertControl'){$ENDIF}; end; end; procedure TAnchorDockHostSite.UpdateDockCaption(Exclude: TControl); var i: Integer; Child: TControl; NewCaption, OldCaption: String; begin if csDestroying in ComponentState then exit; NewCaption:=''; if Minimized then begin if Assigned(FMinimizedControl) then NewCaption:=FMinimizedControl.Caption; end else for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if Child=Exclude then continue; if (Child.HostDockSite=Self) or (Child is TAnchorDockHostSite) or (Child is TAnchorDockPageControl) then begin if NewCaption<>'' then NewCaption:=NewCaption+', '; NewCaption:=NewCaption+Child.Caption; end; end; OldCaption:=Caption; Caption:=NewCaption; //debugln(['TAnchorDockHostSite.UpdateDockCaption Caption="',Caption,'" NewCaption="',NewCaption,'" HasParent=',Parent<>nil,' ',DbgSName(Header)]); Header.Caption:=Caption; if OldCaption<>Caption then begin //debugln(['TAnchorDockHostSite.UpdateDockCaption Caption="',Caption,'" NewCaption="',NewCaption,'" HasParent=',Parent<>nil]); if Parent is TAnchorDockHostSite then TAnchorDockHostSite(Parent).UpdateDockCaption; if Parent is TAnchorDockPage then TAnchorDockPage(Parent).UpdateDockCaption; end; // do not show close button for mainform Header.CloseButton.Visible:=(not IsParentOf(Application.MainForm)); end; procedure TAnchorDockHostSite.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); var ADockMargin: LongInt; begin GetWindowRect(Handle, InfluenceRect); if (Parent=nil) or DockMaster.IsCustomSite(Parent) then begin // allow docking outside => enlarge margins ADockMargin:=DockMaster.DockOutsideMargin; //debugln(['TAnchorDockHostSite.GetSiteInfo ',DbgSName(Self),' allow outside ADockMargin=',ADockMargin,' ',dbgs(InfluenceRect)]); InfluenceRect.Left := InfluenceRect.Left-ADockMargin; InfluenceRect.Top := InfluenceRect.Top-ADockMargin; InfluenceRect.Right := InfluenceRect.Right+ADockMargin; InfluenceRect.Bottom := InfluenceRect.Bottom+ADockMargin; end else if Parent is TAnchorDockHostSite then begin // do not cover parent site => shrink margins ADockMargin:=DockMaster.DockParentMargin; ADockMargin:=Min(ADockMargin,Min(ClientWidth,ClientHeight) div 10); ADockMargin:=Max(0,ADockMargin); //debugln(['TAnchorDockHostSite.GetSiteInfo ',DbgSName(Self),' do not cover parent ADockMargin=',ADockMargin,' ',dbgs(InfluenceRect)]); InfluenceRect.Left := InfluenceRect.Left+ADockMargin; InfluenceRect.Top := InfluenceRect.Top+ADockMargin; InfluenceRect.Right := InfluenceRect.Right-ADockMargin; InfluenceRect.Bottom := InfluenceRect.Bottom-ADockMargin; end; CanDock:=(Client is TAnchorDockHostSite) and not DockMaster.AutoFreedIfControlIsRemoved(Self,Client) and not Minimized; //debugln(['TAnchorDockHostSite.GetSiteInfo ',DbgSName(Self),' ',dbgs(BoundsRect),' ',Caption,' CanDock=',CanDock,' PtIn=',PtInRect(InfluenceRect,MousePos)]); if Assigned(OnGetSiteInfo) then OnGetSiteInfo(Self, Client, InfluenceRect, MousePos, CanDock); end; function TAnchorDockHostSite.GetPageArea: TRect; begin Result:=Rect(0,0,Width*DockMaster.PageAreaInPercent div 100, Height*DockMaster.PageAreaInPercent div 100); Types.OffsetRect(Result,(Width*(100-DockMaster.PageAreaInPercent)) div 200, (Height*(100-DockMaster.PageAreaInPercent)) div 200); end; function TAnchorDockHostSite.PointInOuterBorderArea(APoint: TPoint; AnAlign: TAlign; AWantedAreaCount: integer; out AnAreaIdx, AnAreaCount: integer): Boolean; var DistX, DistY, MaxPix, MaxX, MaxY: Integer; begin DistX := Min(abs(APoint.x), abs(ClientWidth-APoint.x)); DistY := Min(abs(APoint.y), abs(ClientHeight-APoint.y)); if AWantedAreaCount > 1 then MaxPix := DockMaster.OuterBorderAreaMaxPixel * 3 else MaxPix := DockMaster.OuterBorderAreaMaxPixel * 2; MaxX := Min(MaxPix, ClientWidth*DockMaster.OuterBorderAreaInPercent div 100); MaxY := Min(MaxPix, ClientHeight*DockMaster.OuterBorderAreaInPercent div 100); AnAreaIdx := 0; AnAreaCount := 1; Result := (DistX 1) then begin MaxPix := DockMaster.OuterBorderAreaMaxPixel; case AnAlign of alLeft, alRight: begin AnAreaCount := Max(2, Min(AWantedAreaCount, MaxX div Max(MaxPix div 3, 10))); AnAreaIdx := AnAreaCount - (DistX * 64 -1) div (MaxX * 64 div AnAreaCount) - 1; end; else begin AnAreaCount := Max(2, Min(AWantedAreaCount, MaxY div Max(MaxPix div 3, 10))); AnAreaIdx := AnAreaCount - (DistY * 64 -1) div (MaxY * 64 div AnAreaCount) - 1; end; end; end; {$IFDEF VerboseAnchorDocking}debugln('TAnchorDockHostSite.PointInOuterBorderArea %s: %s in %s - X: %d of %d Y: %d of %d - Area-Wanted: %d Got: %d of %d', [dbgs(AnAlign), dbgs(APoint), dbgs(ClientRect), DistX, MaxX, DistY, MaxY, AWantedAreaCount, AnAreaIdx, AnAreaCount]);{$ENDIF} end; procedure TAnchorDockHostSite.ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); begin inherited ChangeBounds(ALeft, ATop, AWidth, AHeight, KeepBase); if Header<>nil then UpdateHeaderAlign; end; procedure TAnchorDockHostSite.UpdateHeaderAlign; var NeededHeaderPosition:TADLHeaderPosition; Splitter: TAnchorDockSplitter; SplitterAnchorKind:TAnchorKind; begin if Header=nil then exit; if Minimized then begin if FindNearestSpliter(self,Splitter,SplitterAnchorKind) then begin NeededHeaderPosition:=OppositeAnchorKind2TADLHeaderPosition[SplitterAnchorKind]; end else NeededHeaderPosition:=Header.HeaderPosition; end else NeededHeaderPosition:=Header.HeaderPosition; case NeededHeaderPosition of adlhpAuto: if Header.Align in [alLeft,alRight] then begin if (ClientHeight>0) and ((ClientWidth*100 div ClientHeight)<=DockMaster.HeaderAlignTop) then Header.Align:=alTop; end else begin if (ClientHeight>0) and ((ClientWidth*100 div ClientHeight)>=DockMaster.HeaderAlignLeft) then begin if Application.BidiMode=bdRightToLeft then Header.Align:=alRight else Header.Align:=alLeft; end; end; adlhpLeft: Header.Align:=alLeft; adlhpTop: Header.Align:=alTop; adlhpRight: Header.Align:=alRight; adlhpBottom: Header.Align:=alBottom; end; end; procedure TAnchorDockHostSite.UpdateHeaderShowing; var Splitter: TAnchorDockSplitter; SplitterAnchorKind:TAnchorKind; begin if Header=nil then exit; if HeaderNeedsShowing then begin Header.Parent:=Self; Header.MinimizeButton.Visible:=(DockMaster.DockSitesCanBeMinimized and CanBeMinimized(Splitter,SplitterAnchorKind))or Minimized; Header.MinimizeButton.Parent:=Header; Header.DoAutoSize; end else Header.Parent:=nil; end; procedure TAnchorDockHostSite.BeginUpdateLayout; begin inc(FUpdateLayout); if FUpdateLayout=1 then DockMaster.BeginUpdate; end; procedure TAnchorDockHostSite.EndUpdateLayout; begin if FUpdateLayout=0 then RaiseGDBException('TAnchorDockHostSite.EndUpdateLayout'); dec(FUpdateLayout); if FUpdateLayout=0 then DockMaster.EndUpdate; end; function TAnchorDockHostSite.UpdatingLayout: boolean; begin Result:=(FUpdateLayout>0) or (csDestroying in ComponentState); end; function AcceptAlign(Site:TAnchorDockHostSite; AlignCandidate:TAlign):TAlign; var i:integer; Splitter: TAnchorDockSplitter; SplitterAnchorKind:TAnchorKind; MinimizedSiteAlign:TAlign; begin for i:=0 to Site.ControlCount-1 do if Site.Controls[i] is TAnchorDockHostSite then if (Site.Controls[i] as TAnchorDockHostSite).Minimized then begin if FindNearestSpliter(Site.Controls[i] as TAnchorDockHostSite,Splitter,SplitterAnchorKind) then begin MinimizedSiteAlign:=OppositeAnchorKind2Align[SplitterAnchorKind]; if AlignCandidate=MinimizedSiteAlign then exit(alNone); end end; result:=AlignCandidate; end; function TAnchorDockHostSite.GetDockEdge(const MousePos: TPoint): TAlign; begin result:=inherited; result:=AcceptAlign(self,result); end; procedure TAnchorDockHostSite.SaveLayout( LayoutTree: TAnchorDockLayoutTree; LayoutNode: TAnchorDockLayoutTreeNode); var i: Integer; Site: TAnchorDockHostSite; ChildNode: TAnchorDockLayoutTreeNode; Child: TControl; Splitter: TAnchorDockSplitter; OneControl: TControl; begin if SiteType=adhstOneControl then OneControl:=GetOneControl else OneControl:=nil; if (SiteType=adhstOneControl) and (OneControl<>nil) and (not (OneControl is TAnchorDockHostSite)) then begin LayoutNode.NodeType:=adltnControl; LayoutNode.Assign(Self,false,Minimized); LayoutNode.Name:=OneControl.Name; LayoutNode.HeaderPosition:=Header.HeaderPosition; end else if (SiteType in [adhstLayout,adhstOneControl]) then begin LayoutNode.NodeType:=adltnLayout; for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if Child.Owner=Self then continue; if (Child is TAnchorDockHostSite) then begin Site:=TAnchorDockHostSite(Child); ChildNode:=LayoutTree.NewNode(LayoutNode); Site.SaveLayout(LayoutTree,ChildNode); end else if (Child is TAnchorDockSplitter) then begin Splitter:=TAnchorDockSplitter(Child); ChildNode:=LayoutTree.NewNode(LayoutNode); Splitter.SaveLayout(ChildNode); end; end; LayoutNode.Assign(Self,false,Minimized); LayoutNode.HeaderPosition:=Header.HeaderPosition; end else if SiteType=adhstPages then begin LayoutNode.NodeType:=adltnPages; for i:=0 to Pages.PageCount-1 do begin Site:=Pages.DockPages[i].GetSite; if Site<>nil then begin ChildNode:=LayoutTree.NewNode(LayoutNode); Site.SaveLayout(LayoutTree,ChildNode); end; end; LayoutNode.Assign(Self,false,Minimized); LayoutNode.HeaderPosition:=Header.HeaderPosition; LayoutNode.TabPosition:=Pages.TabPosition; LayoutNode.PageIndex:=Pages.PageIndex; end else LayoutNode.NodeType:=adltnNone; if BoundSplitter<>nil then begin if Align in [alLeft,alRight] then LayoutNode.BoundSplitterPos:=BoundSplitter.Left else LayoutNode.BoundSplitterPos:=BoundSplitter.Top; end; LayoutNode.PixelsPerInch:=Screen.PixelsPerInch; end; constructor TAnchorDockHostSite.CreateNew(AOwner: TComponent; Num: Integer); begin inherited CreateNew(AOwner,Num); FMinimizedControl:=Nil; Visible:=false; FHeaderSide:=akTop; FHeader:=DockMaster.HeaderClass.Create(Self); FHeader.Align:=alTop; FHeader.Parent:=Self; FSiteType:=adhstNone; UpdateHeaderAlign; DragKind:=dkDock; DockManager:=DockMaster.ManagerClass.Create(Self); UseDockManager:=true; DragManager.RegisterDockSite(Self,true); AddHandlerFirstShow(@FirstShow); end; destructor TAnchorDockHostSite.Destroy; {$IFDEF VerboseAnchorDocking} var i: Integer; {$ENDIF} begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockHostSite.Destroy ',DbgSName(Self),' Caption="',Caption,'" Self=',dbgs(Pointer(Self)),' ComponentCount=',ComponentCount,' ControlCount=',ControlCount]); for i:=0 to ComponentCount-1 do debugln(['TAnchorDockHostSite.Destroy Component ',i,'/',ComponentCount,' ',DbgSName(Components[i])]); for i:=0 to ControlCount-1 do debugln(['TAnchorDockHostSite.Destroy Control ',i,'/',ControlCount,' ',DbgSName(Controls[i])]); {$ENDIF} FreePages; inherited Destroy; end; { TAnchorDockHeader } procedure TAnchorDockHeader.PopupMenuPopup(Sender: TObject); var HeaderPosItem: TMenuItem; ParentSite: TAnchorDockHostSite; Side: TAnchorKind; SideCaptions: array[TAnchorKind] of string; Item: TMenuItem; ContainsMainForm: boolean; s: String; begin ParentSite:=TAnchorDockHostSite(Parent); SideCaptions[akLeft]:=adrsLeft; SideCaptions[akTop]:=adrsTop; SideCaptions[akRight]:=adrsRight; SideCaptions[akBottom]:=adrsBottom; // menu items: undock, merge DockMaster.AddRemovePopupMenuItem(ParentSite.CanUndock,'UndockMenuItem', adrsUndock,@UndockButtonClick); DockMaster.AddRemovePopupMenuItem(ParentSite.CanMerge,'MergeMenuItem', adrsMerge, @MergeButtonClick); // menu items: header position HeaderPosItem:=DockMaster.AddPopupMenuItem('HeaderPosMenuItem', adrsHeaderPosition, nil); Item:=DockMaster.AddPopupMenuItem('HeaderPosAutoMenuItem', adrsAutomatically, @HeaderPositionItemClick, HeaderPosItem); if Item<>nil then begin Item.Tag:=ord(adlhpAuto); Item.Checked:=HeaderPosition=TADLHeaderPosition(Item.Tag); end; for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin Item:=DockMaster.AddPopupMenuItem('HeaderPos'+DbgS(Side)+'MenuItem', SideCaptions[Side], @HeaderPositionItemClick, HeaderPosItem); if Item=nil then continue; Item.Tag:=ord(Side)+1; Item.Checked:=HeaderPosition=TADLHeaderPosition(Item.Tag); end; // menu items: enlarge for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin Item:=DockMaster.AddRemovePopupMenuItem(ParentSite.EnlargeSide(Side,true), 'Enlarge'+DbgS(Side)+'MenuItem', Format(adrsEnlargeSide, [ SideCaptions[Side]]),@EnlargeSideClick); if Item<>nil then Item.Tag:=ord(Side); end; // menu item: close or quit ContainsMainForm:=ParentSite.IsParentOf(Application.MainForm); if ContainsMainForm then s:=Format(adrsQuit, [Application.Title]) else s:=adrsClose; DockMaster.AddRemovePopupMenuItem(CloseButton.Visible,'CloseMenuItem',s, @CloseButtonClick); end; procedure TAnchorDockHeader.ButtonPaint(Sender: TObject); var //LCanvas: TCanvas; AStyle: TTextStyle; btn: TCustomSpeedButton; txt:String; rect:TRect; begin if DockMaster.FlatHeadersButtons and (Sender is TCustomSpeedButton) then begin btn:=sender as TCustomSpeedButton; try AStyle:=btn.Canvas.TextStyle; AStyle.Layout:=tlCenter; AStyle.Alignment:=taCenter; AStyle.ShowPrefix:=True; rect:=btn.ClientRect; InflateRect(rect,-1,-1); btn.Canvas.Font.Name:=IconsFont; if sender is TAnchorDockMinimizeButton then begin txt:=FlatPinnedSym end else txt:=FlatCrossSym; btn.Canvas.TextRect(rect, rect.TopLeft.X, rect.TopLeft.Y,txt,AStyle); finally end; end; end; procedure TAnchorDockHeader.CloseButtonClick(Sender: TObject); var HeaderParent:TAnchorDockHostSite; begin TWinControl(HeaderParent):=Parent; if HeaderParent=TWinControl(DockMaster.FOverlappingForm) then begin HeaderParent:=DockMaster.FOverlappingForm.AnchorDockHostSite; HeaderParent.HideMinimizedControl; end; if HeaderParent is TAnchorDockHostSite then begin DockMaster.RestoreLayouts.Add(DockMaster.CreateRestoreLayout(HeaderParent),true); HeaderParent.CloseSite; end; end; procedure TAnchorDockHeader.MinimizeButtonClick(Sender: TObject); var HeaderParent:TAnchorDockHostSite; begin TWinControl(HeaderParent):=Parent; if HeaderParent=TWinControl(DockMaster.FOverlappingForm) then begin HeaderParent:=DockMaster.FOverlappingForm.AnchorDockHostSite; HeaderParent.HideMinimizedControl; end; if HeaderParent is TAnchorDockHostSite then begin HeaderParent.MinimizeSite; end; end; procedure TAnchorDockHeader.HeaderPositionItemClick(Sender: TObject); var Item: TMenuItem; begin if not (Sender is TMenuItem) then exit; Item:=TMenuItem(Sender); HeaderPosition:=TADLHeaderPosition(Item.Tag); end; procedure TAnchorDockHeader.UndockButtonClick(Sender: TObject); begin TAnchorDockHostSite(Parent).Undock; end; procedure TAnchorDockHeader.MergeButtonClick(Sender: TObject); begin TAnchorDockHostSite(Parent).Merge; end; procedure TAnchorDockHeader.EnlargeSideClick(Sender: TObject); var Side: TAnchorKind; begin if not (Sender is TMenuItem) then exit; Side:=TAnchorKind(TMenuItem(Sender).Tag); TAnchorDockHostSite(Parent).EnlargeSide(Side,false); end; procedure TAnchorDockHeader.SetHeaderPosition(const AValue: TADLHeaderPosition); begin if FHeaderPosition=AValue then exit; FHeaderPosition:=AValue; if Parent is TAnchorDockHostSite then TAnchorDockHostSite(Parent).UpdateHeaderAlign; end; procedure TAnchorDockHeader.Draw(HeaderStyle:TADHeaderStyle); var r: TRect; TxtH: longint; TxtW: longint; dx,dy: Integer; //NeedDrawHeaderAfterText,NeedHighlightText:boolean; begin r:=ClientRect; if not HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then begin HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,not(Align in [alLeft,alRight]),FFocused); end else begin Canvas.Brush.Color := clForm; if DockMaster.HeaderFilled then Canvas.FillRect(r); if not DockMaster.HeaderFlatten then Canvas.Frame3d(r,1,bvRaised); end; {case DockMaster.HeaderStyle of adhsPoints: Canvas.Brush.Color := clForm; else Canvas.Frame3d(r,1,bvRaised); end; Canvas.FillRect(r);} if CloseButton.IsControlVisible and (CloseButton.Parent=Self) then begin if Align in [alLeft,alRight] then r.Top:=CloseButton.Top+CloseButton.Height+ButtonBorderSpacingAround else r.Right:=CloseButton.Left-ButtonBorderSpacingAround; end; if MinimizeButton.IsControlVisible and (MinimizeButton.Parent=Self) then begin if Align in [alLeft,alRight] then r.Top:=MinimizeButton.Top+MinimizeButton.Height+ButtonBorderSpacingAround else r.Right:=MinimizeButton.Left-ButtonBorderSpacingAround; end; // caption if Caption<>'' then begin if FFocused and DockMaster.HeaderHighlightFocused and HeaderStyle.StyleDesc.NeedHighlightText then Canvas.Font.Bold:=true else Canvas.Font.Bold:=False; Canvas.Brush.Color:=clNone; Canvas.Brush.Style:=bsClear; TxtH:=Canvas.TextHeight('ABCMgq'); TxtW:=Canvas.TextWidth(Caption); if Align in [alLeft,alRight] then begin // vertical dx:=Max(0,(r.Right-r.Left-TxtH) div 2); {$IFDEF LCLWin32} dec(dx,2); {$ENDIF} dy:=Max(0,(r.Bottom-r.Top-TxtW) div 2); Canvas.Font.Orientation:=900; if TxtW<(r.Bottom-r.Top)then begin // text fits Canvas.TextOut(r.Left+dx-1,r.Bottom-dy,Caption); if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then begin HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left,r.Top,r.Right,r.Bottom-dy-TxtW-1),false,FFocused); HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left,r.Bottom-dy+2,r.Right,r.Bottom),false,FFocused); end; end else begin // text does not fit if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,false,FFocused); end; end else begin // horizontal dx:=Max(0,(r.Right-r.Left-TxtW) div 2); dy:=Max(0,(r.Bottom-r.Top-TxtH) div 2); Canvas.Font.Orientation:=0; if TxtW<(r.right-r.Left)then begin // text fits Canvas.TextRect(r,dx+2,dy,Caption); if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then begin HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Left,r.Top,r.Left+dx-1,r.Bottom),true,FFocused); HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,Rect(r.Right-dx+5,r.Top,r.Right,r.Bottom),true,FFocused); end; end else begin // text does not fit if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,true,FFocused); end; end; end else if HeaderStyle.StyleDesc.NeedDrawHeaderAfterText then if Align in [alLeft,alRight] then HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,false,FFocused) else HeaderStyle.DrawProc(Canvas,HeaderStyle.StyleDesc,r,true,FFocused); end; procedure TAnchorDockHeader.Paint; begin draw(DockMaster.CurrentADHeaderStyle); end; procedure CalculatePreferredFlatButtonSize(Handle: HWND; out PreferredWidth, PreferredHeight: integer); const TestTxt2 = FlatPinnedSym+FlatCrossSym; var LCanvas: TCanvas; R: TRect; Flags: cardinal; begin LCanvas:= TCanvas.Create; try LCanvas.Handle := GetDC(Handle); Flags := DT_CALCRECT or DT_EXPANDTABS or DT_SINGLELINE or DT_NOPREFIX; R := Rect(0, 0, 10000, 10000); DrawText(LCanvas.Handle, PChar(TestTxt), Length(TestTxt), R, Flags); PreferredWidth := R.Bottom - R.Top; LCanvas.Font.Name := IconsFont; R := Rect(0, 0, 10000, 10000); DrawText(LCanvas.Handle, PChar(TestTxt2), Length(TestTxt2), R, Flags); PreferredWidth := max(R.Bottom - R.Top, PreferredWidth); PreferredHeight:=PreferredWidth; finally LCanvas.Handle:= 0; LCanvas.Free; end; end; procedure TAnchorDockHeader.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); var DC: HDC; R: TRect; OldFont: HGDIOBJ; Flags: cardinal; NeededWidth,NeededHeight: Integer; begin inherited CalculatePreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace); if Caption<>'' then begin DC := GetDC(Parent.Handle); try R := Rect(0, 0, 10000, 10000); OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle)); Flags := DT_CALCRECT or DT_EXPANDTABS or DT_SINGLELINE or DT_NOPREFIX; DrawText(DC, PChar(TestTxt), Length(TestTxt), R, Flags); SelectObject(DC, OldFont); NeededHeight := R.Bottom - R.Top + BevelWidth*2; finally ReleaseDC(Parent.Handle, DC); end; if Align in [alLeft,alRight] then begin PreferredWidth:=Max(NeededHeight,PreferredWidth); end else begin PreferredHeight:=Max(NeededHeight,PreferredHeight); end; end else begin NeededHeight:=CloseButton.Height; if Align in [alLeft,alRight] then begin PreferredWidth:=Max(NeededHeight,PreferredWidth); end else begin PreferredHeight:=Max(NeededHeight,PreferredHeight); end; end; if DockMaster.FlatHeadersButtons then begin CalculatePreferredFlatButtonSize(Handle, NeededWidth, NeededHeight); PreferredWidth:=Max(PreferredWidth, NeededWidth+2*ButtonBorderSpacingAround); PreferredHeight:=Max(PreferredHeight, NeededHeight+2*ButtonBorderSpacingAround); end; end; procedure TAnchorDockHeader.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var SiteMinimized:Boolean; begin inherited MouseDown(Button, Shift, X, Y); SiteMinimized:=False; FUseTimer:=false; StopMouseNoMoveTimer; if Parent is TAnchorDockHostSite then SiteMinimized:=(Parent as TAnchorDockHostSite).Minimized; if SiteMinimized then begin DoMouseNoMoveTimer(nil); end else begin if parent<>nil then if DockMaster.FOverlappingForm<>nil then //if parent=DockMaster.FOverlappingForm.Panel then DockMaster.HideOverlappingForm(nil); if (Button=mbLeft) and (DockMaster.AllowDragging) and (DockMaster.FOverlappingForm=nil) then DragManager.DragStart(Parent,false,DockMaster.DragTreshold); end; end; procedure TAnchorDockHeader.MouseMove(Shift: TShiftState; X,Y: Integer); begin inherited MouseMove(Shift, X, Y); if parent<>nil then if parent is TAnchorDockHostSite then if (parent as TAnchorDockHostSite).Minimized then if DockMaster.FOverlappingForm=nil then if FMouseTimeStartX=EmptyMouseTimeStartX then StartMouseNoMoveTimer else begin if (abs(FMouseTimeStartX-X)>MouseNoMoveDelta) or (abs(FMouseTimeStartY-Y)>MouseNoMoveDelta)then StopMouseNoMoveTimer; end; if (parent is TAnchorDockHostSite) and (DockMaster.FOverlappingForm=nil)then FUseTimer:=true; end; procedure TAnchorDockHeader.MouseLeave; begin inherited; StopMouseNoMoveTimer; end; procedure TAnchorDockHeader.StartMouseNoMoveTimer; begin if FUseTimer then begin if DockTimer.Enabled then DockTimer.Enabled:=false; DockTimer.Interval:=MouseNoMoveTime; DockTimer.OnTimer:=@DoMouseNoMoveTimer; DockTimer.Enabled:=true; end; end; procedure TAnchorDockHeader.StopMouseNoMoveTimer; begin FMouseTimeStartX:=EmptyMouseTimeStartX; DockTimer.OnTimer:=nil; DockTimer.Enabled:=false; end; procedure TAnchorDockHeader.DoMouseNoMoveTimer(Sender: TObject); begin StopMouseNoMoveTimer; //if FUseTimer then if parent<>nil then if parent is TAnchorDockHostSite then if (parent as TAnchorDockHostSite).Minimized then (parent as TAnchorDockHostSite).ShowMinimizedControl; end; procedure TAnchorDockHeader.UpdateHeaderControls; begin if CloseButton<>nil then begin if Align in [alLeft,alRight] then begin //MinimizeButton.Align:=alTop; //CloseButton.Align:=alTop; CloseButton.AnchorSide[akLeft].Side := asrCenter; CloseButton.AnchorSide[akLeft].Control := Self; CloseButton.AnchorSide[akTop].Side := asrTop; CloseButton.AnchorSide[akTop].Control := Self; CloseButton.Anchors := [akTop,akLeft]; if MinimizeButton<>nil then begin MinimizeButton.AnchorSide[akLeft].Side := asrCenter; MinimizeButton.AnchorSide[akLeft].Control := Self; MinimizeButton.AnchorSide[akTop].Side := asrBottom; MinimizeButton.AnchorSide[akTop].Control := CloseButton; MinimizeButton.Anchors := [akTop,akLeft]; MinimizeButton.BorderSpacing.Around:=ButtonBorderSpacingAround; end; end else begin //MinimizeButton.Align:=alRight; //CloseButton.Align:=alRight; CloseButton.AnchorSide[akRight].Side := asrRight; CloseButton.AnchorSide[akRight].Control := Self; CloseButton.AnchorSide[akTop].Side := asrCenter; CloseButton.AnchorSide[akTop].Control := Self; CloseButton.Anchors := [akTop,akRight]; if MinimizeButton<>nil then begin MinimizeButton.AnchorSide[akRight].Side := asrLeft; MinimizeButton.AnchorSide[akRight].Control := CloseButton; MinimizeButton.AnchorSide[akTop].Side := asrCenter; MinimizeButton.AnchorSide[akTop].Control := Self; MinimizeButton.Anchors := [akTop,akRight]; MinimizeButton.BorderSpacing.Around:=ButtonBorderSpacingAround; end; end; CloseButton.BorderSpacing.Around:=ButtonBorderSpacingAround; end; //debugln(['TAnchorDockHeader.UpdateHeaderControls ',dbgs(Align),' ',dbgs(CloseButton.Align)]); end; procedure TAnchorDockHeader.SetAlign(Value: TAlign); begin if Value=Align then exit; DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SetAlign'){$ENDIF}; try inherited SetAlign(Value); UpdateHeaderControls; finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SetAlign'){$ENDIF}; end; end; procedure TAnchorDockHeader.DoOnShowHint(HintInfo: PHintInfo); var s: String; p: LongInt; c: String; begin s:=DockMaster.GetLocalizedHeaderHint; p:=Pos('%s',s); if p>0 then begin if Parent<>nil then c:=Parent.Caption else c:=''; s:=Format(s,[c]); end; //debugln(['TAnchorDockHeader.DoOnShowHint "',s,'" "',DockMaster.HeaderHint,'"']); HintInfo^.HintStr:=s; inherited DoOnShowHint(HintInfo); end; constructor TAnchorDockHeader.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FHeaderPosition:=adlhpAuto; BevelOuter:=bvNone; BorderWidth:=0; FCloseButton:=TAnchorDockCloseButton.Create(Self); with FCloseButton do begin Name:='CloseButton'; Parent:=Self; Flat:=true; ShowHint:=true; Hint:=adrsClose; OnClick:=@CloseButtonClick; {$IF DEFINED(MSWINDOWS)} if Win32MajorVersion>=10 then OnPaint:=@ButtonPaint; {$ENDIF} AutoSize:=true; end; FMinimizeButton:=TAnchorDockMinimizeButton.Create(Self); with FMinimizeButton do begin Name:='MinimizeButton'; Parent:=Self; Flat:=true; ShowHint:=true; Hint:=adrsMinimize; OnClick:=@MinimizeButtonClick; {$IF DEFINED(MSWINDOWS)} if Win32MajorVersion>=10 then OnPaint:=@ButtonPaint; {$ENDIF} AutoSize:=true; end; Align:=alTop; AutoSize:=true; ShowHint:=true; PopupMenu:=DockMaster.GetPopupMenu; FFocused:=false; FMouseTimeStartX:=EmptyMouseTimeStartX; FUseTimer:=true; end; { TAnchorDockCloseButton } function TAnchorDockCloseButton.GetDrawDetails: TThemedElementDetails; function WindowPart: TThemedWindow; begin // no check states available Result := twCloseButtonNormal; if not IsEnabled then Result := {$IFDEF LCLWIN32}twCloseButtonDisabled{$ELSE}twSmallCloseButtonDisabled{$ENDIF} else if FState in [bsDown, bsExclusive] then Result := {$IFDEF LCLWIN32}twCloseButtonPushed{$ELSE}twSmallCloseButtonPushed{$ENDIF} else if FState = bsHot then Result := {$IFDEF LCLWIN32}twCloseButtonHot{$ELSE}twSmallCloseButtonHot{$ENDIF} else Result := {$IFDEF LCLWIN32}twCloseButtonNormal;{$ELSE}twSmallCloseButtonNormal;{$ENDIF} end; begin if DockMaster.FlatHeadersButtons then result := inherited else Result := ThemeServices.GetElementDetails(WindowPart); end; procedure SizeCorrector(var current, recommend: integer); begin if recommend<0 then begin if current>0 then recommend:=current else current:=HardcodedButtonSize; end else begin if current>recommend then current:=recommend else begin if current>0 then recommend:=current else current:=recommend; end; end; end; procedure ButtonSizeCorrector(var w,h:integer); begin SizeCorrector(w,PreferredButtonWidth); SizeCorrector(h,PreferredButtonHeight); end; procedure TAnchorDockCloseButton.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin if not DockMaster.FlatHeadersButtons then with ThemeServices.GetDetailSizeForPPI(ThemeServices.GetElementDetails( {$IFDEF LCLWIN32}twCloseButtonNormal{$ELSE}twSmallCloseButtonNormal{$ENDIF}), Font.PixelsPerInch) do begin PreferredWidth:=cx; PreferredHeight:=cy; ButtonSizeCorrector(PreferredWidth,PreferredHeight); {$IF defined(LCLGtk2) or defined(Carbon)} inc(PreferredWidth,2); inc(PreferredHeight,2); {$ENDIF} end else CalculatePreferredFlatButtonSize(Parent.Handle, PreferredWidth,PreferredHeight); end; { TAnchorDockMinimizeButton } function TAnchorDockMinimizeButton.GetDrawDetails: TThemedElementDetails; function WindowPart: TThemedWindow; begin // no check states available Result := twMinButtonNormal; if not IsEnabled then Result := {$IFDEF LCLGtk2}twMDIRestoreButtonDisabled{$ELSE}twMinButtonDisabled{$ENDIF} else if FState in [bsDown, bsExclusive] then Result := {$IFDEF LCLGtk2}twMDIRestoreButtonPushed{$ELSE}twMinButtonPushed{$ENDIF} else if FState = bsHot then Result := {$IFDEF LCLGtk2}twMDIRestoreButtonHot{$ELSE}twMinButtonHot{$ENDIF} else Result := {$IFDEF LCLGtk2}twMDIRestoreButtonNormal{$ELSE}twMinButtonNormal{$ENDIF}; end; begin if DockMaster.FlatHeadersButtons then result := inherited else Result := ThemeServices.GetElementDetails(WindowPart); end; procedure TAnchorDockMinimizeButton.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin if not DockMaster.FlatHeadersButtons then with ThemeServices.GetDetailSizeForPPI(ThemeServices.GetElementDetails( {$IFDEF LCLGtk2}twMDIRestoreButtonNormal{$ELSE}twMinButtonNormal{$ENDIF}), Font.PixelsPerInch) do begin PreferredWidth:=cx; PreferredHeight:=cy; ButtonSizeCorrector(PreferredWidth,PreferredHeight); {$IF defined(LCLGtk2) or defined(Carbon)} inc(PreferredWidth,2); inc(PreferredHeight,2); {$ENDIF} end else CalculatePreferredFlatButtonSize(Parent.Handle, PreferredWidth,PreferredHeight); end; { TAnchorDockManager } procedure TAnchorDockManager.SetPreferredSiteSizeAsSiteMinimum( const AValue: boolean); begin if FPreferredSiteSizeAsSiteMinimum=AValue then exit; FPreferredSiteSizeAsSiteMinimum:=AValue; if DockSite=nil then Site.AdjustSize; end; constructor TAnchorDockManager.Create(ADockSite: TWinControl); begin inherited Create(ADockSite); FSite:=ADockSite; FDockableSites:=[akLeft,akTop,akBottom,akRight]; FInsideDockingAllowed:=true; FPreferredSiteSizeAsSiteMinimum:=true; if (ADockSite is TAnchorDockHostSite) then FDockSite:=TAnchorDockHostSite(ADockSite); end; procedure TAnchorDockManager.GetControlBounds(Control: TControl; out AControlBounds: TRect); begin if Control=nil then ; AControlBounds:=Rect(0,0,0,0); //debugln(['TAnchorDockManager.GetControlBounds DockSite="',DockSite.Caption,'" Control=',DbgSName(Control)]); end; procedure TAnchorDockManager.InsertControl(Control: TControl; InsertAt: TAlign; DropCtl: TControl); begin if Control=nil then; if InsertAt=alNone then ; if DropCtl=nil then ; end; procedure TAnchorDockManager.InsertControl(ADockObject: TDragDockObject); var NewSiteBounds: TRect; NewChildBounds: TRect; Child: TControl; ChildSite: TAnchorDockHostSite; SplitterWidth: Integer; begin if DockSite<>nil then begin // handled by TAnchorDockHostSite //debugln(['TAnchorDockManager.InsertControl DockSite="',DockSite.Caption,'" Control=',DbgSName(ADockObject.Control),' InsertAt=',dbgs(ADockObject.DropAlign)]) end else begin {$IFDEF VerboseAnchorDocking} 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)]); {$ENDIF} Site.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockManager.InsertControl'){$ENDIF}; try // align dragged Control Child:=ADockObject.Control; Child.Parent:=Site; Child.Align:=ADockObject.DropAlign; Child.Width:=ADockObject.DockRect.Right-ADockObject.DockRect.Left; Child.Height:=ADockObject.DockRect.Bottom-ADockObject.DockRect.Top; SplitterWidth:=0; ChildSite:=nil; if Child is TAnchorDockHostSite then begin ChildSite:=TAnchorDockHostSite(Child); ChildSite.CreateBoundSplitter(Site is TAnchorDockPanel); SplitterWidth:=DockMaster.SplitterWidth; end; if Site is TAnchorDockPanel then ADockObject.DropAlign:=alClient; // resize Site NewSiteBounds:=Site.BoundsRect; case ADockObject.DropAlign of alLeft: dec(NewSiteBounds.Left,Child.ClientWidth+SplitterWidth); alRight: dec(NewSiteBounds.Right,Child.ClientWidth+SplitterWidth); alTop: dec(NewSiteBounds.Top,Child.ClientHeight+SplitterWidth); alBottom: inc(NewSiteBounds.Bottom,Child.ClientHeight+SplitterWidth); alClient: ; end; if not StoredConstraintsValid then StoreConstraints; if ADockObject.DropAlign in [alLeft,alRight] then Site.Constraints.MaxWidth:=0 else if ADockObject.DropAlign in [alTop,alBottom] then Site.Constraints.MaxHeight:=0; Site.BoundsRect:=NewSiteBounds; if ADockObject.DropAlign=alClient then Child.Align:=alClient; //debugln(['TAnchorDockManager.InsertControl Site.BoundsRect=',dbgs(Site.BoundsRect),' NewSiteBounds=',dbgs(NewSiteBounds),' Child.ClientRect=',dbgs(Child.ClientRect)]); FSiteClientRect:=Site.ClientRect; // resize child NewChildBounds:=Child.BoundsRect; case ADockObject.DropAlign of alTop: NewChildBounds:=Bounds(0,0,Site.ClientWidth,Child.ClientHeight); alBottom: NewChildBounds:=Bounds(0,Site.ClientHeight-Child.ClientHeight, Site.ClientWidth,Child.ClientHeight); alLeft: NewChildBounds:=Bounds(0,0,Child.ClientWidth,Site.ClientHeight); alRight: NewChildBounds:=Bounds(Site.ClientWidth-Child.ClientWidth,0, Child.ClientWidth,Site.ClientHeight); alClient: NewChildBounds:=Bounds(0,0, Site.ClientWidth,Site.ClientHeight); end; Child.BoundsRect:=NewChildBounds; NewChildBounds:=Child.BoundsRect; if ChildSite<>nil then ChildSite.PositionBoundSplitter; // only allow to dock one control DragManager.RegisterDockSite(Site,false); {$IFDEF VerboseAnchorDocking} 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)]); {$ENDIF} finally Site.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockManager.InsertControl'){$ENDIF}; end; end; end; procedure TAnchorDockManager.LoadFromStream(Stream: TStream); begin debugln(['TAnchorDockManager.LoadFromStream not implemented Site="',DbgSName(Site),'"']); if Stream=nil then ; end; procedure TAnchorDockManager.PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign; var DockRect: TRect); { Client = dragged source site (a TAnchorDockHostSite) DropCtl is target control (the DockSite, DockSite.Pages or one of the pages) DropAlign: where on Client DropCtl should be placed DockRect: the estimated new bounds of DropCtl } var Offset: TPoint; Inside: Boolean; TmpSite: TWinControl; begin if (DropAlign=alClient) and (DockSite<>nil) and (DockSite.Pages<>nil) then begin // dock into pages if DropCtl=DockSite.Pages then begin // dock as last page DockRect:=DockSite.Pages.TabRect(DockSite.Pages.PageCount-1); case DockSite.Pages.TabPosition of tpTop,tpBottom: DockRect.Left:=(DockRect.Left+DockRect.Right) div 2; tpLeft,tpRight: DockRect.Top:=(DockRect.Top+DockRect.Bottom) div 2; end; Offset:=DockSite.Pages.ClientOrigin; Types.OffsetRect(DockRect,Offset.X,Offset.Y); exit; end else if DropCtl is TAnchorDockPage then begin // dock in front of page DockRect:=DockSite.Pages.TabRect(TAnchorDockPage(DropCtl).PageIndex); case DockSite.Pages.TabPosition of tpTop,tpBottom: DockRect.Right:=(DockRect.Left+DockRect.Right) div 2; tpLeft,tpRight: DockRect.Bottom:=(DockRect.Top+DockRect.Bottom) div 2; end; Offset:=DockSite.Pages.ClientOrigin; Types.OffsetRect(DockRect,Offset.X,Offset.Y); exit; end; end; Inside:=(DropCtl=Site); if (not Inside) and (Site.Parent<>nil) then begin if (Site.Parent is TAnchorDockHostSite) or (not (Site.Parent.DockManager is TAnchorDockManager)) or (Site.Parent.Parent<>nil) then Inside:=true; end; if Site is TAnchorDockPanel then begin DockRect:=Bounds(Site.ClientOrigin.x,Site.ClientOrigin.y,Site.ClientWidth,Site.ClientHeight); exit; end; TmpSite:=Site; if RedirectToHostSite <> nil then TmpSite:=RedirectToHostSite; case DropAlign of alLeft: if Inside then DockRect:=Rect(0,0,Min(Client.Width,TmpSite.ClientWidth div 2),TmpSite.ClientHeight) else DockRect:=Rect(-Client.Width,0,0,TmpSite.ClientHeight); alRight: if Inside then begin DockRect:=Rect(0,0,Min(Client.Width,TmpSite.Width div 2),TmpSite.ClientHeight); Types.OffsetRect(DockRect,TmpSite.ClientWidth-DockRect.Right,0); end else DockRect:=Bounds(TmpSite.ClientWidth,0,Client.Width,TmpSite.ClientHeight); alTop: if Inside then DockRect:=Rect(0,0,TmpSite.ClientWidth,Min(Client.Height,TmpSite.ClientHeight div 2)) else DockRect:=Rect(0,-Client.Height,TmpSite.ClientWidth,0); alBottom: if Inside then begin DockRect:=Rect(0,0,TmpSite.ClientWidth,Min(Client.Height,TmpSite.ClientHeight div 2)); Types.OffsetRect(DockRect,0,TmpSite.ClientHeight-DockRect.Bottom); end else DockRect:=Bounds(0,TmpSite.ClientHeight,TmpSite.ClientWidth,Client.Height); alClient: begin // paged docking => show center if DockSite<>nil then DockRect:=DockSite.GetPageArea; end; else exit; // use default end; Offset:=TmpSite.ClientOrigin; Types.OffsetRect(DockRect,Offset.X,Offset.Y); end; procedure TAnchorDockManager.RemoveControl(Control: TControl); var NewBounds: TRect; ChildSite: TAnchorDockHostSite; SplitterWidth: Integer; begin if DockSite<>nil then begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockManager.RemoveControl DockSite="',DockSite.Caption,'" Control=',DbgSName(Control)]); {$ENDIF} if DockSite.Minimized then DockSite.RemoveMinimizedControl; end else begin {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockManager.RemoveControl Site="',DbgSName(Site),'" Control=',DbgSName(Control)]); {$ENDIF} if Control is TAnchorDockHostSite then begin SplitterWidth:=0; if Control is TAnchorDockHostSite then begin ChildSite:=TAnchorDockHostSite(Control); if ChildSite.BoundSplitter<>nil then SplitterWidth:=DockMaster.SplitterWidth; end; // shrink Site NewBounds:=Site.BoundsRect; case Control.Align of alTop: inc(NewBounds.Top,Control.Height+SplitterWidth); alBottom: dec(NewBounds.Bottom,Control.Height+SplitterWidth); alLeft: inc(NewBounds.Left,Control.Width+SplitterWidth); alRight: dec(NewBounds.Right,Control.Width+SplitterWidth); end; if StoredConstraintsValid then begin // restore constraints with Site.Constraints do begin MinWidth:=FStoredConstraints.Left; MinHeight:=FStoredConstraints.Top; MaxWidth:=FStoredConstraints.Right; MaxHeight:=FStoredConstraints.Bottom; end; FStoredConstraints:=Rect(0,0,0,0); end; Site.BoundsRect:=NewBounds; {$IFDEF VerboseAnchorDocking} debugln(['TAnchorDockManager.RemoveControl Site=',DbgSName(Site),' ',dbgs(Site.BoundsRect)]); {$ENDIF} // Site can dock a control again DragManager.RegisterDockSite(Site,true); end; end; end; procedure TAnchorDockManager.ResetBounds(Force: Boolean); var OldSiteClientRect: TRect; WidthDiff: Integer; HeightDiff: Integer; ClientRectChanged: Boolean; procedure AlignChilds; var i: Integer; b: TRect; AControl: TControl; ChildMaxSize: TPoint; SiteMinSize: TPoint; Child: TAnchorDockHostSite; begin if ClientRectChanged and DockMaster.Restoring then begin // ClientRect changed => restore bounds for i:=0 to Site.ControlCount-1 do begin AControl:=Site.Controls[i]; b:=Rect(0,0,0,0); if AControl is TAnchorDockHostSite then b:=TAnchorDockHostSite(AControl).DockRestoreBounds else if AControl is TAnchorDockSplitter then b:=TAnchorDockSplitter(AControl).DockRestoreBounds; if (b.Right<=b.Left) or (b.Bottom<=b.Top) then b:=AControl.BoundsRect; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockManager.ResetBounds RESTORE ',DbgSName(AControl),' Cur=',dbgs(AControl.BoundsRect),' Restore=',dbgs(b)]); {$ENDIF} if AControl is TAnchorDockSplitter then begin // fit splitter into clientarea if AControl.AnchorSide[akLeft].Control=nil then b.Left:=Max(0,Min(b.Left,Site.ClientWidth-10)); if AControl.AnchorSide[akTop].Control=nil then b.Top:=Max(0,Min(b.Top,Site.ClientHeight-10)); if TAnchorDockSplitter(AControl).ResizeAnchor in [akLeft,akRight] then begin b.Right:=b.Left+DockMaster.SplitterWidth; b.Bottom:=Max(1,Min(b.Bottom,Site.ClientHeight-b.Top)); end else begin b.Right:=Max(1,Min(b.Right,Site.ClientWidth-b.Left)); b.Bottom:=b.Top+DockMaster.SplitterWidth; end; end; AControl.BoundsRect:=b; if AControl is TAnchorDockSplitter then TAnchorDockSplitter(AControl).UpdateDockBounds; end; exit; end; if DockSite<>nil then exit; Child:=GetChildSite; if Child=nil then exit; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockManager.ResetBounds ',DbgSName(Site),' ',dbgs(Child.BaseBounds),' ',WidthDiff,',',HeightDiff]); {$ENDIF} ChildMaxSize:=Point(Site.ClientWidth-DockMaster.SplitterWidth, Site.ClientHeight-DockMaster.SplitterWidth); if PreferredSiteSizeAsSiteMinimum then begin SiteMinSize:=GetSitePreferredClientSize; if Child.Align in [alLeft,alRight] then begin ChildMaxSize.X:=Max(0,(ChildMaxSize.X-SiteMinSize.X)); end else begin ChildMaxSize.Y:=Max(0,(ChildMaxSize.Y-SiteMinSize.Y)); end; {$IF defined(VerboseAnchorDockRestore) or defined(VerboseADCustomSite)} debugln(['TAnchorDockManager.ResetBounds ChildMaxSize=',dbgs(ChildMaxSize),' SiteMinSize=',dbgs(SiteMinSize),' Site.Client=',dbgs(Site.ClientRect)]); {$ENDIF} end; case ResizePolicy of admrpChild: begin if Child.Parent is TAnchorDockPanel then // else begin if Child.Align in [alLeft,alRight] then Child.Width:=Max(1,Min(ChildMaxSize.X,Child.Width+WidthDiff)) else begin i:=Max(1,Min(ChildMaxSize.Y,Child.Height+HeightDiff)); {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockManager.ResetBounds Child=',DbgSName(Child),' OldHeight=',Child.Height,' NewHeight=',i]); {$ENDIF} Child.Height:=i; end; end; end; end; end; begin if Force then ; //debugln(['TAnchorDockManager.ResetBounds Site="',Site.Caption,'" Force=',Force,' ',dbgs(Site.ClientRect)]); OldSiteClientRect:=FSiteClientRect; FSiteClientRect:=Site.ClientRect; WidthDiff:=FSiteClientRect.Right-OldSiteClientRect.Right; HeightDiff:=FSiteClientRect.Bottom-OldSiteClientRect.Bottom; ClientRectChanged:=(WidthDiff<>0) or (HeightDiff<>0); if ClientRectChanged or PreferredSiteSizeAsSiteMinimum then AlignChilds; if ClientRectChanged then if DockMaster.FOverlappingForm<>nil then DockMaster.HideOverlappingForm(nil); end; procedure TAnchorDockManager.SaveToStream(Stream: TStream); begin if Stream=nil then ; debugln(['TAnchorDockManager.SaveToStream not implemented Site="',DbgSName(Site),'"']); end; function TAnchorDockManager.GetDockEdge(ADockObject: TDragDockObject): boolean; var BestDistance: Integer; procedure FindMinDistance(CurAlign: TAlign; CurDistance: integer); begin if CurDistance<0 then CurDistance:=-CurDistance; if CurDistance>=BestDistance then exit; ADockObject.DropAlign:=CurAlign; BestDistance:=CurDistance; end; var p: TPoint; LastTabRect: TRect; TabIndex: longint; Inside: Boolean; AreaIdx, AreaCnt: integer; ph: TAnchorDockHostSite; begin //debugln(['TAnchorDockManager.GetDockEdge ',DbgSName(Site),' ',DbgSName(DockSite),' DockableSites=',dbgs(DockableSites)]); FRedirectToHostSite := nil; if DockableSites=[] then begin ADockObject.DropAlign:=alNone; exit(false); end; p:=Site.ScreenToClient(ADockObject.DragPos); //debugln(['TAnchorDockManager.GetDockEdge ',dbgs(p),' ',dbgs(Site.BoundsRect),' ',DbgSName(Site)]); if (DockSite<>nil) and (DockSite.Pages<>nil) then begin // page docking ADockObject.DropAlign:=alClient; p:=DockSite.Pages.ScreenToClient(ADockObject.DragPos); LastTabRect:=DockSite.Pages.TabRect(DockSite.Pages.PageCount-1); if (p.Y>=LastTabRect.Top) and (p.y=LastTabRect.Right then begin // insert as last ADockObject.DropOnControl:=DockSite.Pages; end else begin TabIndex:=DockSite.Pages.IndexOfPageAt(p); if TabIndex>=0 then begin // insert in front of an existing ADockObject.DropOnControl:=DockSite.Pages.Page[TabIndex]; end; end; end; end else if (DockSite<>nil) and PtInRect(DockSite.GetPageArea,p) then begin // page docking ADockObject.DropAlign:=alClient; end else begin // check side BestDistance:=High(Integer); if akLeft in DockableSites then FindMinDistance(alLeft,p.X); if akRight in DockableSites then FindMinDistance(alRight,Site.ClientWidth-p.X); if akTop in DockableSites then FindMinDistance(alTop,p.Y); if akBottom in DockableSites then FindMinDistance(alBottom,Site.ClientHeight-p.Y); Inside :=( ((ADockObject.DropAlign=alLeft) and (p.X>=0)) or ((ADockObject.DropAlign=alTop) and (p.Y>=0)) or ((ADockObject.DropAlign=alRight) and (p.X nil) then begin FRedirectToHostSite:=(Site as TAnchorDockHostSite).GetParentHostSiteOfTabbed(ADockObject.DropAlign); if AreaIdx = AreaCnt-1 then AreaIdx := MaxInt; while (AreaIdx > 0) and (FRedirectToHostSite <> nil) and FRedirectToHostSite.IsDockedPage(ADockObject.DropAlign) do begin ph := FRedirectToHostSite.GetParentHostSiteOfTabbed(ADockObject.DropAlign); if ph = nil then break; FRedirectToHostSite := ph; dec(AreaIdx); end; ADockObject.DropOnControl:=FRedirectToHostSite; end else // check inside if InsideDockingAllowed and Inside then ADockObject.DropOnControl:=Site else ADockObject.DropOnControl:=nil; if Site is TAnchorDockHostSite then begin ADockObject.DropAlign:=AcceptAlign(Site as TAnchorDockHostSite,ADockObject.DropAlign); if ADockObject.DropAlign=alNone then exit(false); end; end; //debugln(['TAnchorDockManager.GetDockEdge ADockObject.DropAlign=',dbgs(ADockObject.DropAlign),' DropOnControl=',DbgSName(ADockObject.DropOnControl)]); Result:=true; end; procedure TAnchorDockManager.RestoreSite(SplitterPos: integer); var ChildSite: TAnchorDockHostSite; begin FSiteClientRect:=Site.ClientRect; if DockSite<>nil then exit; ChildSite:=GetChildSite; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockManager.RestoreSite START ',DbgSName(Site),' ChildSite=',DbgSName(ChildSite)]); {$ENDIF} if ChildSite<>nil then begin ChildSite.CreateBoundSplitter; ChildSite.PositionBoundSplitter; if ChildSite.Align in [alLeft,alRight] then ChildSite.BoundSplitter.Left:=SplitterPos else ChildSite.BoundSplitter.Top:=SplitterPos; case ChildSite.Align of alTop: ChildSite.Height:=ChildSite.BoundSplitter.Top; alBottom: ChildSite.Height:=Site.ClientHeight -(ChildSite.BoundSplitter.Top+ChildSite.BoundSplitter.Height); alLeft: ChildSite.Width:=ChildSite.BoundSplitter.Left; alRight: ChildSite.Width:=Site.ClientWidth -(ChildSite.BoundSplitter.Left+ChildSite.BoundSplitter.Width); end; // only allow to dock one control DragManager.RegisterDockSite(Site,false); {$IFDEF VerboseAnchorDockRestore} 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)]); {$ENDIF} end; end; procedure TAnchorDockManager.StoreConstraints; begin with Site.Constraints do FStoredConstraints:=Rect(MinWidth,MinHeight,MaxWidth,MaxHeight); end; function TAnchorDockManager.GetSitePreferredClientSize: TPoint; { Compute the preferred inner size of Site without the ChildSite and without the splitter } var ChildSite: TAnchorDockHostSite; Splitter: TAnchorDockSplitter; SplitterSize: TPoint; i: Integer; ChildControl: TControl; PrefWidth: Integer; PrefHeight: Integer; SplitterAnchor: TAnchorKind; // side where a child is anchored to the splitter ChildPrefWidth: integer; ChildPrefHeight: integer; ChildBottom: Integer; ChildRight: Integer; begin Result:=Point(0,0); Site.GetPreferredSize(Result.X,Result.Y); // compute the bounds without the Splitter and ChildSite ChildSite:=GetChildSite; if ChildSite=nil then exit; Splitter:=ChildSite.BoundSplitter; if Splitter=nil then exit; SplitterSize:=Point(0,0); Splitter.GetPreferredSize(SplitterSize.X,SplitterSize.Y); PrefWidth:=0; PrefHeight:=0; if ChildSite.Align in [alLeft,alRight] then PrefHeight:=Result.Y else PrefWidth:=Result.X; SplitterAnchor:=MainAlignAnchor[ChildSite.Align]; for i:=0 to Site.ControlCount-1 do begin ChildControl:=Site.Controls[i]; if (ChildControl=Splitter) or (ChildControl=ChildSite) then continue; if (ChildControl.AnchorSide[SplitterAnchor].Control=Splitter) or ((ChildControl.Align in [alLeft,alTop,alRight,alBottom,alClient]) and (SplitterAnchor in AnchorAlign[ChildControl.Align])) then begin // this control could be resized by the splitter // => use its position and preferred size for a preferred size of the ChildSite ChildPrefWidth:=0; ChildPrefHeight:=0; ChildControl.GetPreferredSize(ChildPrefWidth,ChildPrefHeight); //debugln([' ChildControl=',DbgSName(ChildControl),' ',ChildPrefWidth,',',ChildPrefHeight]); case ChildSite.Align of alTop: begin ChildBottom:=ChildControl.Top+ChildControl.Height; PrefHeight:=Max(PrefHeight,Site.ClientHeight-ChildBottom-ChildPrefHeight); end; alBottom: PrefHeight:=Max(PrefHeight,ChildControl.Top+ChildPrefHeight); alLeft: begin ChildRight:=ChildControl.Left+ChildControl.Width; PrefWidth:=Max(PrefWidth,Site.ClientWidth-ChildRight-ChildPrefWidth); end; alRight: PrefWidth:=Max(PrefWidth,ChildControl.Left+ChildPrefWidth); end; end; end; {$IFDEF VerboseADCustomSite} debugln(['TAnchorDockManager.GetSitePreferredClientSize DefaultSitePref=',dbgs(Result),' Splitter.Align=',dbgs(Splitter.Align),' ChildSite.Align=',dbgs(ChildSite.Align),' NewPref=',PrefWidth,',',PrefHeight]); {$ENDIF} Result.X:=PrefWidth; Result.Y:=PrefHeight; end; function TAnchorDockManager.GetChildSite: TAnchorDockHostSite; var i: Integer; begin for i:=0 to Site.ControlCount-1 do if Site.Controls[i] is TAnchorDockHostSite then begin Result:=TAnchorDockHostSite(Site.Controls[i]); exit; end; Result:=nil; end; function TAnchorDockManager.StoredConstraintsValid: boolean; begin with FStoredConstraints do Result:=(Left<>0) or (Top<>0) or (Right<>0) or (Bottom<>0); end; function TAnchorDockManager.IsEnabledControl(Control: TControl):Boolean; begin Result := (DockMaster <> nil) and DockMaster.IsSite(Control); end; function TAnchorDockManager.CanBeDoubleDocked:Boolean; begin Result := False; end; { TAnchorDockSplitter } procedure TAnchorDockSplitter.SetResizeAnchor(const AValue: TAnchorKind); begin inherited SetResizeAnchor(AValue); case ResizeAnchor of akLeft: Anchors:=AnchorAlign[alLeft]; akTop: Anchors:=AnchorAlign[alTop]; akRight: Anchors:=AnchorAlign[alRight]; akBottom: Anchors:=AnchorAlign[alBottom]; end; UpdatePercentPosition; //debugln(['TAnchorDockSplitter.SetResizeAnchor ',DbgSName(Self),' ResizeAnchor=',dbgs(ResizeAnchor),' Align=',dbgs(Align),' Anchors=',dbgs(Anchors)]); end; procedure TAnchorDockSplitter.SetParent(NewParent: TWinControl); begin if NewParent=nil then AsyncUpdateDockBounds:=false; inherited SetParent(NewParent); end; procedure TAnchorDockSplitter.PopupMenuPopup(Sender: TObject); begin end; procedure TAnchorDockSplitter.OnAsyncUpdateDockBounds (Data: PtrInt); begin FAsyncUpdateDockBounds:=false; FPercentPosition:=-1; UpdateDockBounds; end; procedure TAnchorDockSplitter.UpdateDockBounds; begin if csDestroying in ComponentState then exit; FDockBounds:=BoundsRect; if Parent<>nil then begin FDockParentClientSize.cx:=Parent.ClientWidth; FDockParentClientSize.cy:=Parent.ClientHeight; end else begin FDockParentClientSize.cx:=0; FDockParentClientSize.cy:=0; end; if FPercentPosition < 0 then UpdatePercentPosition; end; procedure TAnchorDockSplitter.ConstrainBounds(var ALeft, ATop, AWidth, AHeight: integer); begin if (Parent = nil) or (not HandleAllocated) or (FPercentPosition <= 0) or ((DockMaster <> nil) and (DockMaster.fUpdateCount > 0)) then exit; if not (akRight in Anchors) then begin if ALeft + AWidth > Parent.ClientWidth then ALeft := Parent.ClientWidth - AWidth; if ALeft < 0 then ALeft := 0; end; if not (akBottom in Anchors) then begin if ATop + AHeight > Parent.ClientHeight then ATop := Parent.ClientHeight - AHeight; if ATop < 0 then ATop := 0; end; end; procedure TAnchorDockSplitter.UpdatePercentPosition; begin case ResizeAnchor of akTop, akBottom: if FDockParentClientSize.cy > 0 then FPercentPosition := Top / FDockParentClientSize.cy else FPercentPosition := -1; else if FDockParentClientSize.cx > 0 then FPercentPosition := Left / FDockParentClientSize.cx else FPercentPosition := -1; end; end; procedure TAnchorDockSplitter.SetAsyncUpdateDockBounds(const AValue: boolean); begin if FAsyncUpdateDockBounds=AValue then Exit; FAsyncUpdateDockBounds:=AValue; if FAsyncUpdateDockBounds then Application.QueueAsyncCall(@OnAsyncUpdateDockBounds,0) else Application.RemoveAsyncCalls(Self); end; procedure TAnchorDockSplitter.SetBounds(ALeft, ATop, AWidth, AHeight: integer); begin DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockSplitter.SetBounds'){$ENDIF}; try ConstrainBounds(ALeft, ATop, AWidth, AHeight); inherited SetBounds(ALeft, ATop, AWidth, AHeight); UpdateDockBounds; finally EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockSplitter.SetBounds'){$ENDIF}; end; end; procedure TAnchorDockSplitter.SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer); begin ConstrainBounds(ALeft, ATop, AWidth, AHeight); inherited SetBounds(ALeft,ATop,AWidth,AHeight); end; procedure TAnchorDockSplitter.SetBoundsPercentually; var NewLeft, NewTop: Integer; AControl: TControl; SplitterAnchorKind:TAnchorKind; begin if Enabled then begin if ResizeAnchor in [akLeft,akRight] then begin if DockParentClientSize.cx > 0 then begin if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then NewLeft := Round(FPercentPosition*Parent.ClientWidth) else NewLeft := (DockBounds.Left*Parent.ClientWidth) div DockParentClientSize.cx; NewTop := Top; SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height); end; end else begin if DockParentClientSize.cy > 0 then begin NewLeft := Left; if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then NewTop := Round(FPercentPosition*Parent.ClientHeight) else NewTop := (DockBounds.Top*Parent.ClientHeight) div DockParentClientSize.cy; SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height); end; end; if FPercentPosition < 0 then UpdatePercentPosition; end else begin SplitterAnchorKind:=akTop; AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind); if AControl=nil then begin SplitterAnchorKind:=akRight; AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind); end; if AControl=nil then begin SplitterAnchorKind:=akBottom; AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind); end; if AControl=nil then begin SplitterAnchorKind:=akLeft; AControl:=CountAndReturnOnlyOneMinimizedAnchoredControls(self,SplitterAnchorKind); end; if AControl is TAnchorDockHostSite then begin (AControl as TAnchorDockHostSite).UpdateHeaderAlign; NewTop := (AControl as TAnchorDockHostSite).Header.Left; NewTop := (AControl as TAnchorDockHostSite).Header.Height; NewLeft := left; NewTop := top; (AControl as TAnchorDockHostSite).UpdateHeaderAlign; case SplitterAnchorKind of akTop: NewTop := AControl.Top+(AControl as TAnchorDockHostSite).Header.Height; akBottom: NewTop := AControl.Top+AControl.Height-(AControl as TAnchorDockHostSite).Header.Height-Height; akLeft: NewLeft := AControl.Left+(AControl as TAnchorDockHostSite).Header.Width; akRight: NewLeft := AControl.Left+AControl.Width-(AControl as TAnchorDockHostSite).Header.Width-Width; end; SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height); end; end; end; function TAnchorDockSplitter.SideAnchoredControlCount(Side: TAnchorKind): integer; var Sibling: TControl; i: Integer; begin Result:=0; for i:=0 to AnchoredControlCount-1 do begin Sibling:=AnchoredControls[i]; if Sibling.AnchorSide[OppositeAnchor[Side]].Control=Self then inc(Result); end; end; function TAnchorDockSplitter.HasAnchoredControls: boolean; // returns true if this splitter has at least one non splitter control anchored to it var i: Integer; Sibling: TControl; begin Result:=false; for i:=0 to AnchoredControlCount-1 do begin Sibling:=AnchoredControls[i]; if Sibling is TAnchorDockSplitter then continue; exit(true); end; end; function TAnchorDockSplitter.GetSpliterBoundsWithUnminimizedDockSites:TRect; var NewLeft, NewTop: Integer; begin if ResizeAnchor in [akLeft,akRight] then begin if DockParentClientSize.cx > 0 then begin if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then NewLeft := Round(FPercentPosition*Parent.ClientWidth) else NewLeft := (DockBounds.Left*Parent.ClientWidth) div DockParentClientSize.cx; NewTop := Top; end; end else begin if DockParentClientSize.cy > 0 then begin NewLeft := Left; if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then NewTop := Round(FPercentPosition*Parent.ClientHeight) else NewTop := (DockBounds.Top*Parent.ClientHeight) div DockParentClientSize.cy; end; end; result:=Rect(NewLeft,NewTop,NewLeft+Width,NewTop+Height); end; procedure TAnchorDockSplitter.SaveLayout( LayoutNode: TAnchorDockLayoutTreeNode); begin if ResizeAnchor in [akLeft,akRight] then LayoutNode.NodeType:=adltnSplitterVertical else LayoutNode.NodeType:=adltnSplitterHorizontal; LayoutNode.Assign(Self,false,false); if not Enabled then LayoutNode.BoundsRect:=GetSpliterBoundsWithUnminimizedDockSites; LayoutNode.PixelsPerInch:=Screen.PixelsPerInch; end; function TAnchorDockSplitter.HasOnlyOneSibling(Side: TAnchorKind; MinPos, MaxPos: integer): TControl; var i: Integer; AControl: TControl; begin Result:=nil; for i:=0 to AnchoredControlCount-1 do begin AControl:=AnchoredControls[i]; if AControl.AnchorSide[OppositeAnchor[Side]].Control<>Self then continue; // AControl is anchored at Side to this splitter if (Side in [akLeft,akRight]) then begin if (AControl.Left>MaxPos) or (AControl.Left+AControl.WidthMaxPos) or (AControl.Top+AControl.Height= 0) and (DockMaster.FOverlappingForm=nil) then begin APage:=Page[ATabIndex]; if (APage.ControlCount>0) and (APage.Controls[0] is TAnchorDockHostSite) then begin Site:=TAnchorDockHostSite(APage.Controls[0]); DragManager.DragStart(Site,false,DockMaster.DragTreshold); end; end; if (Button = mbRight) then begin //select on right click if ATabIndex>=0 then PageIndex:=ATabIndex; end; end; procedure TAnchorDockPageControl.PopupMenuPopup(Sender: TObject); var ContainsMainForm: Boolean; s: String; TabPositionSection: TMenuItem; Item: TMenuItem; tp: TTabPosition; begin // movement if PageIndex>0 then DockMaster.AddPopupMenuItem('MoveLeftMenuItem', adrsMovePageLeft, @MoveLeftButtonClick); if PageIndex>1 then DockMaster.AddPopupMenuItem('MoveLeftMostMenuItem', adrsMovePageLeftmost, @MoveLeftMostButtonClick); if PageIndex0 then Page[PageIndex].PageIndex:=Page[PageIndex].PageIndex-1; end; procedure TAnchorDockPageControl.MoveLeftMostButtonClick(Sender: TObject); begin if PageIndex>0 then Page[PageIndex].PageIndex:=0; end; procedure TAnchorDockPageControl.MoveRightButtonClick(Sender: TObject); begin if PageIndex'' then NewCaption:=NewCaption+', '; NewCaption:=NewCaption+Child.Caption; end; //debugln(['TAnchorDockPageControl.UpdateDockCaption ',Caption,' ',NewCaption]); if Caption=NewCaption then exit; Caption:=NewCaption; if Parent is TAnchorDockHostSite then TAnchorDockHostSite(Parent).UpdateDockCaption; if Parent is TAnchorDockPage then TAnchorDockPage(Parent).UpdateDockCaption; end; procedure TAnchorDockPageControl.InsertControl(AControl: TControl; Index: Integer); begin inherited InsertControl(AControl, Index); UpdateDockCaption; end; procedure TAnchorDockPageControl.RemoveControl(AControl: TControl); begin inherited RemoveControl(AControl); if (not (csDestroying in ComponentState)) then begin if (PageCount<=1) and (Parent is TAnchorDockHostSite) then DockMaster.NeedSimplify(Parent); UpdateDockCaption; end; end; function TAnchorDockPageControl.GetActiveSite: TAnchorDockHostSite; var CurPage: TCustomPage; CurDockPage: TAnchorDockPage; begin Result:=nil; CurPage:=ActivePageComponent; if not (CurPage is TAnchorDockPage) then exit; CurDockPage:=TAnchorDockPage(CurPage); Result:=CurDockPage.GetSite; end; constructor TAnchorDockPageControl.Create(TheOwner: TComponent); begin inherited Create(TheOwner); PopupMenu:=DockMaster.GetPopupMenu; end; function TAnchorDockPageControl.GetPageClass: TCustomPageClass; begin Result:=DockMaster.PageClass; end; { TAnchorDockOverlappingForm } constructor TAnchorDockOverlappingForm.CreateNew(AOwner: TComponent; Num: Integer = 0); begin inherited; BorderStyle:=bsNone; AnchorDockHostSite:=nil; Panel:=TPanel.Create(self); Panel.BorderStyle:=bsSingle; Panel.Align:=alClient; Panel.Parent:=self; Panel.Visible:=true; end; { TAnchorDockPage } procedure TAnchorDockPage.UpdateDockCaption(Exclude: TControl); var i: Integer; Child: TControl; NewCaption: String; begin NewCaption:=''; for i:=0 to ControlCount-1 do begin Child:=Controls[i]; if Child=Exclude then continue; if not (Child is TAnchorDockHostSite) then continue; if NewCaption<>'' then NewCaption:=NewCaption+', '; NewCaption:=NewCaption+Child.Caption; end; //debugln(['TAnchorDockPage.UpdateDockCaption ',Caption,' ',NewCaption]); if Caption=NewCaption then exit; Caption:=NewCaption; if Parent is TAnchorDockPageControl then TAnchorDockPageControl(Parent).UpdateDockCaption; end; procedure TAnchorDockPage.InsertControl(AControl: TControl; Index: integer); begin inherited InsertControl(AControl, Index); //debugln(['TAnchorDockPage.InsertControl ',DbgSName(AControl)]); if AControl is TAnchorDockHostSite then begin if TAnchorDockHostSite(AControl).Header<>nil then TAnchorDockHostSite(AControl).Header.Parent:=nil; UpdateDockCaption; end; end; procedure TAnchorDockPage.RemoveControl(AControl: TControl); begin inherited RemoveControl(AControl); if (GetSite=nil) and (not (csDestroying in ComponentState)) and (Parent<>nil) and (not (csDestroying in Parent.ComponentState)) then DockMaster.NeedSimplify(Self); end; function TAnchorDockPage.GetSite: TAnchorDockHostSite; begin Result:=nil; if ControlCount=0 then exit; if not (Controls[0] is TAnchorDockHostSite) then exit; Result:=TAnchorDockHostSite(Controls[0]); end; procedure DrawFrame3DHeader(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; {%H-}Horizontal: boolean; {%H-}Focused: boolean); begin Canvas.Frame3d(r,1,bvLowered); Canvas.Frame3d(r,3,bvRaised); end; procedure DrawFrameLine(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; Horizontal: boolean; {%H-}Focused: boolean); var Center:integer; begin if Horizontal then begin Center:=r.Top+(r.Bottom-r.Top) div 2; Canvas.Pen.Color:=clltgray; Canvas.Line(r.Left+5,Center-1,r.Right-3,Center-1); Canvas.Pen.Color:=clgray; Canvas.Line(r.Left+5,Center,r.Right-3,Center); end else begin Center:=r.Right+(r.Left-r.Right) div 2; Canvas.Pen.Color:=clltgray; Canvas.Line(Center-1,r.Top+3,Center-1,r.Bottom-5); Canvas.Pen.Color:=clgray; Canvas.Line(Center,r.Top+3,Center,r.Bottom-5); end; end; procedure DrawFrameLines(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; Horizontal: boolean; {%H-}Focused: boolean); var lx,ly:integer; begin InflateRect(r,-2,-2); if Horizontal then begin lx:=0; ly:=3; r.Bottom:=r.top+(r.bottom-r.Top) div 3; r.top:=r.bottom-ly; end else begin lx:=3; ly:=0; r.Right:=r.Left+(r.Right-r.Left) div 3 ; r.Left:=r.Right-lx; end; DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT ); Types.OffsetRect(r,lx,ly); DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT ); Types.OffsetRect(r,lx,ly); DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT ); end; procedure DrawFramePoints(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; Horizontal: boolean; {%H-}Focused: boolean); var lx,ly,d,lt,lb,lm:integer; begin if Horizontal then begin lx := r.left+2; d := (r.Bottom - r.Top - 5) div 2; lt := r.Top + d; lb := lt + 4; lm := lt + 2; while lx < r.Right do begin Canvas.Pixels[lx, lt] := clBtnShadow; Canvas.Pixels[lx, lb] := clBtnShadow; Canvas.Pixels[lx+2, lm] := clBtnShadow; lx := lx + 4; end; end else begin ly := r.Bottom - 2; d := (r.Right - r.Left - 5) div 2; lt := r.Left + d; lb := lt + 4; lm := lt + 2; while ly > r.Top do begin Canvas.Pixels[lt, ly] := clBtnShadow; Canvas.Pixels[lb, ly] := clBtnShadow; Canvas.Pixels[lm, ly-2] := clBtnShadow; ly := ly - 4; end; end; end; procedure DrawFrameThemedCaption(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; {%H-}Horizontal: boolean; Focused: boolean); var ted:TThemedElementDetails; begin if Focused then ted:=ThemeServices.GetElementDetails(twSmallCaptionActive) else ted:=ThemeServices.GetElementDetails(twSmallCaptionInactive); r.Bottom:=r.Bottom-3; ThemeServices.DrawElement(Canvas.Handle,ted, r); if Focused then ted:=ThemeServices.GetElementDetails(twSmallFrameBottomActive) else ted:=ThemeServices.GetElementDetails(twSmallFrameBottomInactive); r.Top:=r.Bottom; r.Bottom:=r.Bottom+3; ThemeServices.DrawElement(Canvas.Handle,ted, r); end; procedure DrawFrameThemedButton(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; {%H-}Horizontal: boolean; Focused: boolean); var ted:TThemedElementDetails; begin if Focused then ted:=ThemeServices.GetElementDetails(tbPushButtonHot) else ted:=ThemeServices.GetElementDetails(tbPushButtonNormal); ThemeServices.DrawElement(Canvas.Handle,ted, r); end; procedure DrawFrameGradientMenuBar(Canvas: TCanvas; {%H-}Style: TADHeaderStyleDesc; r: TRect; {%H-}Horizontal: boolean; Focused: boolean); var FillDir: TGradientDirection; ColorStart, ColorEnd: TColor; begin if Horizontal then FillDir := gdVertical else FillDir := gdHorizontal; if Focused then begin ColorStart := cl3DHiLight; ColorEnd := cl3DLight; end else begin ColorStart := DecColor(clMenuBar, 32); // darken by 0.125 ColorEnd := clMenuBar; end; Canvas.GradientFill(r, ColorStart, ColorEnd, FillDir); Canvas.Pen.Color := clActiveBorder; Canvas.Pen.Width := 1; Canvas.Frame(r); end; initialization DockMaster:=TAnchorDockMaster.Create(nil); DockMaster.RegisterHeaderStyle('Frame3D', @DrawFrame3DHeader, true, true); DockMaster.RegisterHeaderStyle('Line', @DrawFrameLine, true, true); DockMaster.RegisterHeaderStyle('Lines', @DrawFrameLines, true, true); DockMaster.RegisterHeaderStyle('Points', @DrawFramePoints, true, true); DockMaster.RegisterHeaderStyle('ThemedCaption', @DrawFrameThemedCaption, false, false); DockMaster.RegisterHeaderStyle('ThemedButton', @DrawFrameThemedButton, false, false); DockMaster.RegisterHeaderStyle('GradientMenuBar', @DrawFrameGradientMenuBar, false, false); DockTimer:=TTimer.Create(nil); finalization FreeAndNil(DockMaster); FreeAndNil(DockTimer); end.