{ Unit implementing anchor docking. Copyright (C) 2010 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 ToDo: - keep custom dock site content visible - 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 - http://bugs.freepascal.org/view.php?id=18298 default layout sometimes wrong main bar - http://bugs.freepascal.org/view.php?id=18538 keep size of mainbar - http://bugs.freepascal.org/view.php?id=18553 dock designer windows - http://bugs.freepascal.org/view.php?id=19132 docking already docked - http://bugs.freepascal.org/view.php?id=19200 minimize+restore resize - http://bugs.freepascal.org/view.php?id=19735 main bar on different screen size - http://bugs.freepascal.org/view.php?id=19810 multi monitor - http://bugs.freepascal.org/view.php?id=20845 restore/load tabs - http://bugs.freepascal.org/view.php?id=21076 views - http://bugs.freepascal.org/view.php?id=22149 keep caption of a custom dock site - http://bugs.freepascal.org/view.php?id=23593 open package editor not on top - http://bugs.freepascal.org/view.php?id=23596 (patch) docksite disapears after undocking } unit AnchorDocking; {$mode objfpc}{$H+} interface uses Math, Classes, SysUtils, LResources, types, LCLType, LCLIntf, LCLProc, Controls, Forms, ExtCtrls, ComCtrls, Graphics, Themes, Menus, Buttons, LazConfigStorage, AnchorDockStr, AnchorDockStorage, LazFileCache; 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; 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 } TAnchorDockHeader = class(TCustomPanel) private FCloseButton: TCustomSpeedButton; FHeaderPosition: TADLHeaderPosition; procedure CloseButtonClick(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 CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 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: TCustomSpeedButton read FCloseButton; 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 FDockBounds: TRect; FDockParentClientSize: TSize; FDockRestoreBounds: TRect; protected procedure SetResizeAnchor(const AValue: TAnchorKind); override; procedure PopupMenuPopup(Sender: TObject); virtual; public constructor Create(TheOwner: TComponent); override; property DockBounds: TRect read FDockBounds write FDockBounds; property DockParentClientSize: TSize read FDockParentClientSize write FDockParentClientSize; procedure UpdateDockBounds; procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; // any normal movement sets the DockBounds procedure SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer); // movement for scaling keeps the DockBounds function SideAnchoredControlCount(Side: TAnchorKind): integer; procedure SaveLayout(LayoutNode: TAnchorDockLayoutTreeNode); function HasOnlyOneSibling(Side: TAnchorKind; MinPos, MaxPos: integer): TControl; property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds; end; TAnchorDockSplitterClass = class of TAnchorDockSplitter; { 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; public constructor Create(TheOwner: TComponent); override; procedure UpdateDockCaption(Exclude: TControl = nil); override; property DockPages[Index: integer]: TAnchorDockPage read GetDockPages; procedure RemoveControl(AControl: TControl); override; function GetActiveSite: TAnchorDockHostSite; end; TAnchorDockPageControlClass = class of TAnchorDockPageControl; { 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 = ( 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; procedure SetHeaderSide(const AValue: TAnchorKind); protected 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 CreatePages; 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 RemoveSpiralSplitter(AControl: TControl); procedure ClearChildControlAnchorSides(AControl: TControl); procedure Simplify; procedure SimplifyPages; procedure SimplifyOneControl; function GetOneControl: TControl; function GetSiteCount: integer; function IsOneSiteLayout(out Site: TAnchorDockHostSite): boolean; function IsTwoSiteLayout(out Site1, Site2: TAnchorDockHostSite): boolean; 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; procedure PositionBoundSplitter; public constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; destructor Destroy; override; function CloseQuery: boolean; override; function CloseSite: boolean; virtual; 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; procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); override; procedure UpdateDockCaption(Exclude: TControl = nil); override; procedure UpdateHeaderAlign; procedure UpdateHeaderShowing; procedure BeginUpdateLayout; procedure EndUpdateLayout; function UpdatingLayout: boolean; // save/restore layout procedure SaveLayout(LayoutTree: TAnchorDockLayoutTree; LayoutNode: TAnchorDockLayoutTreeNode); property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds; property HeaderSide: TAnchorKind read FHeaderSide write SetHeaderSide; property Header: TAnchorDockHeader read FHeader; 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; 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; 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 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 } TADHeaderStyle = ( adhsFrame3D, adhsLine, adhsLines, adhsPoints ); const adhsDefault = adhsFrame3D; type TAnchorDockSettings = class private FAllowDragging: boolean; FChangeStamp: integer; FDockOutsideMargin: integer; FDockParentMargin: integer; FDragTreshold: integer; FHeaderAlignLeft: integer; FHeaderAlignTop: integer; FHeaderHint: string; FHeaderStyle: TADHeaderStyle; FHeaderFlatten: boolean; FHeaderFilled: boolean; FHideHeaderCaptionFloatingControl: boolean; FPageAreaInPercent: integer; FScaleOnResize: boolean; FShowHeader: boolean; FShowHeaderCaption: boolean; FSplitterWidth: integer; procedure SetAllowDragging(AValue: boolean); procedure SetDockOutsideMargin(AValue: integer); procedure SetDockParentMargin(AValue: integer); procedure SetDragTreshold(AValue: integer); procedure SetHeaderAlignLeft(AValue: integer); procedure SetHeaderAlignTop(AValue: integer); procedure SetHeaderHint(AValue: string); procedure SetHeaderStyle(AValue: TADHeaderStyle); procedure SetHideHeaderCaptionFloatingControl(AValue: boolean); 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); 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 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: TADHeaderStyle read FHeaderStyle write SetHeaderStyle; property HeaderFlatten: boolean read FHeaderFlatten write SetHeaderFlatten; property HeaderFilled: boolean read FHeaderFilled write SetHeaderFilled; procedure IncreaseChangeStamp; inline; property ChangeStamp: integer read FChangeStamp; procedure LoadFromConfig(Config: TConfigStorage); procedure SaveToConfig(Config: TConfigStorage); function IsEqual(Settings: TAnchorDockSettings): boolean; reintroduce; end; 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; TAnchorDockMaster = class(TComponent) private FAllowDragging: boolean; FControls: TFPList; FDockOutsideMargin: integer; FDockParentMargin: integer; FDragTreshold: integer; FHeaderAlignLeft: integer; FHeaderAlignTop: integer; FHeaderClass: TAnchorDockHeaderClass; FHeaderHint: string; FHeaderStyle: TADHeaderStyle; FHeaderFlatten: boolean; FHeaderFilled: boolean; FIdleConnected: Boolean; FManagerClass: TAnchorDockManagerClass; FOnCreateControl: TADCreateControlEvent; FOnOptionsChanged: TNotifyEvent; FOnShowOptions: TADShowDockMasterOptionsEvent; FOptionsChangeStamp: int64; 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; fNeedSimplify: TFPList; // list of TControl fNeedFree: TFPList; // list of TControl fSimplifying: boolean; fUpdateCount: integer; fDisabledAutosizing: TFPList; // list of TControl fTreeNameToDocker: TADNameToControl; fPopupMenu: TPopupMenu; function GetControls(Index: integer): TControl; function GetLocalizedHeaderHint: string; function CloseUnneededControls(Tree: TAnchorDockLayoutTree): boolean; function CreateNeededControls(Tree: TAnchorDockLayoutTree; DisableAutoSizing: boolean; ControlNames: TStrings): boolean; procedure MapTreeToControls(Tree: TAnchorDockLayoutTree); function RestoreLayout(Tree: TAnchorDockLayoutTree; Scale: boolean): boolean; procedure EnableAllAutoSizing; procedure ClearLayoutProperties(AControl: TControl); procedure PopupMenuPopup(Sender: TObject); procedure ChangeLockButtonClick(Sender: TObject); procedure SetAllowDragging(AValue: boolean); procedure SetDockOutsideMargin(AValue: integer); procedure SetDockParentMargin(AValue: integer); procedure SetDragTreshold(AValue: integer); procedure SetHeaderHint(AValue: string); procedure SetHeaderStyle(AValue: TADHeaderStyle); procedure SetPageAreaInPercent(AValue: integer); procedure SetScaleOnResize(AValue: boolean); procedure SetHeaderFlatten(AValue: boolean); procedure SetHeaderFilled(AValue: boolean); procedure SetShowMenuItemShowHeader(AValue: boolean); 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 AsyncSimplify({%H-}Data: PtrInt); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ControlCount: integer; property Controls[Index: integer]: TControl read GetControls; function IndexOfControl(const aName: string): integer; function FindControl(const aName: string): TControl; 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 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(AForm: TCustomForm; LayoutTree: TAnchorDockLayoutTree); function CreateRestoreLayout(AControl: TControl): TAnchorDockRestoreLayout; function ConfigIsEmpty(Config: TConfigStorage): boolean; function LoadLayoutFromConfig(Config: TConfigStorage; Scale: Boolean): boolean; property RestoreLayouts: TAnchorDockRestoreLayouts read FRestoreLayouts; // layout information for restoring hidden forms 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; // manual docking procedure ManualFloat(AControl: TControl); procedure ManualDock(SrcSite: TAnchorDockHostSite; TargetSite: TCustomForm; Align: TAlign; TargetControl: TControl = nil); function ManualEnlarge(Site: TAnchorDockHostSite; Side: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; // simplification/garbage collection procedure BeginUpdate; procedure EndUpdate; 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 PageAreaInPercent: integer read FPageAreaInPercent write SetPageAreaInPercent default 40; // size of inner mouse snapping area for page docking 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: TADHeaderStyle read FHeaderStyle write SetHeaderStyle default adhsDefault; property HeaderFlatten: boolean read FHeaderFlatten write SetHeaderFlatten default true; property HeaderFilled: boolean read FHeaderFilled write SetHeaderFilled default true; 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 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; end; var DockMaster: TAnchorDockMaster = nil; const ADHeaderStyleNames: array[TADHeaderStyle] of string = ( 'Frame3D', 'Line', 'Lines', 'Points' ); function StrToADHeaderStyle(const s: string): TADHeaderStyle; function dbgs(SiteType: TAnchorDockHostSiteType): string; overload; procedure DrawADHeader(Canvas: TCanvas; Style: TADHeaderStyle; r: TRect; Horizontal: boolean); 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 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 function StrToADHeaderStyle(const s: string): TADHeaderStyle; begin for Result:=Low(TADHeaderStyle) to High(TADHeaderStyle) do if CompareText(ADHeaderStyleNames[Result],s)=0 then exit; Result:=adhsDefault; end; procedure DrawADHeader(Canvas: TCanvas; Style: TADHeaderStyle; r: TRect; Horizontal: boolean); var Center: Integer; lx, ly, d, lt, lb, lm: Integer; begin case Style of adhsFrame3D: begin Canvas.Frame3d(r,2,bvLowered); Canvas.Frame3d(r,4,bvRaised); end; adhsLine: 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; adhsLines: 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 ); OffsetRect(r,lx,ly); DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT ); OffsetRect(r,lx,ly); DrawEdge(Canvas.Handle,r, BDR_RAISEDINNER, BF_RECT ); end; adhsPoints: 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; end; function dbgs(SiteType: TAnchorDockHostSiteType): string; overload; begin case SiteType of adhstNone: Result:='None'; adhstOneControl: Result:='OneControl'; adhstLayout: Result:='Layout'; adhstPages: Result:='Pages'; else Result:='?'; end; end; procedure CopyAnchorBounds(Source, Target: TControl); var a: TAnchorKind; begin Target.DisableAutoSizing; 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]); Target.EnableAutoSizing; 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 GetDockSplitter(Control: TControl; Side: TAnchorKind; out Splitter: TAnchorDockSplitter): boolean; begin Result:=false; Splitter:=nil; if 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 NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl; Side: TAnchorKind): boolean; { returns true if Neighbour can be shrinked on the opposite side of Side } const MinControlSize = 20; var Splitter: TAnchorDockSplitter; begin Result:=false; if not GetDockSplitter(EnlargeControl,OppositeAnchor[Side],Splitter) then exit; case Side of akLeft: // check if left side of Neighbour can be moved Result:=Neighbour.Left+Neighbour.Width >EnlargeControl.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,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.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: TADHeaderStyle); begin if FHeaderStyle=AValue then Exit; FHeaderStyle:=AValue; IncreaseChangeStamp; end; procedure TAnchorDockSettings.SetHideHeaderCaptionFloatingControl( AValue: boolean); begin if FHideHeaderCaptionFloatingControl=AValue then Exit; FHideHeaderCaptionFloatingControl:=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.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.IncreaseChangeStamp; begin LUIncreaseChangeStamp(fChangeStamp); end; procedure TAnchorDockSettings.LoadFromConfig(Config: TConfigStorage); begin Config.AppendBasePath('Settings/'); DragTreshold:=Config.GetValue('DragThreshold',4); DockOutsideMargin:=Config.GetValue('DockOutsideMargin',10); DockParentMargin:=Config.GetValue('DockParentMargin',10); PageAreaInPercent:=Config.GetValue('PageAreaInPercent',40); HeaderAlignTop:=Config.GetValue('HeaderAlignTop',80); HeaderAlignLeft:=Config.GetValue('HeaderAlignLeft',120); SplitterWidth:=Config.GetValue('SplitterWidth',4); ScaleOnResize:=Config.GetValue('ScaleOnResize',true); ShowHeader:=Config.GetValue('ShowHeader',true); ShowHeaderCaption:=Config.GetValue('ShowHeaderCaption',true); HideHeaderCaptionFloatingControl:=Config.GetValue('HideHeaderCaptionFloatingControl',true); AllowDragging:=Config.GetValue('AllowDragging',true); HeaderStyle:=StrToADHeaderStyle(Config.GetValue('HeaderStyle',ADHeaderStyleNames[adhsDefault])); HeaderFlatten:=Config.GetValue('HeaderFlatten',true); HeaderFilled:=Config.GetValue('HeaderFilled',true); Config.UndoAppendBasePath; end; procedure TAnchorDockSettings.SaveToConfig(Config: TConfigStorage); begin Config.AppendBasePath('Settings/'); Config.SetDeleteValue('DragThreshold',DragTreshold,4); Config.SetDeleteValue('DockOutsideMargin',DockOutsideMargin,10); Config.SetDeleteValue('DockParentMargin',DockParentMargin,10); Config.SetDeleteValue('PageAreaInPercent',PageAreaInPercent,40); Config.SetDeleteValue('HeaderAlignTop',HeaderAlignTop,80); Config.SetDeleteValue('HeaderAlignLeft',HeaderAlignLeft,120); Config.SetDeleteValue('SplitterWidth',SplitterWidth,4); Config.SetDeleteValue('ScaleOnResize',ScaleOnResize,true); Config.SetDeleteValue('ShowHeader',ShowHeader,true); Config.SetDeleteValue('ShowHeaderCaption',ShowHeaderCaption,true); Config.SetDeleteValue('HideHeaderCaptionFloatingControl',HideHeaderCaptionFloatingControl,true); Config.SetDeleteValue('AllowDragging',AllowDragging,true); Config.SetDeleteValue('HeaderStyle',ADHeaderStyleNames[HeaderStyle],ADHeaderStyleNames[adhsDefault]); Config.SetDeleteValue('HeaderFlatten',HeaderFlatten,true); Config.SetDeleteValue('HeaderFilled',HeaderFilled,true); Config.UndoAppendBasePath; end; function TAnchorDockSettings.IsEqual(Settings: TAnchorDockSettings): boolean; begin Result:=(DragTreshold=Settings.DragTreshold) and (DockOutsideMargin=Settings.DockOutsideMargin) and (DockParentMargin=Settings.DockParentMargin) and (PageAreaInPercent=Settings.PageAreaInPercent) and (HeaderAlignTop=Settings.HeaderAlignTop) and (HeaderAlignLeft=Settings.HeaderAlignLeft) and (HeaderHint=Settings.HeaderHint) and (SplitterWidth=Settings.SplitterWidth) and (ScaleOnResize=Settings.ScaleOnResize) and (ShowHeader=Settings.ShowHeader) and (ShowHeaderCaption=Settings.ShowHeaderCaption) and (HideHeaderCaptionFloatingControl=Settings.HideHeaderCaptionFloatingControl) and (AllowDragging=Settings.AllowDragging) and (HeaderStyle=Settings.HeaderStyle) and (HeaderFlatten=Settings.HeaderFlatten) and (HeaderFilled=Settings.HeaderFilled) ; end; { TAnchorDockMaster } function TAnchorDockMaster.GetControls(Index: integer): TControl; begin Result:=TControl(FControls[Index]); end; function TAnchorDockMaster.GetLocalizedHeaderHint: string; begin if HeaderHint<>'' then Result:=HeaderHint else Result:=adrsDragAndDockC; 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; function TAnchorDockMaster.CloseUnneededControls(Tree: TAnchorDockLayoutTree ): Boolean; var i: Integer; AControl: TControl; begin i:=ControlCount-1; while i>=0 do begin AControl:=Controls[i]; if AControl.IsVisible and (Tree.Root.FindChildNode(AControl.Name,true)=nil) and (Application.MainForm<>AControl) then begin DisableControlAutoSizing(AControl); // AControl is currently on a visible site, but not in the Tree // => close site debugln(['TAnchorDockMaster.CloseUnneededControls Control=',DbgSName(AControl),' Site=',AControl.HostDockSite.Name]); if AControl.HostDockSite is TAnchorDockHostSite then begin if not TAnchorDockHostSite(AControl.HostDockSite).CloseSite then begin if FControls.IndexOf(AControl)<0 then AControl:=nil; debugln(['TAnchorDockMaster.CloseUnneededControls CloseSite failed Control=',DbgSName(AControl)]); exit(false); 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; 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']); DisableControlAutoSizing(AControl); end else begin //debugln(['CreateControlsForNode ',Node.Name,' needs creation']); AControl:=DoCreateControl(Node.Name,DisableAutoSizing); if AControl<>nil then begin //debugln(['CreateControlsForNode ',AControl.Name,' created']); if fDisabledAutosizing.IndexOf(AControl)<0 then fDisabledAutosizing.Add(AControl); if Node.NodeType=adltnControl then MakeDockable(AControl,false) else if not IsCustomSite(AControl) then raise EAnchorDockLayoutError.Create('not a docksite: '+DbgSName(AControl)); 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) 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 whith 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 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 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; 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 splitter node is not yet mapped Splitter:=Site.AnchorSide[Side].Control; if (not (Splitter is TAnchorDockSplitter)) or (Splitter.Parent<>Site.Parent) then continue; // there is an unmapped splitter anchored to the Site // => map the splitter to the splitter node fTreeNameToDocker[Splitter.Name]:=Splitter; end; end; begin MapHostDockSites(Tree.Root); MapTopLevelSites(Tree.Root); MapBottomUp(Tree.Root); MapSplitters(Tree.Root); end; function TAnchorDockMaster.RestoreLayout(Tree: TAnchorDockLayoutTree; Scale: boolean): boolean; var WorkArea: TRect; function SrcRectValid(const r: TRect): boolean; begin Result:=(r.Left dock it AControl:=FindControl(Node.Name); if AControl=nil then begin debugln(['TAnchorDockMaster.RestoreLayout.Restore can not find control ',Node.Name]); exit; end; DisableControlAutoSizing(AControl); if AControl.HostDockSite=nil then MakeDockable(AControl,false) else ClearLayoutProperties(AControl); Site:=AControl.HostDockSite as TAnchorDockHostSite; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.RestoreLayout.Restore Control Node.Name=',Node.Name,' Control=',DbgSName(AControl),' Site=',DbgSName(Site)]); {$ENDIF} AControl.Visible:=true; SetupSite(Site,Node,Parent,SrcRect); Result:=Site; end else if Node.NodeType=adltnCustomSite then begin // restore custom dock site // the control was already created // => position it AControl:=FindControl(Node.Name); if AControl=nil then begin debugln(['TAnchorDockMaster.RestoreLayout.Restore WARNING: can not find control ',Node.Name]); exit; end; if not IsCustomSite(AControl) then begin debugln(['TAnchorDockMaster.RestoreLayout.Restore WARNING: ',Node.Name,' is not a custom dock site ',DbgSName(AControl)]); exit; end; DisableControlAutoSizing(AControl); SetupSite(TCustomForm(AControl),Node,nil,SrcRect); Result:=AControl; // restore docked site if Node.Count>0 then begin Restore(Node[0],TCustomForm(AControl),SrcRect); end; end else if Node.IsSplitter then begin // restore splitter Splitter:=TAnchorDockSplitter(fTreeNameToDocker[Node.Name]); if Splitter=nil then begin Splitter:=CreateSplitter; fTreeNameToDocker[Node.Name]:=Splitter; end; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.RestoreLayout.Restore Splitter Node.Name=',Node.Name,' ',dbgs(Node.NodeType),' Splitter=',DbgSName(Splitter)]); {$ENDIF} Splitter.Parent:=Parent; NewBounds:=Node.BoundsRect; if SrcRectValid(SrcRect) then NewBounds:=Bounds(ScaleX(NewBounds.Left,SrcRect),ScaleX(NewBounds.Top,SrcRect), NewBounds.Right-NewBounds.Left,NewBounds.Bottom-NewBounds.Top); Splitter.DockRestoreBounds:=NewBounds; Splitter.BoundsRect:=NewBounds; if Node.NodeType=adltnSplitterVertical then Splitter.ResizeAnchor:=akLeft else Splitter.ResizeAnchor:=akTop; Result:=Splitter; end else if Node.NodeType=adltnLayout then begin // restore layout Site:=TAnchorDockHostSite(fTreeNameToDocker[Node.Name]); if Site=nil then begin Site:=CreateSite; fDisabledAutosizing.Add(Site); fTreeNameToDocker[Node.Name]:=Site; end; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.RestoreLayout.Restore Layout Node.Name=',Node.Name,' ChildCount=',Node.Count]); {$ENDIF} Site.BeginUpdateLayout; try SetupSite(Site,Node,Parent,SrcRect); Site.FSiteType:=adhstLayout; Site.Header.Parent:=nil; // create children for i:=0 to Node.Count-1 do Restore(Node[i],Site,SrcRect); // anchor children for i:=0 to Node.Count-1 do begin ChildNode:=Node[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 AnchorControl:=fTreeNameToDocker[ChildNode.Anchors[Side]]; if AnchorControl<>nil then AControl.AnchorToNeighbour(Side,0,AnchorControl) else AControl.AnchorParallel(Side,0,Site); end; end; finally Site.EndUpdateLayout; end; Result:=Site; end else if Node.NodeType=adltnPages then begin // restore pages Site:=TAnchorDockHostSite(fTreeNameToDocker[Node.Name]); if Site=nil then begin Site:=CreateSite; fDisabledAutosizing.Add(Site); fTreeNameToDocker[Node.Name]:=Site; end; Site.BeginUpdateLayout; try SetupSite(Site,Node,Parent,SrcRect); Site.FSiteType:=adhstPages; Site.Header.Parent:=nil; Site.CreatePages; for i:=0 to Node.Count-1 do begin Site.Pages.Pages.Add(Node[i].Name); AControl:=Restore(Node[i],Site.Pages.Page[i],SrcRect); if AControl=nil then continue; AControl.Align:=alClient; for Side:=Low(TAnchorKind) to high(TAnchorKind) do AControl.AnchorSide[Side].Control:=nil; end; finally Site.EndUpdateLayout; end; Result:=Site; end else begin // create children for i:=0 to Node.Count-1 do Restore(Node[i],Parent,SrcRect); end; end; begin Result:=true; WorkArea:=Rect(0,0,0,0); Restore(Tree.Root,nil,Rect(0,0,0,0)); Restoring:=true; 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; end; procedure TAnchorDockMaster.EnableAllAutoSizing; var i: Integer; AControl: TControl; begin i:=fDisabledAutosizing.Count-1; while (i>=0) do begin //debugln(['TAnchorDockMaster.EnableAllAutoSizing ',DbgSName(TControl(fDisabledAutosizing[i]))]); AControl:=TControl(fDisabledAutosizing[i]); fDisabledAutosizing.Delete(i); AControl.EnableAutoSizing; i:=Min(i,fDisabledAutosizing.Count)-1; end; end; procedure TAnchorDockMaster.ClearLayoutProperties(AControl: TControl); var a: TAnchorKind; begin AControl.AutoSize:=false; AControl.Align:=alClient; 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.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 Splitter.ResizeAnchor in [akLeft,akRight] then Splitter.Width:=SplitterWidth else Splitter.Height:=SplitterWidth; end; OptionsChanged; end; procedure TAnchorDockMaster.OnIdle(Sender: TObject; var Done: Boolean); begin if Done then ; IdleConnected:=false; Restoring:=false; end; procedure TAnchorDockMaster.AsyncSimplify(Data: PtrInt); begin FQueueSimplify:=false; SimplifyPendingLayouts; end; procedure TAnchorDockMaster.ChangeLockButtonClick(Sender: TObject); begin AllowDragging:=not AllowDragging; 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: TADHeaderStyle); begin if FHeaderStyle=AValue then Exit; FHeaderStyle:=AValue; OptionsChanged; InvalidateHeaders; end; procedure TAnchorDockMaster.SetPageAreaInPercent(AValue: integer); begin if FPageAreaInPercent=AValue then Exit; FPageAreaInPercent:=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.SetScaleOnResize(AValue: boolean); begin if FScaleOnResize=AValue then Exit; FScaleOnResize:=AValue; 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; 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); end; end; if EnableAutoSizing then EnableAllAutoSizing; end; constructor TAnchorDockMaster.Create(AOwner: TComponent); begin inherited Create(AOwner); FControls:=TFPList.Create; FAllowDragging:=true; FDragTreshold:=4; FDockOutsideMargin:=10; FDockParentMargin:=10; FPageAreaInPercent:=40; FHeaderAlignTop:=80; HeaderAlignLeft:=120; FHeaderHint:=''; FShowHeader:=true; FShowHeaderCaption:=true; FHideHeaderCaptionFloatingControl:=true; FSplitterWidth:=4; FScaleOnResize:=true; 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; end; destructor TAnchorDockMaster.Destroy; var AControl: TControl; i: Integer; begin 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(fDisabledAutosizing); for i:=0 to ComponentCount-1 do begin debugln(['TAnchorDockMaster.Destroy ',i,'/',ComponentCount,' ',DbgSName(Components[i])]); end; 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.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; try if AControl is TAnchorDockHostSite then begin // already a site Site:=TAnchorDockHostSite(AControl); end else if AControl.Parent=nil then 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; 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; if (Site<>nil) and Show then MakeVisible(Site,BringToFront); finally AControl.EnableAutoSizing; end; // BringToFront if 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.MakeDockable '+ 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; 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; end; end; procedure TAnchorDockMaster.MakeVisible(AControl: TControl; SwitchPages: boolean); var Form: TCustomForm; begin while AControl<>nil do begin AControl.Visible:=true; if SwitchPages and (AControl is TAnchorDockPage) then TAnchorDockPageControl(AControl.Parent).PageIndex:= TAnchorDockPage(AControl).PageIndex; if AControl.Parent=nil then begin if AControl is TCustomForm then begin Form:=TCustomForm(AControl); if Form.Monitor<>nil then Form.MakeFullyVisible(nil,true); end; break; end; 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 // hide all forms i:=Screen.CustomFormCount-1; while i>=0 do begin AForm:=GetParentForm(Screen.CustomForms[i]); 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; end; procedure TAnchorDockMaster.SaveMainLayoutToTree(LayoutTree: TAnchorDockLayoutTree); var i: Integer; AControl: TControl; Site: TAnchorDockHostSite; SavedSites: TFPList; LayoutNode: TAnchorDockLayoutTreeNode; AForm: TCustomForm; VisibleControls: TStringList; begin SavedSites:=TFPList.Create; VisibleControls:=TStringList.Create; try for i:=0 to ControlCount-1 do begin AControl:=Controls[i]; if not AControl.IsVisible then continue; VisibleControls.Add(AControl.Name); AForm:=GetParentForm(AControl); if AForm=nil then continue; if SavedSites.IndexOf(AForm)>=0 then continue; SavedSites.Add(AForm); debugln(['TAnchorDockMaster.SaveMainLayoutToTree AForm=',DbgSName(AForm)]); DebugWriteChildAnchors(AForm,true,true); if (AForm is TAnchorDockHostSite) then begin Site:=TAnchorDockHostSite(AForm); LayoutNode:=LayoutTree.NewNode(LayoutTree.Root); Site.SaveLayout(LayoutTree,LayoutNode); end else if IsCustomSite(AForm) then begin // custom dock site LayoutNode:=LayoutTree.NewNode(LayoutTree.Root); LayoutNode.NodeType:=adltnCustomSite; LayoutNode.Assign(AForm); // can have one normal dock site Site:=TAnchorDockManager(AForm.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 else raise EAnchorDockLayoutError.Create('invalid root control for save: '+DbgSName(AControl)); end; // remove invisible controls LayoutTree.Root.Simplify(VisibleControls); finally VisibleControls.Free; SavedSites.Free; end; end; procedure TAnchorDockMaster.SaveSiteLayoutToTree(AForm: TCustomForm; LayoutTree: TAnchorDockLayoutTree); var LayoutNode: TAnchorDockLayoutTreeNode; Site: TAnchorDockHostSite; begin if (AForm is TAnchorDockHostSite) then begin Site:=TAnchorDockHostSite(AForm); Site.SaveLayout(LayoutTree,LayoutTree.Root); end else if IsCustomSite(AForm) then begin LayoutTree.Root.NodeType:=adltnCustomSite; LayoutTree.Root.Assign(AForm); // can have one normal dock site Site:=TAnchorDockManager(AForm.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(AForm)); 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:=GetParentForm(AControl); Result:=TAnchorDockRestoreLayout.Create(TAnchorDockLayoutTree.Create); if AForm=nil then exit; SaveSiteLayoutToTree(AForm,Result.Layout); AddControlNames(AControl,Result); 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; WriteDebugLayout('TAnchorDockMaster.SaveLayoutToConfig ',Tree.Root); //DebugWriteChildAnchors(Tree.Root); finally Tree.Free; end; 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: TStringList; begin Result:=false; ControlNames:=TStringList.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 forms/controls if not CloseUnneededControls(Tree) then exit; BeginUpdate; try // create all needed forms/controls if not CreateNeededControls(Tree,true,ControlNames) then exit; // simplify layouts ControlNames.Sort; {$IFDEF VerboseAnchorDockRestore} debugln(['TAnchorDockMaster.LoadLayoutFromConfig controls: ']); debugln(ControlNames.Text); {$ENDIF} Tree.Root.Simplify(ControlNames); // reuse existing sites to reduce flickering MapTreeToControls(Tree); {$IFDEF VerboseAnchorDockRestore} fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.LoadLayoutFromConfig Map'); {$ENDIF} // create sites RestoreLayout(Tree,Scale); finally EndUpdate; end; finally // clean up FreeAndNil(fTreeNameToDocker); ControlNames.Free; Tree.Free; // commit (this can raise an exception) EnableAllAutoSizing; end; {$IFDEF VerboseAnchorDockRestore} DebugWriteChildAnchors(Application.MainForm,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 DragTreshold := Settings.DragTreshold; DockOutsideMargin := Settings.DockOutsideMargin; DockParentMargin := Settings.DockParentMargin; PageAreaInPercent := Settings.PageAreaInPercent; HeaderAlignTop := Settings.HeaderAlignTop; HeaderAlignLeft := Settings.HeaderAlignLeft; SplitterWidth := Settings.SplitterWidth; ScaleOnResize := Settings.ScaleOnResize; ShowHeader := Settings.ShowHeader; ShowHeaderCaption := Settings.ShowHeaderCaption; HideHeaderCaptionFloatingControl := Settings.HideHeaderCaptionFloatingControl; AllowDragging := Settings.AllowDragging; HeaderStyle := Settings.HeaderStyle; HeaderFlatten := Settings.HeaderFlatten; HeaderFilled := Settings.HeaderFilled; end; procedure TAnchorDockMaster.SaveSettings(Settings: TAnchorDockSettings); begin Settings.DragTreshold:=DragTreshold; Settings.DockOutsideMargin:=DockOutsideMargin; Settings.DockParentMargin:=DockParentMargin; Settings.PageAreaInPercent:=PageAreaInPercent; Settings.HeaderAlignTop:=HeaderAlignTop; Settings.HeaderAlignLeft:=HeaderAlignLeft; Settings.SplitterWidth:=SplitterWidth; Settings.ScaleOnResize:=ScaleOnResize; Settings.ShowHeader:=ShowHeader; Settings.ShowHeaderCaption:=ShowHeaderCaption; Settings.HideHeaderCaptionFloatingControl:=HideHeaderCaptionFloatingControl; Settings.AllowDragging:=AllowDragging; Settings.HeaderStyle:=HeaderStyle; Settings.HeaderFlatten:=HeaderFlatten; Settings.HeaderFilled:=HeaderFilled; 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 debugln(['TAnchorDockMaster.ManualDock SrcSite=',DbgSName(SrcSite),' TargetSite=',DbgSName(TargetSite),' Align=',dbgs(Align),' TargetControl=',DbgSName(TargetControl)]); 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 debugln(['TAnchorDockMaster.ManualDock dock as first site into custom dock site: SrcSite=',DbgSName(SrcSite),' TargetSite=',DbgSName(TargetSite),' Align=',dbgs(Align)]); BeginUpdate; try DockObject := TDragDockObject.Create(SrcSite); try DockObject.DropAlign:=Align; DockObject.DockRect:=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; 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 SimplifyPendingLayouts; 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 fNeedFree.IndexOf(AControl)>=0 then exit; if csDestroying in AControl.ComponentState then exit; fNeedFree.Add(AControl); AControl.DisableAutoSizing; 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 (fNeedFree.IndexOf(AControl)>=0) 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 while fNeedFree.Count>0 do if csDestroying in TControl(fNeedFree[0]).ComponentState then fNeedFree.Delete(0) else TControl(fNeedFree[0]).Free; 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 layout 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 OneControl 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); Result.DisableAutoSizing; 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; if not DisableAutoSizing then Result.EnableAutoSizing; 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; { TAnchorDockHostSite } procedure TAnchorDockHostSite.SetHeaderSide(const AValue: TAnchorKind); begin if FHeaderSide=AValue then exit; FHeaderSide:=AValue; 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 ; 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; try BeginUpdateLayout; try DockMaster.SimplifyPendingLayouts; NewControl.DisableAutoSizing; 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 // add site as sibling Result:=DockAnotherControl(nil,NewControl,DockAlign,DropOnControl<>nil); end; NewControl.EnableAutoSizing; finally EndUpdateLayout; end; finally EnableAutoSizing; 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; begin Result:=true; debugln(['TAnchorDockHostSite.DockSecondControl Self="',Caption,'" AControl=',DbgSName(NewControl),' Align=',dbgs(DockAlign),' Inside=',Inside]); if SiteType<>adhstOneControl then RaiseGDBException('TAnchorDockHostSite.DockSecondControl inconsistency: not adhstOneControl'); if not (DockAlign in [alLeft,alTop,alRight,alBottom]) then RaiseGDBException('TAnchorDockHostSite.DockSecondControl inconsistency: DockAlign='+dbgs(DockAlign)); 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); AddCleanControl(OldSite); 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); debugln(['TAnchorDockHostSite.DockSecondControl END Self="',Caption,'" AControl=',DbgSName(NewControl),' Align=',dbgs(DockAlign),' Inside=',Inside]); 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; debugln(['TAnchorDockHostSite.DockAnotherControl AFTER ENLARGE ',Caption]); //DebugWriteChildAnchors(Self,true,true); 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); 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); 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 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; end; function TAnchorDockHostSite.DockSecondPage(NewControl: TControl): boolean; var OldControl: TControl; OldSite: TAnchorDockHostSite; begin debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" AControl=',DbgSName(NewControl)]); if SiteType<>adhstOneControl then RaiseGDBException('TAnchorDockHostSite.DockSecondPage inconsistency'); FSiteType:=adhstPages; CreatePages; // remove header (keep it for later use) debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" removing header ...']); Header.Parent:=nil; // put the OldControl into a page of its own debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" move oldcontrol to site of its own ...']); OldControl:=GetOneControl; OldSite:=MakeSite(OldControl); OldSite.HostDockSite:=nil; debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" adding oldcontrol site ...']); 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 debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" make new control (',DbgSName(NewControl),') dockable ...']); 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; 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; 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; 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 debugln(['TAnchorDockHostSite.RemoveControlFromLayout Self="',Caption,'" AControl=',DbgSName(AControl),'="',AControl.Caption,'"']); 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.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; debugln(['TAnchorDockHostSite.Simplify ',DbgSName(Self),' ',DbgSName(AControl)]); 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 Pages.PageCount=1 then begin debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=1']); DisableAutoSizing; 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 FreeAndNil(FPages); if SiteType=adhstOneControl then SimplifyOneControl; finally EndUpdateLayout; EnableAutoSizing; 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; FreeAndNil(FPages); DockMaster.NeedSimplify(Self); end; end; procedure TAnchorDockHostSite.SimplifyOneControl; var Site: TAnchorDockHostSite; i: Integer; Child: TControl; a: TAnchorKind; begin if SiteType<>adhstOneControl then exit; if not IsOneSiteLayout(Site) then exit; debugln(['TAnchorDockHostSite.SimplifyOneControl Self="',Caption,'" Site="',Site.Caption,'"']); DisableAutoSizing; 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.Caption:=Site.Header.Caption; UpdateHeaderShowing; Caption:=Site.Caption; Site.BeginUpdateLayout; // move controls from Site to Self i:=Site.ControlCount-1; while i>=0 do begin Child:=Site.Controls[i]; if Child.Owner<>Site then begin //debugln(['TAnchorDockHostSite.SimplifyOneControl Self="',Caption,'" Child=',DbgSName(Child),'="',Child.Caption,'"']); 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; Site.EndUpdateLayout; // delete Site Site.FSiteType:=adhstNone; DockMaster.NeedFree(Site); finally EndUpdateLayout; EnableAutoSizing; 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:=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.IsVisible then continue; inc(Result); end; 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.IsVisible 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.IsVisible 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.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; 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; 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.IsVisible 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]); if Splitter.ResizeAnchor in [akLeft,akRight] then begin if Splitter.DockParentClientSize.cx>0 then Splitter.SetBoundsKeepDockBounds( (Splitter.DockBounds.Left*ClientWidth) div Splitter.DockParentClientSize.cx, Splitter.Top,Splitter.Width,Splitter.Height); end else begin if Splitter.DockParentClientSize.cy>0 then Splitter.SetBoundsKeepDockBounds(Splitter.Left, (Splitter.DockBounds.Top*ClientHeight) div Splitter.DockParentClientSize.cy, Splitter.Width,Splitter.Height); end; //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 Visible) 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; 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]); Visible:=false; Parent:=nil; EnableAutoSizing; 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); 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); begin 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; p := Point(0,0); p := ClientToScreen(p); Parent:=nil; SetBounds(p.x,p.y,Width,Height); EnableAutoSizing; 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; try i:=0; while i --+#| 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; 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; 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.Width'' 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)]); if ((Parent=nil) and DockMaster.HideHeaderCaptionFloatingControl) or (not DockMaster.ShowHeaderCaption) then Header.Caption:='' else 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); //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); OffsetRect(Result,(Width*(100-DockMaster.PageAreaInPercent)) div 200, (Height*(100-DockMaster.PageAreaInPercent)) div 200); 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; begin if Header=nil then exit; case Header.HeaderPosition 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; begin if Header=nil then exit; if HeaderNeedsShowing then Header.Parent:=Self 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; 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); 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); 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); LayoutNode.HeaderPosition:=Header.HeaderPosition; 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; end; constructor TAnchorDockHostSite.CreateNew(AOwner: TComponent; Num: Integer); begin inherited CreateNew(AOwner,Num); 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); end; destructor TAnchorDockHostSite.Destroy; //var i: Integer; begin //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])]);} FreeAndNil(FPages); 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; // undock, merge DockMaster.AddRemovePopupMenuItem(ParentSite.CanUndock,'UndockMenuItem', adrsUndock,@UndockButtonClick); DockMaster.AddRemovePopupMenuItem(ParentSite.CanMerge,'MergeMenuItem', adrsMerge, @MergeButtonClick); // 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; // 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; // close 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.CloseButtonClick(Sender: TObject); begin if Parent is TAnchorDockHostSite then begin DockMaster.RestoreLayouts.Add(DockMaster.CreateRestoreLayout(Parent),true); TAnchorDockHostSite(Parent).CloseSite; 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.Paint; var r: TRect; TxtH: longint; TxtW: longint; dx,dy: Integer; begin r:=ClientRect; Canvas.Brush.Color := clForm; if DockMaster.HeaderFilled then Canvas.FillRect(r); if not DockMaster.HeaderFlatten then Canvas.Frame3d(r,1,bvRaised); {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+1 else r.Right:=CloseButton.Left-1; end; // caption if Caption<>'' then begin 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); DrawADHeader(Canvas,DockMaster.HeaderStyle,Rect(r.Left,r.Top,r.Right,r.Bottom-dy-TxtW-1),false); DrawADHeader(Canvas,DockMaster.HeaderStyle,Rect(r.Left,r.Bottom-dy+1,r.Right,r.Bottom),false); end else begin // text does not fit DrawADHeader(Canvas,DockMaster.HeaderStyle,r,false); 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); DrawADHeader(Canvas,DockMaster.HeaderStyle,Rect(r.Left,r.Top,r.Left+dx-1,r.Bottom),true); DrawADHeader(Canvas,DockMaster.HeaderStyle,Rect(r.Left+dx+TxtW+2,r.Top,r.Right,r.Bottom),true); end else begin // text does not fit DrawADHeader(Canvas,DockMaster.HeaderStyle,r,true); end; end; end else begin if Align in [alLeft,alRight] then DrawADHeader(Canvas,DockMaster.HeaderStyle,r,false) else DrawADHeader(Canvas,DockMaster.HeaderStyle,r,true); end; end; procedure TAnchorDockHeader.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); const TestTxt = 'ABCXYZ123gqj'; var DC: HDC; R: TRect; OldFont: HGDIOBJ; Flags: cardinal; 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; end; procedure TAnchorDockHeader.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if (Button=mbLeft) and DockMaster.AllowDragging then DragManager.DragStart(Parent,false,DockMaster.DragTreshold); end; procedure TAnchorDockHeader.UpdateHeaderControls; begin if Align in [alLeft,alRight] then begin if CloseButton<>nil then CloseButton.Align:=alTop; end else begin if CloseButton<>nil then CloseButton.Align:=alRight; end; //debugln(['TAnchorDockHeader.UpdateHeaderControls ',dbgs(Align),' ',dbgs(CloseButton.Align)]); end; procedure TAnchorDockHeader.SetAlign(Value: TAlign); begin if Value=Align then exit; DisableAutoSizing; inherited SetAlign(Value); UpdateHeaderControls; EnableAutoSizing; 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; FCloseButton:=TAnchorDockCloseButton.Create(Self); BevelOuter:=bvNone; BorderWidth:=0; with FCloseButton do begin Name:='CloseButton'; Parent:=Self; Flat:=true; ShowHint:=true; Hint:=adrsClose; OnClick:=@CloseButtonClick; AutoSize:=true; end; Align:=alTop; AutoSize:=true; ShowHint:=true; PopupMenu:=DockMaster.GetPopupMenu; end; { TAnchorDockCloseButton } function TAnchorDockCloseButton.GetDrawDetails: TThemedElementDetails; function WindowPart: TThemedWindow; begin // no check states available Result := twSmallCloseButtonNormal; if not IsEnabled then Result := twSmallCloseButtonDisabled else if FState in [bsDown, bsExclusive] then Result := twSmallCloseButtonPushed else if FState = bsHot then Result := twSmallCloseButtonHot else Result := twSmallCloseButtonNormal; end; begin Result := ThemeServices.GetElementDetails(WindowPart); end; procedure TAnchorDockCloseButton.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin with ThemeServices.GetDetailSize(ThemeServices.GetElementDetails(twSmallCloseButtonNormal)) do begin PreferredWidth:=cx+2; PreferredHeight:=cy+2; end; 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 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)]); Site.DisableAutoSizing; 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; SplitterWidth:=DockMaster.SplitterWidth; end; // 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); end; if not StoredConstraintsValid then StoreConstraints; if ADockObject.DropAlign in [alLeft,alRight] then Site.Constraints.MaxWidth:=0 else Site.Constraints.MaxHeight:=0; Site.BoundsRect:=NewSiteBounds; //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); end; Child.BoundsRect:=NewChildBounds; if ChildSite<>nil then ChildSite.PositionBoundSplitter; // only allow to dock one control DragManager.RegisterDockSite(Site,false); 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)]); finally Site.EnableAutoSizing; 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; 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; 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; 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; case DropAlign of alLeft: if Inside then DockRect:=Rect(0,0,Min(Client.Width,Site.ClientWidth div 2),Site.ClientHeight) else DockRect:=Rect(-Client.Width,0,0,Site.ClientHeight); alRight: if Inside then begin DockRect:=Rect(0,0,Min(Client.Width,Site.Width div 2),Site.ClientHeight); OffsetRect(DockRect,Site.ClientWidth-DockRect.Right,0); end else DockRect:=Bounds(Site.ClientWidth,0,Client.Width,Site.ClientHeight); alTop: if Inside then DockRect:=Rect(0,0,Site.ClientWidth,Min(Client.Height,Site.ClientHeight div 2)) else DockRect:=Rect(0,-Client.Height,Site.ClientWidth,0); alBottom: if Inside then begin DockRect:=Rect(0,0,Site.ClientWidth,Min(Client.Height,Site.ClientHeight div 2)); OffsetRect(DockRect,0,Site.ClientHeight-DockRect.Bottom); end else DockRect:=Bounds(0,Site.ClientHeight,Site.ClientWidth,Client.Height); alClient: begin // paged docking => show center if DockSite<>nil then DockRect:=DockSite.GetPageArea; end; else exit; // use default end; Offset:=Site.ClientOrigin; OffsetRect(DockRect,Offset.X,Offset.Y); end; procedure TAnchorDockManager.RemoveControl(Control: TControl); var NewBounds: TRect; ChildSite: TAnchorDockHostSite; SplitterWidth: Integer; begin if DockSite<>nil then debugln(['TAnchorDockManager.RemoveControl DockSite="',DockSite.Caption,'" Control=',DbgSName(Control)]) else begin debugln(['TAnchorDockManager.RemoveControl Site="',DbgSName(Site),'" Control=',DbgSName(Control)]); 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; debugln(['TAnchorDockManager.RemoveControl Site=',DbgSName(Site),' ',dbgs(Site.BoundsRect)]); // 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; debugln(['TAnchorDockManager.ResetBounds ChildMaxSize=',dbgs(ChildMaxSize),' SiteMinSize=',dbgs(SiteMinSize),' Site.Client=',dbgs(Site.ClientRect)]); end; case ResizePolicy of admrpChild: 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; 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; 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; begin //debugln(['TAnchorDockManager.GetDockEdge ',DbgSName(Site),' ',DbgSName(DockSite),' DockableSites=',dbgs(DockableSites)]); 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.TabIndexAtClientPos(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); // check inside if InsideDockingAllowed and ( ((ADockObject.DropAlign=alLeft) and (p.X>=0)) or ((ADockObject.DropAlign=alTop) and (p.Y>=0)) or ((ADockObject.DropAlign=alRight) and (p.X1 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(['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; initialization DockMaster:=TAnchorDockMaster.Create(nil); finalization FreeAndNil(DockMaster); end.