diff --git a/etc/anchordocking/README.txt b/etc/anchordocking/README.txt deleted file mode 100644 index ec680535..00000000 --- a/etc/anchordocking/README.txt +++ /dev/null @@ -1,8 +0,0 @@ -The package anchordocking.lpk implements a docking manager for LCL applications. -It handles drag and docking forms together via splitters and pages -(like a TPageControl). -It can save and restore layouts. - -More information can be found at -http://wiki.lazarus.freepascal.org/Anchor_Docking - diff --git a/etc/anchordocking/xanchordocking.pas b/etc/anchordocking/xanchordocking.pas deleted file mode 100644 index 41eb4148..00000000 --- a/etc/anchordocking/xanchordocking.pas +++ /dev/null @@ -1,6444 +0,0 @@ -{ 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: - - option to save on IDE close (if MainForm is visible on active screen) - - restore: put MainForm on active screen - - restore custom dock site splitter without resizing content, only resize docked site - - undock on hide - - popup menu - - shrink side left, top, right, bottom - - implement a simple way to make forms dockable at designtime without any code - - on show again (hide form, show form): restore layout - - close button for pages - - event for drawing grabbers+headers - - save/restore other splitters - - Parent bug with links to all other: - - http://bugs.freepascal.org/view.php?id=18298 default layout sometimes wrong main bar - Other bugs: - - http://bugs.freepascal.org/view.php?id=19810 multi monitor -} -unit xAnchorDocking; - -{$mode objfpc}{$H+} - -{ $DEFINE VerboseAnchorDockRestore} -{ $DEFINE VerboseADCustomSite} -{ $DEFINE VerboseAnchorDockPages} - -interface - -uses - Math, Classes, SysUtils, types, - LCLType, LCLIntf, LCLProc, - Controls, Forms, ExtCtrls, ComCtrls, Graphics, Themes, Menus, Buttons, - LazConfigStorage, Laz2_XMLCfg, LazFileCache, - xAnchorDockStr, xAnchorDockStorage; - -{$IFDEF DebugDisableAutoSizing} -const ADAutoSizingReason = 'TAnchorDockMaster Delayed'; -{$ENDIF} - -type - TAnchorDockHostSite = class; - - { TAnchorDockCloseButton - Close button used in TAnchorDockHeader, uses the close button glyph of the - theme shrinked to a small size. The glyph is shared by all close buttons. } - - TAnchorDockCloseButton = class(TCustomSpeedButton) - protected - function GetDrawDetails: TThemedElementDetails; override; - procedure CalculatePreferredSize(var PreferredWidth, - PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override; - 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 - FCustomWidth: Boolean; - FDockBounds: TRect; - FDockParentClientSize: TSize; - FDockRestoreBounds: TRect; - FPercentPosition: Single; - - procedure UpdatePercentPosition; - protected - procedure SetResizeAnchor(const AValue: TAnchorKind); override; - procedure PopupMenuPopup(Sender: TObject); virtual; - procedure Paint; override; - public - procedure MoveSplitter(Offset: integer); override; - public - constructor Create(TheOwner: TComponent); override; - property DockBounds: TRect read FDockBounds; - property DockParentClientSize: TSize read FDockParentClientSize; - procedure UpdateDockBounds; - procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; // any normal movement sets the DockBounds - procedure SetBoundsPercentually; - procedure SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer); // movement for scaling keeps the DockBounds - function SideAnchoredControlCount(Side: TAnchorKind): integer; - function HasAnchoredControls: boolean; - procedure SaveLayout(LayoutNode: TAnchorDockLayoutTreeNode); - function HasOnlyOneSibling(Side: TAnchorKind; MinPos, MaxPos: integer): TControl; - property DockRestoreBounds: TRect read FDockRestoreBounds write FDockRestoreBounds; - property CustomWidth: Boolean read FCustomWidth write FCustomWidth; - end; - TAnchorDockSplitterClass = class of TAnchorDockSplitter; - - TAnchorDockPageControl = class; - { TAnchorDockPage - A page of a TAnchorDockPageControl. } - - TAnchorDockPage = class(TCustomPage) - public - procedure UpdateDockCaption(Exclude: TControl = nil); override; - procedure InsertControl(AControl: TControl; Index: integer); override; - procedure RemoveControl(AControl: TControl); override; - function GetSite: TAnchorDockHostSite; - end; - TAnchorDockPageClass = class of TAnchorDockPage; - - { TAnchorDockPageControl - Used for page docking. - The parent is always a TAnchorDockHostSite with SiteType=adhstPages. - Its children are all TAnchorDockPage. - It shows the DockMaster popup menu and starts dragging. } - - TAnchorDockPageControl = class(TCustomTabControl) - private - function GetDockPages(Index: integer): TAnchorDockPage; - protected - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; - procedure PopupMenuPopup(Sender: TObject); virtual; - procedure CloseButtonClick(Sender: TObject); virtual; - procedure MoveLeftButtonClick(Sender: TObject); virtual; - procedure MoveLeftMostButtonClick(Sender: TObject); virtual; - procedure MoveRightButtonClick(Sender: TObject); virtual; - procedure MoveRightMostButtonClick(Sender: TObject); virtual; - procedure TabPositionClick(Sender: TObject); virtual; - 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 } - - 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; - procedure FreePages; virtual; - function DockSecondPage(NewControl: TControl): boolean; virtual; - function DockAnotherPage(NewControl: TControl; InFrontOf: TControl): boolean; virtual; - procedure AddCleanControl(AControl: TControl; TheAlign: TAlign = alNone); - procedure RemoveControlFromLayout(AControl: TControl); - procedure 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); overload; - procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload; - procedure SaveToConfig(Config: TConfigStorage); overload; - procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload; - function IsEqual(Settings: TAnchorDockSettings): boolean; reintroduce; - procedure Assign(Source: TAnchorDockSettings); - end; - - 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; // list of TControl, custom host sites and docked controls, not helper controls (e.g. TAnchorDock*) - 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; // TAnchorDockHostSite, TAnchorDockSplitter or custom docksite - 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; NewAlign: TAlign = alClient); - 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 FullRestoreLayout(Tree: TAnchorDockLayoutTree; Scale: Boolean): Boolean; - function ControlCount: integer; - property Controls[Index: integer]: TControl read GetControls; - function IndexOfControl(const aName: string): integer; - function FindControl(const aName: string): TControl; - function 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; - // layout information for restoring hidden forms - property RestoreLayouts: TAnchorDockRestoreLayouts read FRestoreLayouts - write FRestoreLayouts; - property Restoring: boolean read FRestoring write SetRestoring; - property IdleConnected: Boolean read FIdleConnected write SetIdleConnected; - procedure LoadSettingsFromConfig(Config: TConfigStorage); - procedure SaveSettingsToConfig(Config: TConfigStorage); - procedure LoadSettings(Settings: TAnchorDockSettings); - procedure SaveSettings(Settings: TAnchorDockSettings); - function SettingsAreEqual(Settings: TAnchorDockSettings): boolean; - procedure ResetSplitters; - - // manual docking - procedure ManualFloat(AControl: TControl); - procedure ManualDock(SrcSite: TAnchorDockHostSite; TargetSite: TCustomForm; - Align: TAlign; TargetControl: TControl = nil); - 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 DockedControlIsVisible(Control: TControl): boolean; -function GetDockSplitter(Control: TControl; Side: TAnchorKind; - out Splitter: TAnchorDockSplitter): boolean; -function GetDockSplitterOrParent(Control: TControl; Side: TAnchorKind; - out AnchorControl: TControl): boolean; -function CountAnchoredControls(Control: TControl; Side: TAnchorKind): Integer; -function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl; - Side: TAnchorKind): boolean; -function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind; - DestControl: TControl): boolean; -procedure GetAnchorControlsRect(Control: TControl; out ARect: TAnchorControlsRect); -function GetEnclosingControlRect(ControlList: TFPlist; - out ARect: TAnchorControlsRect): boolean; -function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList; - -implementation - -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{$IFDEF DebugDisableAutoSizing}('CopyAnchorBounds'){$ENDIF}; - try - Target.BoundsRect:=Source.BoundsRect; - Target.Anchors:=Source.Anchors; - Target.Align:=Source.Align; - for a:=low(TAnchorKind) to high(TAnchorKind) do - Target.AnchorSide[a].Assign(Source.AnchorSide[a]); - finally - Target.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('CopyAnchorBounds'){$ENDIF}; - end; -end; - -procedure AnchorAndChangeBounds(AControl: TControl; Side: TAnchorKind; - Target: TControl); -begin - if Target=AControl.Parent then begin - AControl.AnchorParallel(Side,0,Target); - case Side of - akTop: AControl.Top:=0; - akLeft: AControl.Left:=0; - akRight: AControl.Width:=AControl.Parent.ClientWidth-AControl.Left; - akBottom: AControl.Height:=AControl.Parent.ClientHeight-AControl.Top; - end; - end else begin - AControl.AnchorToNeighbour(Side,0,Target); - case Side of - akTop: AControl.Top:=Target.Top+Target.Height; - akLeft: AControl.Left:=Target.Left+Target.Width; - akRight: AControl.Width:=Target.Left-AControl.Width; - akBottom: AControl.Height:=Target.Top-AControl.Height; - end; - end; -end; - -function ControlsLeftTopOnScreen(AControl: TControl): TPoint; -begin - if AControl.Parent<>nil then begin - Result:=AControl.Parent.ClientOrigin; - inc(Result.X,AControl.Left); - inc(Result.Y,AControl.Top); - end else begin - Result:=AControl.Parent.ClientOrigin; - end; -end; - -function DockedControlIsVisible(Control: TControl): boolean; -begin - while Control<>nil do begin - if (not Control.IsControlVisible) - and (not (Control is TAnchorDockPage)) then - exit(false); - Control:=Control.Parent; - end; - Result:=true; -end; - -function GetDockSplitter(Control: TControl; Side: TAnchorKind; out - Splitter: TAnchorDockSplitter): boolean; -begin - Result:=false; - Splitter:=nil; - if not (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.Assign(Source: TAnchorDockSettings); -begin - FAllowDragging := Source.FAllowDragging; - FChangeStamp := Source.FChangeStamp; - FDockOutsideMargin := Source.FDockOutsideMargin; - FDockParentMargin := Source.FDockParentMargin; - FDragTreshold := Source.FDragTreshold; - FHeaderAlignLeft := Source.FHeaderAlignLeft; - FHeaderAlignTop := Source.FHeaderAlignTop; - FHeaderHint := Source.FHeaderHint; - FHeaderStyle := Source.FHeaderStyle; - FHeaderFlatten := Source.FHeaderFlatten; - FHeaderFilled := Source.FHeaderFilled; - FHideHeaderCaptionFloatingControl := Source.FHideHeaderCaptionFloatingControl; - FPageAreaInPercent := Source.FPageAreaInPercent; - FScaleOnResize := Source.FScaleOnResize; - FShowHeader := Source.FShowHeader; - FShowHeaderCaption := Source.FShowHeaderCaption; - FSplitterWidth := Source.FSplitterWidth; -end; - -procedure TAnchorDockSettings.IncreaseChangeStamp; -begin - LUIncreaseChangeStamp(fChangeStamp); -end; - -procedure TAnchorDockSettings.LoadFromConfig(Config: TConfigStorage); -begin - Config.AppendBasePath('Settings/'); - 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(Path: string; Config: TRttiXMLConfig - ); -begin - Config.SetDeleteValue(Path+'DragThreshold',DragTreshold,4); - Config.SetDeleteValue(Path+'DockOutsideMargin',DockOutsideMargin,10); - Config.SetDeleteValue(Path+'DockParentMargin',DockParentMargin,10); - Config.SetDeleteValue(Path+'PageAreaInPercent',PageAreaInPercent,40); - Config.SetDeleteValue(Path+'HeaderAlignTop',HeaderAlignTop,80); - Config.SetDeleteValue(Path+'HeaderAlignLeft',HeaderAlignLeft,120); - Config.SetDeleteValue(Path+'SplitterWidth',SplitterWidth,4); - Config.SetDeleteValue(Path+'ScaleOnResize',ScaleOnResize,true); - Config.SetDeleteValue(Path+'ShowHeader',ShowHeader,true); - Config.SetDeleteValue(Path+'ShowHeaderCaption',ShowHeaderCaption,true); - Config.SetDeleteValue(Path+'HideHeaderCaptionFloatingControl',HideHeaderCaptionFloatingControl,true); - Config.SetDeleteValue(Path+'AllowDragging',AllowDragging,true); - Config.SetDeleteValue(Path+'HeaderStyle',ADHeaderStyleNames[HeaderStyle],ADHeaderStyleNames[adhsDefault]); - Config.SetDeleteValue(Path+'HeaderFlatten',HeaderFlatten,true); - Config.SetDeleteValue(Path+'HeaderFilled',HeaderFilled,true); -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; - -procedure TAnchorDockSettings.LoadFromConfig(Path: string; - Config: TRttiXMLConfig); -begin - DragTreshold:=Config.GetValue(Path+'DragThreshold',4); - DockOutsideMargin:=Config.GetValue(Path+'DockOutsideMargin',10); - DockParentMargin:=Config.GetValue(Path+'DockParentMargin',10); - PageAreaInPercent:=Config.GetValue(Path+'PageAreaInPercent',40); - HeaderAlignTop:=Config.GetValue(Path+'HeaderAlignTop',80); - HeaderAlignLeft:=Config.GetValue(Path+'HeaderAlignLeft',120); - SplitterWidth:=Config.GetValue(Path+'SplitterWidth',4); - ScaleOnResize:=Config.GetValue(Path+'ScaleOnResize',true); - ShowHeader:=Config.GetValue(Path+'ShowHeader',true); - ShowHeaderCaption:=Config.GetValue(Path+'ShowHeaderCaption',true); - HideHeaderCaptionFloatingControl:=Config.GetValue(Path+'HideHeaderCaptionFloatingControl',true); - AllowDragging:=Config.GetValue(Path+'AllowDragging',true); - HeaderStyle:=StrToADHeaderStyle(Config.GetValue(Path+'HeaderStyle',ADHeaderStyleNames[adhsDefault])); - HeaderFlatten:=Config.GetValue(Path+'HeaderFlatten',true); - HeaderFilled:=Config.GetValue(Path+'HeaderFilled',true); -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 DockedControlIsVisible(AControl) - 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 - if AControl.HostDockSite <> nil then - begin - 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; - 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']); - if DisableAutoSizing then - DisableControlAutoSizing(AControl); - end else begin - //debugln(['CreateControlsForNode ',Node.Name,' needs creation']); - AControl:=DoCreateControl(Node.Name,true); - if AControl<>nil then begin - try - if DisableAutoSizing and (fDisabledAutosizing.IndexOf(AControl)<0) - then begin - fDisabledAutosizing.Add(AControl); - AControl.FreeNotification(Self); - end; - if Node.NodeType=adltnControl then - MakeDockable(AControl,false) - else if not IsCustomSite(AControl) then - raise EAnchorDockLayoutError.Create('not a docksite: '+DbgSName(AControl)); - finally - if not DisableAutoSizing then - AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; - end; - end else begin - debugln(['CreateControlsForNode ',Node.Name,' failed to create']); - end; - end; - if AControl<>nil then - ControlNames.Add(AControl.Name); - end; - for i:=0 to Node.Count-1 do - CreateControlsForNode(Node[i]); - end; - -begin - Result:=false; - CreateControlsForNode(Tree.Root); - Result:=true; -end; - -procedure TAnchorDockMaster.MapTreeToControls(Tree: TAnchorDockLayoutTree); - - procedure MapHostDockSites(Node: TAnchorDockLayoutTreeNode); - // map in TreeNameToDocker each control name to its HostDockSite or custom dock site - var - i: Integer; - AControl: TControl; - begin - if Node.IsSplitter then exit; - if (Node.NodeType=adltnControl) then begin - AControl:=FindControl(Node.Name); - if (AControl<>nil) and (AControl.HostDockSite is TAnchorDockHostSite) then - fTreeNameToDocker[Node.Name]:=AControl.HostDockSite; - // ignore kids - exit; - end; - if (Node.NodeType=adltnCustomSite) then begin - AControl:=FindControl(Node.Name); - if IsCustomSite(AControl) then - fTreeNameToDocker[Node.Name]:=AControl; - end; - for i:=0 to Node.Count-1 do - MapHostDockSites(Node[i]); // recursive - end; - - procedure MapTopLevelSites(Node: TAnchorDockLayoutTreeNode); - // map in TreeNameToDocker each RootWindow node name to a site with a - // corresponding control - // For example: if there is control on a complex site (SiteA), and the control - // has a node in the Tree, then the root node of the tree node is mapped to - // the SiteA. This way the corresponding root forms are kept which reduces - // flickering. - - function FindMappedControl(ChildNode: TAnchorDockLayoutTreeNode - ): TCustomForm; - var - i: Integer; - begin - if ChildNode.NodeType in [adltnControl,adltnCustomSite] then - Result:=TCustomForm(fTreeNameToDocker[ChildNode.Name]) - else - for i:=0 to ChildNode.Count-1 do begin - Result:=FindMappedControl(ChildNode[i]); // search recursive - if Result<>nil then exit; - end; - end; - - var - i: Integer; - RootSite: TCustomForm; - Site: TCustomForm; - begin - if Node.IsSplitter then exit; - if Node.IsRootWindow then begin - if Node.Name='' then exit; - if Node.NodeType=adltnControl then exit; - // Node is a complex site - if fTreeNameToDocker[Node.Name]<>nil then exit; - // and not yet mapped to a site - Site:=FindMappedControl(Node); - if Site=nil then exit; - // and there is sub node mapped to a site (anchor or custom) - RootSite:=GetParentForm(Site); - if not (RootSite is TAnchorDockHostSite) then exit; - // and the mapped site has a root site - if fTreeNameToDocker.ControlToName(RootSite)<>'' then exit; - // and the root site is not yet mapped - // => map the root node to the root site - fTreeNameToDocker[Node.Name]:=RootSite; - end else - for i:=0 to Node.Count-1 do - MapTopLevelSites(Node[i]); // recursive - end; - - procedure MapBottomUp(Node: TAnchorDockLayoutTreeNode); - { map the other nodes to existing sites - The heuristic works like this: - if a child node was mapped to a site and the site has a parent site then - map this node to this parent site. - } - var - i: Integer; - BestSite: TControl; - begin - if Node.IsSplitter then exit; - BestSite:=fTreeNameToDocker[Node.Name]; - for i:=0 to Node.Count-1 do begin - MapBottomUp(Node[i]); // recursive - if BestSite=nil then - BestSite:=fTreeNameToDocker[Node[i].Name]; - end; - if (fTreeNameToDocker[Node.Name]=nil) and (BestSite<>nil) then begin - // search the parent site of a child site - repeat - BestSite:=BestSite.Parent; - if BestSite is TAnchorDockHostSite then begin - if fTreeNameToDocker.ControlToName(BestSite)='' then - fTreeNameToDocker[Node.Name]:=BestSite; - break; - end; - until (BestSite=nil); - end; - end; - - procedure MapSplitters(Node: TAnchorDockLayoutTreeNode); - { map the splitter nodes to existing splitters - The heuristic works like this: - If a node is mapped to a site and the node is at Side anchored to a - splitter node and the site is anchored at Side to a splitter - then map the splitter node to the splitter. - } - var - i: Integer; - Side: TAnchorKind; - Site: TControl; - SplitterNode: TAnchorDockLayoutTreeNode; - Splitter: TControl; - begin - if Node.IsSplitter then exit; - for i:=0 to Node.Count-1 do - MapSplitters(Node[i]); // recursive - - if Node.Parent=nil then exit; - // node is a child node - Site:=fTreeNameToDocker[Node.Name]; - if Site=nil then exit; - // node is mapped to a site - // check each side - for Side:=Low(TAnchorKind) to high(TAnchorKind) do begin - if Node.Anchors[Side]='' then continue; - Splitter:=Site.AnchorSide[Side].Control; - if (not (Splitter is TAnchorDockSplitter)) - or (Splitter.Parent<>Site.Parent) then continue; - SplitterNode:=Node.Parent.FindChildNode(Node.Anchors[Side],false); - if (SplitterNode=nil) then continue; - // this Side of node is anchored to a splitter node - if fTreeNameToDocker[SplitterNode.Name]<>nil then continue; - // the SplitterNode is not yet mapped - if fTreeNameToDocker.ControlToName(Splitter)<>'' then continue; - // there is an unmapped splitter anchored to the Site - // => map the splitter to the splitter node - // Note: Splitter.Name can be different from SplitterNode.Name ! - fTreeNameToDocker[SplitterNode.Name]:=Splitter; - end; - end; - -begin - MapHostDockSites(Tree.Root); - MapTopLevelSites(Tree.Root); - MapBottomUp(Tree.Root); - MapSplitters(Tree.Root); -end; - -function TAnchorDockMaster.RestoreLayout(Tree: TAnchorDockLayoutTree; - Scale: boolean): boolean; -var - WorkArea, SrcWorkArea: TRect; - - function SrcRectValid(const r: TRect): boolean; - begin - Result:=(r.Left=0) and (Node.Monitor 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); - 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); - Result:=AControl; - // restore docked site - if Node.Count>0 then begin - Restore(Node[0],TCustomForm(AControl)); - 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(SrcWorkArea) then - NewBounds:=Rect(ScaleChildX(NewBounds.Left),ScaleChildY(NewBounds.Top), - ScaleChildX(NewBounds.Right),ScaleChildY(NewBounds.Bottom)); - Splitter.DockRestoreBounds:=NewBounds; - Splitter.BoundsRect:=NewBounds; - if Node.NodeType=adltnSplitterVertical then begin - Splitter.ResizeAnchor:=akLeft; - Splitter.AnchorSide[akLeft].Control:=nil; - Splitter.AnchorSide[akRight].Control:=nil; - end else begin - Splitter.ResizeAnchor:=akTop; - Splitter.AnchorSide[akTop].Control:=nil; - Splitter.AnchorSide[akBottom].Control:=nil; - end; - Result:=Splitter; - end else if Node.NodeType=adltnLayout then begin - // restore layout - Site:=GetNodeSite(Node); - {$IFDEF VerboseAnchorDockRestore} - debugln(['TAnchorDockMaster.RestoreLayout.Restore Layout Node.Name=',Node.Name,' ChildCount=',Node.Count]); - {$ENDIF} - Site.BeginUpdateLayout; - try - SetupSite(Site,Node,Parent); - Site.FSiteType:=adhstLayout; - Site.Header.Parent:=nil; - // create children - for i:=0 to Node.Count-1 do - Restore(Node[i],Site); - // 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 begin - AnchorControl:=fTreeNameToDocker[ChildNode.Anchors[Side]]; - if AnchorControl=nil then - debugln(['WARNING: TAnchorDockMaster.RestoreLayout.Restore: Node=',ChildNode.Name,' Anchor[',dbgs(Side),']=',ChildNode.Anchors[Side],' not found']); - end; - if AnchorControl<>nil then - AControl.AnchorToNeighbour(Side,0,AnchorControl) - else - AControl.AnchorParallel(Side,0,Site); - end; - end; - // free unneeded helper controls (e.g. splitters) - for i:=Site.ControlCount-1 downto 0 do begin - AControl:=Site.Controls[i]; - if fTreeNameToDocker.ControlToName(AControl)<>'' then continue; - if AControl is TAnchorDockSplitter then begin - AControl.Free; - end; - end; - finally - Site.EndUpdateLayout; - end; - Result:=Site; - end else if Node.NodeType=adltnPages then begin - // restore pages - Site:=GetNodeSite(Node); - {$IFDEF VerboseAnchorDockRestore} - debugln(['TAnchorDockMaster.RestoreLayout.Restore Pages Node.Name=',Node.Name,' ChildCount=',Node.Count]); - {$ENDIF} - Site.BeginUpdateLayout; - j:=0; - try - SetupSite(Site,Node,Parent); - Site.FSiteType:=adhstPages; - Site.Header.Parent:=nil; - if Site.Pages=nil then - Site.CreatePages; - for i:=0 to Node.Count-1 do begin - aPageName:=Node[i].Name; - if j>=Site.Pages.PageCount then - Site.Pages.Pages.Add(aPageName); - aPage:=Site.Pages.Page[j]; - inc(j); - AControl:=Restore(Node[i],aPage); - if AControl=nil then continue; - AControl.Align:=alClient; - for Side:=Low(TAnchorKind) to high(TAnchorKind) do - AControl.AnchorSide[Side].Control:=nil; - end; - finally - while Site.Pages.PageCount>j do - Site.Pages.Page[Site.Pages.PageCount-1].Free; - Site.SimplifyPages; - Site.EndUpdateLayout; - end; - Result:=Site; - end else begin - // create children - for i:=0 to Node.Count-1 do - Restore(Node[i],Parent); - end; - end; - -begin - Result:=true; - WorkArea:=Rect(0,0,0,0); - SrcWorkArea:=WorkArea; - Restore(Tree.Root,nil); - 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{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; -end; - -procedure TAnchorDockMaster.EnableAllAutoSizing; -var - i: Integer; - AControl: TControl; -begin - i:=fDisabledAutosizing.Count-1; - while (i>=0) do begin - AControl:=TControl(fDisabledAutosizing[i]); - //debugln(['TAnchorDockMaster.EnableAllAutoSizing ',DbgSName(AControl)]); - fDisabledAutosizing.Delete(i); - AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; - i:=Min(i,fDisabledAutosizing.Count)-1; - end; -end; - -procedure TAnchorDockMaster.ClearLayoutProperties(AControl: TControl; - NewAlign: TAlign); -var - a: TAnchorKind; -begin - AControl.AutoSize:=false; - AControl.Align:=NewAlign; - AControl.BorderSpacing.Around:=0; - AControl.BorderSpacing.Left:=0; - AControl.BorderSpacing.Top:=0; - AControl.BorderSpacing.Right:=0; - AControl.BorderSpacing.Bottom:=0; - AControl.BorderSpacing.InnerBorder:=0; - for a:=Low(TAnchorKind) to High(TAnchorKind) do - AControl.AnchorSide[a].Control:=nil; -end; - -procedure TAnchorDockMaster.PopupMenuPopup(Sender: TObject); -var - Popup: TPopupMenu; - ChangeLockItem: TMenuItem; - ShowHeadersItem: TMenuItem; -begin - if not (Sender is TPopupMenu) then exit; - Popup:=TPopupMenu(Sender); - Popup.Items.Clear; - - // top popup menu item can be clicked by accident, so use something simple: - // lock/unlock - ChangeLockItem:=AddPopupMenuItem('AnchorDockMasterChangeLockMenuItem', - adrsLocked,@ChangeLockButtonClick); - ChangeLockItem.Checked:=not AllowDragging; - ChangeLockItem.ShowAlwaysCheckable:=true; - - if Popup.PopupComponent is TAnchorDockHeader then - TAnchorDockHeader(Popup.PopupComponent).PopupMenuPopup(Sender) - else if Popup.PopupComponent is TAnchorDockPageControl then - TAnchorDockPageControl(Popup.PopupComponent).PopupMenuPopup(Sender) - else if Popup.PopupComponent is TAnchorDockSplitter then - TAnchorDockSplitter(Popup.PopupComponent).PopupMenuPopup(Sender); - - if ShowMenuItemShowHeader or (not ShowHeader) then begin - ShowHeadersItem:=AddPopupMenuItem('AnchorDockMasterShowHeaderMenuItem', - adrsShowHeaders, @ShowHeadersButtonClick); - ShowHeadersItem.Checked:=ShowHeader; - ShowHeadersItem.ShowAlwaysCheckable:=true; - end; - - if Assigned(OnShowOptions) then - AddPopupMenuItem('OptionsMenuItem', adrsDockingOptions, @OptionsClick); -end; - -procedure TAnchorDockMaster.ResetSplitters; -var - I: Integer; - S: TAnchorDockSplitter; -begin - for I := 0 to ComponentCount-1 do - if Components[I] is TAnchorDockSplitter then - begin - S := TAnchorDockSplitter(Components[I]); - S.UpdateDockBounds; - S.UpdatePercentPosition; - end; -end; - -function TAnchorDockMaster.FullRestoreLayout(Tree: TAnchorDockLayoutTree; - Scale: Boolean): Boolean; -var - ControlNames: TStringList; -begin - Result:=false; - ControlNames:=TStringList.Create; - fTreeNameToDocker:=TADNameToControl.Create; - try - // close all unneeded forms/controls (not helper controls like splitters) - if not CloseUnneededControls(Tree) then exit; - - BeginUpdate; - try - // create all needed forms/controls (not helper controls like splitters) - if not CreateNeededControls(Tree,true,ControlNames) then exit; - - // simplify layouts - ControlNames.Sort; - {$IFDEF VerboseAnchorDockRestore} - debugln(['TAnchorDockMaster.LoadLayoutFromConfig controls: ']); - debugln(ControlNames.Text); - {$ENDIF} - // if some forms/controls could not be created the layout needs to be adapted - Tree.Root.Simplify(ControlNames); - - // reuse existing sites to reduce flickering - MapTreeToControls(Tree); - {$IFDEF VerboseAnchorDockRestore} - fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.LoadLayoutFromConfig Map'); - {$ENDIF} - - // create sites, move controls - RestoreLayout(Tree,Scale); - finally - EndUpdate; - end; - finally - // clean up - FreeAndNil(fTreeNameToDocker); - ControlNames.Free; - // commit (this can raise an exception, when it triggers events) - EnableAllAutoSizing; - end; - ResetSplitters; // reset splitters' DockBounds after EnableAllAutoSizing. fixes issue #18538 - {$IFDEF VerboseAnchorDockRestore} - DebugWriteChildAnchors(Application.MainForm,true,false); - {$ENDIF} - Result:=true; -end; - -procedure TAnchorDockMaster.SetHideHeaderCaptionFloatingControl( - const AValue: boolean); -var - Site: TAnchorDockHostSite; - i: Integer; -begin - if AValue=HideHeaderCaptionFloatingControl then exit; - fHideHeaderCaptionFloatingControl:=AValue; - for i:=0 to ComponentCount-1 do begin - Site:=TAnchorDockHostSite(Components[i]); - if not (Site is TAnchorDockHostSite) then continue; - Site.UpdateDockCaption; - end; - OptionsChanged; -end; - -procedure TAnchorDockMaster.SetSplitterWidth(const AValue: integer); -var - i: Integer; - Splitter: TAnchorDockSplitter; -begin - if (AValue<1) or (AValue=SplitterWidth) then exit; - FSplitterWidth:=AValue; - for i:=0 to ComponentCount-1 do begin - Splitter:=TAnchorDockSplitter(Components[i]); - if not (Splitter is TAnchorDockSplitter) then continue; - if not Splitter.CustomWidth then - begin - if Splitter.ResizeAnchor in [akLeft,akRight] then - Splitter.Width:=SplitterWidth - else - Splitter.Height:=SplitterWidth; - end; - end; - OptionsChanged; -end; - -procedure TAnchorDockMaster.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; - {$IFDEF VerboseAnchorDocking} - i: Integer; - {$ENDIF} -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); - {$IFDEF VerboseAnchorDocking} - for i:=0 to ComponentCount-1 do begin - debugln(['TAnchorDockMaster.Destroy ',i,'/',ComponentCount,' ',DbgSName(Components[i])]); - end; - {$ENDIF} - 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{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.DisableControlAutoSizing'){$ENDIF}; - try - if AControl is TAnchorDockHostSite then begin - // already a site - Site:=TAnchorDockHostSite(AControl); - end else if AControl.Parent=nil then begin - - if FControls.IndexOf(AControl)<0 then begin - FControls.Add(AControl); - AControl.FreeNotification(Self); - end; - - // create docksite - Site:=CreateSite; - try - try - Site.BoundsRect:=AControl.BoundsRect; - ClearLayoutProperties(AControl); - // dock - AControl.ManualDock(Site); - AControl.Visible:=true; - if not AddDockHeader then - Site.Header.Parent:=nil; - except - FreeAndNil(Site); - raise; - end; - finally - if Site<>nil then - Site.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; - end; - end else if AControl.Parent is TAnchorDockHostSite then begin - // AControl is already docked => show site - Site:=TAnchorDockHostSite(AControl.Parent); - AControl.Visible:=true; - end else begin - raise Exception.Create('TAnchorDockMaster.MakeDockable '+Format( - adrsNotSupportedHasParent, [DbgSName(AControl), DbgSName(AControl)])); - end; - if (Site<>nil) and Show then - MakeVisible(Site,BringToFront); - finally - AControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.DisableControlAutoSizing'){$ENDIF}; - end; - // BringToFront - if Show and BringToFront and (Site<>nil) then begin - GetParentForm(Site).BringToFront; - Site.SetFocus; - end; -end; - -procedure TAnchorDockMaster.MakeDockSite(AForm: TCustomForm; Sites: TAnchors; - ResizePolicy: TADMResizePolicy; AllowInside: boolean); -var - AManager: TAnchorDockManager; -begin - if AForm.Name='' then - raise Exception.Create('TAnchorDockMaster.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{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockSite'){$ENDIF}; - try - if FControls.IndexOf(AForm)<0 then begin - FControls.Add(AForm); - AForm.FreeNotification(Self); - end; - AManager:=ManagerClass.Create(AForm); - AManager.DockableSites:=Sites; - AManager.InsideDockingAllowed:=AllowInside; - AManager.ResizePolicy:=ResizePolicy; - AForm.DockManager:=AManager; - AForm.UseDockManager:=true; - AForm.DockSite:=true; - finally - AForm.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.MakeDockSite'){$ENDIF}; - end; -end; - -procedure TAnchorDockMaster.MakeVisible(AControl: TControl; SwitchPages: boolean); -begin - while AControl<>nil do begin - AControl.Visible:=true; - if SwitchPages and (AControl is TAnchorDockPage) then - TAnchorDockPageControl(AControl.Parent).PageIndex:= - TAnchorDockPage(AControl).PageIndex; - AControl:=AControl.Parent; - end; -end; - -function TAnchorDockMaster.ShowControl(ControlName: string; - BringToFront: boolean): TControl; -begin - Result:=DoCreateControl(ControlName,false); - if Result=nil then exit; - MakeDockable(Result,true,BringToFront); -end; - -procedure TAnchorDockMaster.CloseAll; -var - i: Integer; - AForm: TCustomForm; - AControl: TWinControl; -begin - // 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.SaveLayoutToConfig(Config: TConfigStorage); -var - Tree: TAnchorDockLayoutTree; -begin - Tree:=TAnchorDockLayoutTree.Create; - try - Config.AppendBasePath('MainConfig/'); - SaveMainLayoutToTree(Tree); - Tree.SaveToConfig(Config); - Config.UndoAppendBasePath; - Config.AppendBasePath('Restores/'); - RestoreLayouts.SaveToConfig(Config); - Config.UndoAppendBasePath; - {$IFDEF VerboseAnchorDocking} - WriteDebugLayout('TAnchorDockMaster.SaveLayoutToConfig ',Tree.Root); - {$ENDIF} - //DebugWriteChildAnchors(Tree.Root); - finally - Tree.Free; - end; -end; - -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 DockedControlIsVisible(AControl) 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; - -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 (not helper controls like splitters) - if not CloseUnneededControls(Tree) then exit; - - BeginUpdate; - try - // create all needed forms/controls (not helper controls like splitters) - if not CreateNeededControls(Tree,true,ControlNames) then exit; - - // simplify layouts - ControlNames.Sort; - {$IFDEF VerboseAnchorDockRestore} - debugln(['TAnchorDockMaster.LoadLayoutFromConfig controls: ']); - debugln(ControlNames.Text); - {$ENDIF} - // if some forms/controls could not be created the layout needs to be adapted - Tree.Root.Simplify(ControlNames); - - // reuse existing sites to reduce flickering - MapTreeToControls(Tree); - {$IFDEF VerboseAnchorDockRestore} - fTreeNameToDocker.WriteDebugReport('TAnchorDockMaster.LoadLayoutFromConfig Map'); - {$ENDIF} - - // create sites, move controls - 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{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; - AControl.Parent:=nil; - AControl.Visible:=false; -end; - -procedure TAnchorDockMaster.SimplifyPendingLayouts; -var - AControl: TControl; - Changed: Boolean; - i: Integer; -begin - if fSimplifying or (fUpdateCount>0) then exit; - fSimplifying:=true; - try - // simplify layout (do not free controls in this step, only mark them) - repeat - Changed:=false; - i:=fNeedSimplify.Count-1; - while i>=0 do begin - AControl:=TControl(fNeedSimplify[i]); - if (csDestroying in AControl.ComponentState) - or (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 - for i := fNeedFree.Count - 1 downto 0 do - if not (csDestroying in TControl(fNeedFree[i]).ComponentState) then - TControl(fNeedFree[i]).Free; - fNeedFree.Clear; - finally - fSimplifying:=false; - end; -end; - -function TAnchorDockMaster.AutoFreedIfControlIsRemoved(AControl, - RemovedControl: TControl): boolean; -{ returns true if the simplification algorithm will automatically free - AControl when RemovedControl is removed - Some sites are dummy sites that were autocreated. They will be auto freed - if not needed anymore. - 1. A TAnchorDockPage has a TAnchorDockHostSite as child. If the child is freed - the page will be freed. - 2. When a TAnchorDockPageControl has only one page left the content is moved - up and the pagecontrol and page will be freed. - 3. When a adhstLayout site has only one child site left, the content is moved up - and the child site will be freed. - 4. When the control of a adhstOneControl site is freed the site will be freed. -} -var - ParentSite: TAnchorDockHostSite; - Page: TAnchorDockPage; - PageControl: TAnchorDockPageControl; - OtherPage: TAnchorDockPage; - Site, Site1, Site2: TAnchorDockHostSite; -begin - Result:=false; - if (RemovedControl=nil) or (AControl=nil) then exit; - while RemovedControl<>nil do begin - if RemovedControl=AControl then exit(true); - if RemovedControl is TAnchorDockPage then begin - // a page will be removed - Page:=TAnchorDockPage(RemovedControl); - if not (Page.Parent is TAnchorDockPageControl) then exit; - PageControl:=TAnchorDockPageControl(Page.Parent); - if PageControl.PageCount>2 then exit; - if PageControl.PageCount=2 then begin - // this pagecontrol will be replaced by the content of the other page - if PageControl=AControl then exit(true); - if PageControl.Page[0]=Page then - OtherPage:=PageControl.DockPages[1] - else - OtherPage:=PageControl.DockPages[0]; - // the other page will be removed (its content will be moved up) - if OtherPage=AControl then exit(true); - if (OtherPage.ControlCount>0) then begin - if (OtherPage.Controls[0] is TAnchorDockHostSite) - and (OtherPage.Controls[0]=RemovedControl) then - exit(true); // the site of the other page will be removed (its content moved up) - end; - exit; - end; - // the last page of the pagecontrol is freed => the pagecontrol will be removed too - end else if RemovedControl is TAnchorDockPageControl then begin - // the pagecontrol will be removed - if not (RemovedControl.Parent is TAnchorDockHostSite) then exit; - // a pagecontrol is always the only child of a site - // => the site will be removed too - end else if RemovedControl is TAnchorDockHostSite then begin - // a site will be removed - Site:=TAnchorDockHostSite(RemovedControl); - if Site.Parent is TAnchorDockPage then begin - // a page has only one site - // => the page will be removed too - end else if Site.Parent is TAnchorDockHostSite then begin - ParentSite:=TAnchorDockHostSite(Site.Parent); - if (ParentSite.SiteType=adhstOneControl) - or ParentSite.IsOneSiteLayout(Site) then begin - // the control of a OneControl site is removed => the ParentSite is freed too - end else if ParentSite.SiteType=adhstLayout then begin - if ParentSite.IsTwoSiteLayout(Site1,Site2) then begin - // when there are two sites and one of them is removed - // the content of the other will be moved up and then both sites are - // removed - if (Site1=AControl) or (Site2=AControl) then - exit(true); - end; - exit; // removing only site will not free the layout - end else begin - raise Exception.Create('TAnchorDockMaster.AutoFreedIfControlIsRemoved ParentSiteType='+dbgs(ParentSite.SiteType)+' ChildSiteType='+dbgs(Site.SiteType)); - end; - end else - exit; // other classes will never be auto freed - end else begin - // control is not a site => check if control is in a OneControl site - if not (RemovedControl.Parent is TAnchorDockHostSite) then exit; - ParentSite:=TAnchorDockHostSite(RemovedControl.Parent); - if (ParentSite.SiteType<>adhstOneControl) then exit; - if ParentSite.GetOneControl<>RemovedControl then exit; - // the control of a OneControl site is removed => the site is freed too - end; - RemovedControl:=RemovedControl.Parent; - end; -end; - -function TAnchorDockMaster.CreateSite(NamePrefix: string; - DisableAutoSizing: boolean): TAnchorDockHostSite; -var - i: Integer; - NewName: String; -begin - Result:=TAnchorDockHostSite(SiteClass.NewInstance); - {$IFDEF DebugDisableAutoSizing} - if DisableAutoSizing then - Result.DisableAutoSizing(ADAutoSizingReason) - else - Result.DisableAutoSizing('TAnchorDockMaster.CreateSite'); - {$ELSE} - Result.DisableAutoSizing; - {$ENDIF}; - try - Result.CreateNew(Self,1); - i:=0; - repeat - inc(i); - NewName:=NamePrefix+AnchorDockSiteName+IntToStr(i); - until (Screen.FindForm(NewName)=nil) and (FindComponent(NewName)=nil); - Result.Name:=NewName; - finally - if not DisableAutoSizing then - Result.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster.CreateSite'){$ENDIF}; - end; -end; - -function TAnchorDockMaster.CreateSplitter(NamePrefix: string - ): TAnchorDockSplitter; -var - i: Integer; - NewName: String; -begin - Result:=SplitterClass.Create(Self); - i:=0; - repeat - inc(i); - NewName:=NamePrefix+AnchorDockSplitterName+IntToStr(i); - until FindComponent(NewName)=nil; - Result.Name:=NewName; -end; - -procedure TAnchorDockMaster.IncreaseOptionsChangeStamp; -begin - LUIncreaseChangeStamp64(FOptionsChangeStamp); -end; - -{ 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{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock HostSite'){$ENDIF}; - try - BeginUpdateLayout; - try - DockMaster.SimplifyPendingLayouts; - NewControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock NewControl'){$ENDIF}; - - if (NewControl.Parent=Self) and (SiteType=adhstLayout) then begin - // change of layout, one child is docked to the outer side - RemoveControlFromLayout(NewControl); - end else if (NewControl.Parent=Parent) and (Parent is TAnchorDockHostSite) - and (TAnchorDockHostSite(Parent).SiteType=adhstLayout) then begin - // change of layout, one sibling is moved - TAnchorDockHostSite(Parent).RemoveControlFromLayout(NewControl); - end; - - if SiteType=adhstNone then begin - // make a control dockable by docking it into a TAnchorDockHostSite; - Result:=DockFirstControl(NewControl); - end else if DockAlign=alClient then begin - // page docking - if SiteType=adhstOneControl then begin - if Parent is TAnchorDockPage then begin - // add as sibling page - Result:=(Parent.Parent.Parent as TAnchorDockHostSite).DockAnotherPage(NewControl,nil); - end else - // create pages - Result:=DockSecondPage(NewControl); - end else if SiteType=adhstPages then - // add as sibling page - Result:=DockAnotherPage(NewControl,DropOnControl); - end else if DockAlign in [alLeft,alTop,alRight,alBottom] then - begin - // anchor docking - if SiteType=adhstOneControl then begin - if Parent is TAnchorDockHostSite then begin - // add site as sibling - Result:=TAnchorDockHostSite(Parent).DockAnotherControl(Self,NewControl, - DockAlign,DropOnControl<>nil); - end else - // create layout - Result:=DockSecondControl(NewControl,DockAlign,DropOnControl<>nil); - end else if SiteType=adhstLayout then - // add site as sibling - Result:=DockAnotherControl(nil,NewControl,DockAlign,DropOnControl<>nil); - end; - - NewControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock NewControl'){$ENDIF}; - finally - EndUpdateLayout; - end; - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.ExecuteDock HostSite'){$ENDIF}; - end; -end; - -function TAnchorDockHostSite.DockFirstControl(NewControl: TControl): boolean; -var - DestRect: TRect; -begin - if SiteType<>adhstNone then - RaiseGDBException('TAnchorDockHostSite.DockFirstControl inconsistency'); - // create adhstOneControl - DestRect := ClientRect; - NewControl.Dock(Self, DestRect); - FSiteType:=adhstOneControl; - if NewControl is TCustomForm then begin - Icon.Assign(TCustomForm(NewControl).Icon); - end; - Result:=true; -end; - -function TAnchorDockHostSite.DockSecondControl(NewControl: TControl; - DockAlign: TAlign; Inside: boolean): boolean; -{ Convert a adhstOneControl into a adhstLayout by docking NewControl - at a side (DockAlign). - If Inside=true this DockSite is not expanded and both controls share the old space. - If Inside=false this DockSite is expanded. -} -var - OldSite: TAnchorDockHostSite; - OldControl: TControl; -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 - if FPages<>nil then - RaiseGDBException(''); - FPages:=DockMaster.PageControlClass.Create(nil); // do not own it, pages can be moved to another site - FPages.FreeNotification(Self); - FPages.Parent:=Self; - FPages.Align:=alClient; -end; - -procedure TAnchorDockHostSite.FreePages; -begin - FreeAndNil(FPages); -end; - -function TAnchorDockHostSite.DockSecondPage(NewControl: TControl): boolean; -var - OldControl: TControl; - OldSite: TAnchorDockHostSite; -begin - {$IFDEF VerboseAnchorDockPages} - debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" AControl=',DbgSName(NewControl)]); - {$ENDIF} - if SiteType<>adhstOneControl then - RaiseGDBException('TAnchorDockHostSite.DockSecondPage inconsistency'); - - FSiteType:=adhstPages; - CreatePages; - - // remove header (keep it for later use) - {$IFDEF VerboseAnchorDockPages} - debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" removing header ...']); - {$ENDIF} - Header.Parent:=nil; - - // put the OldControl into a page of its own - {$IFDEF VerboseAnchorDockPages} - debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" move oldcontrol to site of its own ...']); - {$ENDIF} - OldControl:=GetOneControl; - OldSite:=MakeSite(OldControl); - OldSite.HostDockSite:=nil; - {$IFDEF VerboseAnchorDockPages} - debugln(['TAnchorDockHostSite.DockSecondPage Self="',Caption,'" adding oldcontrol site ...']); - {$ENDIF} - FPages.Pages.Add(OldSite.Caption); - OldSite.Parent:=FPages.Page[0]; - OldSite.Align:=alClient; - OldSite.Visible:=true; - - Result:=DockAnotherPage(NewControl,nil); -end; - -function TAnchorDockHostSite.DockAnotherPage(NewControl: TControl; - InFrontOf: TControl): boolean; -var - NewSite: TAnchorDockHostSite; - NewIndex: LongInt; -begin - {$IFDEF VerboseAnchorDockPages} - debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" make new control (',DbgSName(NewControl),') dockable ...']); - {$ENDIF} - if SiteType<>adhstPages then - RaiseGDBException('TAnchorDockHostSite.DockAnotherPage inconsistency'); - - NewSite:=MakeSite(NewControl); - //debugln(['TAnchorDockHostSite.DockAnotherPage Self="',Caption,'" adding newcontrol site ...']); - NewIndex:=FPages.PageCount; - if (InFrontOf is TAnchorDockPage) - and (InFrontOf.Parent=Pages) then - NewIndex:=TAnchorDockPage(InFrontOf).PageIndex; - Pages.Pages.Insert(NewIndex,NewSite.Caption); - //debugln(['TAnchorDockHostSite.DockAnotherPage ',DbgSName(FPages.Page[1])]); - NewSite.Parent:=FPages.Page[NewIndex]; - NewSite.Align:=alClient; - NewSite.Visible:=true; - FPages.PageIndex:=NewIndex; - - Result:=true; -end; - -procedure TAnchorDockHostSite.AddCleanControl(AControl: TControl; - TheAlign: TAlign); -var - a: TAnchorKind; -begin - AControl.Parent:=Self; - AControl.Align:=TheAlign; - AControl.Anchors:=[akLeft,akTop,akRight,akBottom]; - for a:=Low(TAnchorKind) to high(TAnchorKind) do - AControl.AnchorSide[a].Control:=nil; - AControl.Visible:=true; -end; - -procedure TAnchorDockHostSite.RemoveControlFromLayout(AControl: TControl); - - procedure RemoveControlBoundSplitter(Splitter: TAnchorDockSplitter; - Side: TAnchorKind); - var - i: Integer; - Sibling: TControl; - NewBounds: TRect; - begin - //debugln(['RemoveControlBoundSplitter START ',DbgSName(Splitter)]); - { Example: Side=akRight - # # - ##################### ######### - ---+S+--------+# ---+# - ---+S|AControl|# ---> ---+# - ---+S+--------+# ---+# - ##################### ######### - } - for i:=Splitter.AnchoredControlCount-1 downto 0 do begin - Sibling:=Splitter.AnchoredControls[i]; - if Sibling.AnchorSide[Side].Control=Splitter then begin - // anchor Sibling to next - Sibling.AnchorSide[Side].Assign(AControl.AnchorSide[Side]); - // enlarge Sibling - NewBounds:=Sibling.BoundsRect; - case Side of - akTop: NewBounds.Top:=AControl.Top; - akLeft: NewBounds.Left:=AControl.Left; - akRight: NewBounds.Right:=AControl.Left+AControl.Width; - akBottom: NewBounds.Bottom:=AControl.Top+AControl.Height; - end; - 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 - {$IFDEF VerboseAnchorDockPages} - debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=1']); - {$ENDIF} - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyPages'){$ENDIF}; - BeginUpdateLayout; - try - // move the content of the Page to the place where Pages is - Page:=Pages.DockPages[0]; - Site:=Page.GetSite; - Site.Parent:=Self; - if Site<>nil then - CopyAnchorBounds(Pages,Site); - if SiteType=adhstPages then - FSiteType:=adhstOneControl; - // free Pages - FreePages; - if SiteType=adhstOneControl then - SimplifyOneControl; - finally - EndUpdateLayout; - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyPages'){$ENDIF}; - end; - //debugln(['TAnchorDockHostSite.SimplifyPages END Self="',Caption,'"']); - //DebugWriteChildAnchors(GetParentForm(Self),true,true); - end else if Pages.PageCount=0 then begin - //debugln(['TAnchorDockHostSite.SimplifyPages "',Caption,'" PageCount=0 Self=',dbgs(Pointer(Self))]); - FSiteType:=adhstNone; - FreePages; - DockMaster.NeedSimplify(Self); - end; -end; - -procedure TAnchorDockHostSite.SimplifyOneControl; -var - Site: TAnchorDockHostSite; - i: Integer; - Child: TControl; - a: TAnchorKind; -begin - if SiteType<>adhstOneControl then exit; - if not IsOneSiteLayout(Site) then exit; - debugln(['TAnchorDockHostSite.SimplifyOneControl Self="',Caption,'" Site="',Site.Caption,'"']); - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyOneControl'){$ENDIF}; - BeginUpdateLayout; - try - // move the content of Site up and free Site - // Note: it is not possible to do it the other way round, because moving a - // form to screen changes the z order and focus - FSiteType:=Site.SiteType; - - // header - Header.Align:=Site.Header.Align; - Header.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{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SimplifyOneControl'){$ENDIF}; - end; - - //debugln(['TAnchorDockHostSite.SimplifyOneControl END Self="',Caption,'"']); - //DebugWriteChildAnchors(GetParentForm(Self),true,true); -end; - -function TAnchorDockHostSite.GetOneControl: TControl; -var - i: Integer; -begin - for i:=0 to ControlCount-1 do begin - Result:=Controls[i]; - if Result.Owner<>Self then exit; - end; - Result:=nil; -end; - -function TAnchorDockHostSite.GetSiteCount: integer; -var - i: Integer; - Child: TControl; -begin - Result:=0; - for i:=0 to ControlCount-1 do begin - Child:=Controls[i]; - if not (Child is TAnchorDockHostSite) then continue; - if not Child.IsControlVisible then continue; - inc(Result); - end; -end; - -function TAnchorDockHostSite.IsOneSiteLayout(out Site: TAnchorDockHostSite - ): boolean; -var - i: Integer; - Child: TControl; -begin - Site:=nil; - for i:=0 to ControlCount-1 do begin - Child:=Controls[i]; - if not (Child is TAnchorDockHostSite) then continue; - if not Child.IsControlVisible then continue; - if Site<>nil then exit(false); - Site:=TAnchorDockHostSite(Child); - end; - Result:=Site<>nil; -end; - -function TAnchorDockHostSite.IsTwoSiteLayout(out Site1, - Site2: TAnchorDockHostSite): boolean; -var - i: Integer; - Child: TControl; -begin - Site1:=nil; - Site2:=nil; - for i:=0 to ControlCount-1 do begin - Child:=Controls[i]; - if not (Child is TAnchorDockHostSite) then continue; - if not Child.IsControlVisible then continue; - if Site1=nil then - Site1:=TAnchorDockHostSite(Child) - else if Site2=nil then - Site2:=TAnchorDockHostSite(Child) - else - exit(false); - end; - Result:=Site2<>nil; -end; - -function TAnchorDockHostSite.GetUniqueSplitterName: string; -var - i: Integer; -begin - i:=0; - repeat - inc(i); - Result:=AnchorDockSplitterName+IntToStr(i); - until FindComponent(Result)=nil; -end; - -function TAnchorDockHostSite.MakeSite(AControl: TControl): TAnchorDockHostSite; -begin - if AControl is TAnchorDockHostSite then - Result:=TAnchorDockHostSite(AControl) - else begin - Result:=DockMaster.CreateSite; - try - AControl.ManualDock(Result,nil,alClient); - finally - Result.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(ADAutoSizingReason){$ENDIF}; - end; - end; -end; - -procedure TAnchorDockHostSite.MoveAllControls(dx, dy: integer); -// move all children, except the sides that are anchored to parent left,top -var - i: Integer; - Child: TControl; - NewBounds: TRect; -begin - for i:=0 to ControlCount-1 do begin - Child:=Controls[i]; - NewBounds:=Child.BoundsRect; - OffsetRect(NewBounds,dx,dy); - if Child.AnchorSideLeft.Control=Self then - NewBounds.Left:=0; - if Child.AnchorSideTop.Control=Self then - NewBounds.Top:=0; - Child.BoundsRect:=NewBounds; - end; -end; - -procedure TAnchorDockHostSite.AlignControls(AControl: TControl; var ARect: TRect); -var - i: Integer; - Child: TControl; - Splitter: TAnchorDockSplitter; -begin - inherited AlignControls(AControl, ARect); - if csDestroying in ComponentState then exit; - - if DockMaster.ScaleOnResize and (not UpdatingLayout) - and (not DockMaster.Restoring) then begin - // scale splitters - for i:=0 to ControlCount-1 do begin - Child:=Controls[i]; - if not Child.IsControlVisible then continue; - if Child is TAnchorDockSplitter then begin - Splitter:=TAnchorDockSplitter(Child); - //debugln(['TAnchorDockHostSite.AlignControls ',Caption,' ',DbgSName(Splitter),' OldBounds=',dbgs(Splitter.BoundsRect),' BaseBounds=',dbgs(Splitter.DockBounds),' BaseParentSize=',dbgs(Splitter.DockParentClientSize),' ParentSize=',ClientWidth,'x',ClientHeight]); - Splitter.SetBoundsPercentually; - //debugln(['TAnchorDockHostSite.AlignControls ',Caption,' ',DbgSName(Child),' NewBounds=',dbgs(Child.BoundsRect)]); - end; - end; - end; -end; - -function TAnchorDockHostSite.CheckIfOneControlHidden: boolean; -var - Child: TControl; -begin - Result:=false; - //debugln(['TAnchorDockHostSite.CheckIfOneControlHidden ',DbgSName(Self),' UpdatingLayout=',UpdatingLayout,' Visible=',Visible,' Parent=',DbgSName(Parent),' csDestroying=',csDestroying in ComponentState,' SiteType=',dbgs(SiteType)]); - if UpdatingLayout or (not IsControlVisible) - or (csDestroying in ComponentState) - or (SiteType<>adhstOneControl) - then - exit; - Child:=GetOneControl; - if (Child=nil) then exit; - if Child.IsControlVisible then exit; - - // docked child was hidden/closed - Result:=true; - // => undock - BeginUpdateLayout; - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CheckIfOneControlHidden'){$ENDIF}; - try - 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; - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CheckIfOneControlHidden'){$ENDIF}; - end; - EndUpdateLayout; - if (not (Child is TCustomForm)) or (csDestroying in Child.ComponentState) then - Release; -end; - -procedure TAnchorDockHostSite.DoDock(NewDockSite: TWinControl; var ARect: TRect); -begin - inherited DoDock(NewDockSite, ARect); - if DockMaster <> nil then - DockMaster.SimplifyPendingLayouts; -end; - -procedure TAnchorDockHostSite.SetParent(NewParent: TWinControl); -var - OldCaption: string; - OldParent: TWinControl; -begin - OldParent:=Parent; - if NewParent=OldParent then exit; - inherited SetParent(NewParent); - OldCaption:=Caption; - UpdateDockCaption; - if OldCaption<>Caption then begin - // UpdateDockCaption has not updated parents => do it now - if Parent is TAnchorDockHostSite then - TAnchorDockHostSite(Parent).UpdateDockCaption; - if Parent is TAnchorDockPage then - TAnchorDockPage(Parent).UpdateDockCaption; - end; - UpdateHeaderShowing; - - if (BoundSplitter<>nil) and (BoundSplitter.Parent<>Parent) then begin - //debugln(['TAnchorDockHostSite.SetParent freeing splitter: ',DbgSName(BoundSplitter)]); - FreeAndNil(FBoundSplitter); - end; - if Parent=nil then - BorderStyle:=bsSizeable - else - BorderStyle:=bsNone; -end; - -function TAnchorDockHostSite.HeaderNeedsShowing: boolean; -begin - Result:=(SiteType<>adhstLayout) - and (not (Parent is TAnchorDockPage)) - and Assigned(DockMaster) and DockMaster.ShowHeader; -end; - -procedure TAnchorDockHostSite.DoClose(var CloseAction: TCloseAction); -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{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Undock'){$ENDIF}; - try - p := Point(0,0); - p := ClientToScreen(p); - Parent:=nil; - SetBounds(p.x,p.y,Width,Height); - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Undock'){$ENDIF}; - end; -end; - -function TAnchorDockHostSite.CanMerge: boolean; -begin - Result:=(SiteType=adhstLayout) - and (Parent is TAnchorDockHostSite) - and (TAnchorDockHostSite(Parent).SiteType=adhstLayout); -end; - -procedure TAnchorDockHostSite.Merge; -{ Move all child controls to parent and delete this site -} -var - ParentSite: TAnchorDockHostSite; - i: Integer; - Child: TControl; - Side: TAnchorKind; -begin - ParentSite:=Parent as TAnchorDockHostSite; - if (SiteType<>adhstLayout) or (ParentSite.SiteType<>adhstLayout) then - RaiseGDBException(''); - ParentSite.BeginUpdateLayout; - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.Merge'){$ENDIF}; - try - for i := ControlCount - 1 downto 0 do begin - Child := Controls[i]; - if Child.Owner <> Self then - begin - Child.Parent := ParentSite; - Child.SetBounds(Child.Left + Left, Child.Top + Top, Child.Width, Child.Height); - for Side := Low(TAnchorKind) to High(TAnchorKind) do - if Child.AnchorSide[Side].Control = Self then - Child.AnchorSide[Side].Assign(AnchorSide[Side]); - end; - end; - Parent:=nil; - DockMaster.NeedFree(Self); - finally - ParentSite.EndUpdateLayout; - // not needed, because this site is freed: EnableAutoSizing; - end; -end; - -function TAnchorDockHostSite.EnlargeSide(Side: TAnchorKind; - OnlyCheckIfPossible: boolean): boolean; -{ - Shrink one splitter, enlarge the other splitter. - - |#| |# |#| |# - |#| Control |# |#| |# - --+#+---------+# --> --+#| Control |# - ===============# ===#| |# - --------------+# --+#| |# - A |# A|#| |# - --------------+# --+#+---------+# - ================== =================== - - Move one neighbor splitter, enlarge Control, resize one splitter, rotate the other splitter. - - |#| |#| |#| |#| - |#| Control |#| |#| |#| - --+#+---------+#+-- --> --+#| Control |#+-- - =================== ===#| |#=== - --------+#+-------- --+#| |#+-- - |#| B |#| |#|B - |#+-------- |#| |#+-- - A |#========= A|#| |#=== - |#+-------- |#| |#+-- - |#| C |#| |#|C - --------+#+-------- --+#+---------+#+-- - =================== =================== -} -begin - Result:=true; - if EnlargeSideResizeTwoSplitters(Side,ClockwiseAnchor[Side], - OnlyCheckIfPossible) then exit; - if EnlargeSideResizeTwoSplitters(Side,OppositeAnchor[ClockwiseAnchor[Side]], - OnlyCheckIfPossible) then exit; - if EnlargeSideRotateSplitter(Side,OnlyCheckIfPossible) then exit; - Result:=false; -end; - -function TAnchorDockHostSite.EnlargeSideResizeTwoSplitters(ShrinkSplitterSide, - EnlargeSpitterSide: TAnchorKind; OnlyCheckIfPossible: boolean): boolean; -{ Shrink one neighbor control, enlarge Self. Two splitters are resized. - - For example: ShrinkSplitterSide=akBottom, EnlargeSpitterSide=akLeft - - |#| |# |#| |# - |#| Self |# |#| |# - --+#+--------+# --> --+#| Self |# - ==============# ===#| |# - -------------+# --+#| |# - A |# A|#| |# - -------------+# --+#+--------+# - ================= ================== - - - -} -var - ParentSite: TAnchorDockHostSite; - ShrinkSplitter: TAnchorDockSplitter; - EnlargeSplitter: TAnchorDockSplitter; - KeptSide: TAnchorKind; - KeptAnchorControl: TControl; - Sibling: TControl; - ShrinkControl: TControl; - i: Integer; -begin - Result:=false; - if not (Parent is TAnchorDockHostSite) then exit; - ParentSite:=TAnchorDockHostSite(Parent); - if not OnlyCheckIfPossible then begin - ParentSite.BeginUpdateLayout; - ParentSite.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideResizeTwoSplitters'){$ENDIF}; - end; - try - // check ShrinkSplitter - ShrinkSplitter:=TAnchorDockSplitter(AnchorSide[ShrinkSplitterSide].Control); - if not (ShrinkSplitter is TAnchorDockSplitter) then exit; - // check if EnlargeSpitterSide is a neighbor ShrinkSplitterSide - if (EnlargeSpitterSide<>ClockwiseAnchor[ShrinkSplitterSide]) - and (EnlargeSpitterSide<>OppositeAnchor[ClockwiseAnchor[ShrinkSplitterSide]]) then - exit; - // check EnlargeSpitter - EnlargeSplitter:=TAnchorDockSplitter(AnchorSide[EnlargeSpitterSide].Control); - if not (EnlargeSplitter is TAnchorDockSplitter) then exit; - // check if KeptSide is anchored to a splitter or parent - KeptSide:=OppositeAnchor[EnlargeSpitterSide]; - KeptAnchorControl:=AnchorSide[KeptSide].Control; - if not ((KeptAnchorControl=ParentSite) - or (KeptAnchorControl is TAnchorDockSplitter)) then exit; - // check if ShrinkSplitter is anchored/stops at KeptAnchorControl - if ShrinkSplitter.AnchorSide[KeptSide].Control<>KeptAnchorControl then exit; - - // check if there is a control to shrink - ShrinkControl:=nil; - for i:=0 to ShrinkSplitter.AnchoredControlCount-1 do begin - Sibling:=ShrinkSplitter.AnchoredControls[i]; - if (Sibling.AnchorSide[OppositeAnchor[ShrinkSplitterSide]].Control=ShrinkSplitter) - and (Sibling.AnchorSide[KeptSide].Control=KeptAnchorControl) then begin - ShrinkControl:=Sibling; - break; - end; - end; - if ShrinkControl=nil then exit; - - if OnlyCheckIfPossible then begin - // check if ShrinkControl is large enough for shrinking - case EnlargeSpitterSide of - akTop: if ShrinkControl.Top>=EnlargeSplitter.Top then exit; - akLeft: if ShrinkControl.Left>=EnlargeSplitter.Left then exit; - akRight: if ShrinkControl.Left+ShrinkControl.Width - <=EnlargeSplitter.Left+EnlargeSplitter.Width then exit; - akBottom: if ShrinkControl.Top+ShrinkControl.Height - <=EnlargeSplitter.Top+EnlargeSplitter.Height then exit; - end; - end else begin - // do it - // enlarge the EnlargeSplitter and Self - AnchorAndChangeBounds(EnlargeSplitter,ShrinkSplitterSide, - ShrinkControl.AnchorSide[ShrinkSplitterSide].Control); - AnchorAndChangeBounds(Self,ShrinkSplitterSide, - ShrinkControl.AnchorSide[ShrinkSplitterSide].Control); - // shrink the ShrinkSplitter and ShrinkControl - AnchorAndChangeBounds(ShrinkSplitter,KeptSide,EnlargeSplitter); - AnchorAndChangeBounds(ShrinkControl,KeptSide,EnlargeSplitter); - end; - - finally - if not OnlyCheckIfPossible then begin - ParentSite.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.EnlargeSideResizeTwoSplitters'){$ENDIF}; - ParentSite.EndUpdateLayout; - end; - end; - Result:=true; -end; - -function TAnchorDockHostSite.EnlargeSideRotateSplitter(Side: TAnchorKind; - OnlyCheckIfPossible: boolean): boolean; -{ Shrink splitter at Side, enlarge both neighbor splitters, - rotate the splitter behind, enlarge Control, - shrink controls at rotate splitter - - |#| |#| |#| |#| - |#| Control |#| |#| |#| - --+#+---------+#+-- --> --+#| Control |#+-- - =================== ===#| |#=== - --------+#+-------- --+#| |#+-- - |#| B |#| |#|B - |#+-------- |#| |#+-- - A |#========= A|#| |#=== - |#+-------- |#| |#+-- - |#| C |#| |#|C - --------+#+-------- --+#+---------+#+-- - =================== =================== -} -var - Splitter: TAnchorDockSplitter; - CWSide: TAnchorKind; - CWSplitter: TAnchorDockSplitter; - CCWSide: TAnchorKind; - i: Integer; - Sibling: TControl; - BehindSide: TAnchorKind; - RotateSplitter: TAnchorDockSplitter; - CCWSplitter: TAnchorDockSplitter; -begin - Result:=false; - // check if there is a splitter at Side - Splitter:=TAnchorDockSplitter(AnchorSide[Side].Control); - if not (Splitter is TAnchorDockSplitter) then exit; - // check if there is a splitter at clockwise Side - CWSide:=ClockwiseAnchor[Side]; - CWSplitter:=TAnchorDockSplitter(AnchorSide[CWSide].Control); - if not (CWSplitter is TAnchorDockSplitter) then exit; - // check if there is a splitter at counter clockwise Side - CCWSide:=OppositeAnchor[CWSide]; - CCWSplitter:=TAnchorDockSplitter(AnchorSide[CCWSide].Control); - if not (CCWSplitter is TAnchorDockSplitter) then exit; - // check if neighbor splitters end at Splitter - if CWSplitter.AnchorSide[Side].Control<>Splitter then exit; - if CCWSplitter.AnchorSide[Side].Control<>Splitter then exit; - // find the rotate splitter behind Splitter - BehindSide:=OppositeAnchor[Side]; - RotateSplitter:=nil; - for i:=0 to Splitter.AnchoredControlCount-1 do begin - Sibling:=Splitter.AnchoredControls[i]; - if Sibling.AnchorSide[BehindSide].Control<>Splitter then continue; - if not (Sibling is TAnchorDockSplitter) then continue; - if Side in [akLeft,akRight] then begin - if Sibling.TopTop+Height then continue; - end else begin - if Sibling.LeftLeft+Width then continue; - end; - if RotateSplitter=nil then - RotateSplitter:=TAnchorDockSplitter(Sibling) - else - // there are multiple splitters behind - exit; - end; - if RotateSplitter=nil then exit; - // check that all siblings at RotateSplitter are large enough to shrink - for i:=0 to RotateSplitter.AnchoredControlCount-1 do begin - Sibling:=RotateSplitter.AnchoredControls[i]; - if Side in [akLeft,akRight] then begin - if (Sibling.Top>Top-DockMaster.SplitterWidth) - and (Sibling.Top+Sibling.HeightLeft-DockMaster.SplitterWidth) - and (Sibling.Left+Sibling.WidthTop then continue; - akTop: if Sibling.Left>Left then continue; - akBottom: if Sibling.Leftnil then exit; - FBoundSplitter:=DockMaster.CreateSplitter; - BoundSplitter.FreeNotification(Self); - BoundSplitter.Align:=Align; - BoundSplitter.Parent:=Parent; -end; - -procedure TAnchorDockHostSite.PositionBoundSplitter; -begin - case Align of - alTop: BoundSplitter.SetBounds(0,Height,Parent.ClientWidth,BoundSplitter.Height); - alBottom: BoundSplitter.SetBounds(0,Parent.ClientHeight-Height-BoundSplitter.Height, - Parent.ClientWidth,BoundSplitter.Height); - alLeft: BoundSplitter.SetBounds(Width,0,BoundSplitter.Width,Parent.ClientHeight); - alRight: BoundSplitter.SetBounds(Parent.ClientWidth-Width-BoundSplitter.Width,0 - ,BoundSplitter.Width,Parent.ClientHeight); - end; -end; - -function TAnchorDockHostSite.CloseQuery: boolean; - - function Check(AControl: TWinControl): boolean; - var - i: Integer; - Child: TControl; - begin - for i:=0 to AControl.ControlCount-1 do begin - Child:=AControl.Controls[i]; - if Child is TWinControl then begin - if Child is TCustomForm then begin - if not TCustomForm(Child).CloseQuery then exit(false); - end else begin - if not Check(TWinControl(Child)) then exit(false); - end; - end; - end; - Result:=true; - end; - -begin - Result:=Check(Self); -end; - -function TAnchorDockHostSite.CloseSite: boolean; -var - AControl: TControl; - AForm: TCustomForm; - IsMainForm: Boolean; - CloseAction: TCloseAction; - NeedEnableAutoSizing: Boolean; -begin - Result:=CloseQuery; - if not Result then exit; - - debugln(['TAnchorDockHostSite.CloseSite ',DbgSName(Self),' SiteType=',dbgs(SiteType)]); - case SiteType of - adhstNone: - begin - Release; - exit; - end; - adhstOneControl: - begin - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF}; - NeedEnableAutoSizing:=true; - try - AControl:=GetOneControl; - if AControl is TCustomForm then begin - AForm:=TCustomForm(AControl); - IsMainForm := (Application.MainForm = AForm) - or (AForm.IsParentOf(Application.MainForm)); - if IsMainForm then - CloseAction := caFree - else - CloseAction := caHide; - // ToDo: TCustomForm(AControl).DoClose(CloseAction); - case CloseAction of - caHide: Hide; - caMinimize: WindowState := wsMinimized; - caFree: - begin - // if form is MainForm, then terminate the application - // the owner of the MainForm is the application, - // so the Application will take care of free-ing the form - // and Release is not necessary - if IsMainForm then - Application.Terminate - else begin - NeedEnableAutoSizing:=false; - Release; - AForm.Release; - exit; - end; - end; - end; - end else begin - AControl.Visible:=false; - NeedEnableAutoSizing:=false; - Release; - exit; - end; - Visible:=false; - Parent:=nil; - finally - if NeedEnableAutoSizing then - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.CloseSite'){$ENDIF}; - end; - end; - end; -end; - -procedure TAnchorDockHostSite.RemoveControl(AControl: TControl); -begin - //debugln(['TAnchorDockHostSite.RemoveControl ',DbgSName(Self),'=',Caption,' ',DbgSName(AControl)]); - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.RemoveControl'){$ENDIF}; - try - inherited RemoveControl(AControl); - if not (csDestroying in ComponentState) then begin - if (not ((AControl is TAnchorDockHeader) - or (AControl is TAnchorDockSplitter))) - then begin - //debugln(['TAnchorDockHostSite.RemoveControl START ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl),' UpdatingLayout=',UpdatingLayout]); - if (SiteType=adhstLayout) then - RemoveControlFromLayout(AControl) - else - DockMaster.NeedSimplify(Self); - UpdateDockCaption; - //debugln(['TAnchorDockHostSite.RemoveControl END ',Caption,' ',dbgs(SiteType),' ',DbgSName(AControl)]); - end; - end; - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.RemoveControl'){$ENDIF}; - end; -end; - -procedure TAnchorDockHostSite.InsertControl(AControl: TControl; Index: integer); -begin - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.InsertControl'){$ENDIF}; - try - inherited InsertControl(AControl, Index); - if not ((AControl is TAnchorDockSplitter) - or (AControl is TAnchorDockHeader)) - then - UpdateDockCaption; - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.InsertControl'){$ENDIF}; - end; -end; - -procedure TAnchorDockHostSite.UpdateDockCaption(Exclude: TControl); -var - i: Integer; - Child: TControl; - NewCaption, OldCaption: String; -begin - if csDestroying in ComponentState then exit; - NewCaption:=''; - for i:=0 to ControlCount-1 do begin - Child:=Controls[i]; - if Child=Exclude then continue; - if (Child.HostDockSite=Self) or (Child is TAnchorDockHostSite) - or (Child is TAnchorDockPageControl) then begin - if NewCaption<>'' then - NewCaption:=NewCaption+','; - NewCaption:=NewCaption+Child.Caption; - end; - end; - OldCaption:=Caption; - Caption:=NewCaption; - //debugln(['TAnchorDockHostSite.UpdateDockCaption Caption="',Caption,'" NewCaption="',NewCaption,'" HasParent=',Parent<>nil,' ',DbgSName(Header)]); - 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])]);} - FreePages; - inherited Destroy; -end; - -{ TAnchorDockHeader } - -procedure TAnchorDockHeader.PopupMenuPopup(Sender: TObject); -var - HeaderPosItem: TMenuItem; - ParentSite: TAnchorDockHostSite; - Side: TAnchorKind; - SideCaptions: array[TAnchorKind] of string; - Item: TMenuItem; - ContainsMainForm: boolean; - s: String; -begin - ParentSite:=TAnchorDockHostSite(Parent); - SideCaptions[akLeft]:=adrsLeft; - SideCaptions[akTop]:=adrsTop; - SideCaptions[akRight]:=adrsRight; - SideCaptions[akBottom]:=adrsBottom; - - // menu items: undock, merge - DockMaster.AddRemovePopupMenuItem(ParentSite.CanUndock,'UndockMenuItem', - adrsUndock,@UndockButtonClick); - DockMaster.AddRemovePopupMenuItem(ParentSite.CanMerge,'MergeMenuItem', - adrsMerge, @MergeButtonClick); - - // menu items: header position - HeaderPosItem:=DockMaster.AddPopupMenuItem('HeaderPosMenuItem', - adrsHeaderPosition, nil); - Item:=DockMaster.AddPopupMenuItem('HeaderPosAutoMenuItem', adrsAutomatically, - @HeaderPositionItemClick, HeaderPosItem); - if Item<>nil then begin - Item.Tag:=ord(adlhpAuto); - Item.Checked:=HeaderPosition=TADLHeaderPosition(Item.Tag); - end; - for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin - Item:=DockMaster.AddPopupMenuItem('HeaderPos'+DbgS(Side)+'MenuItem', - SideCaptions[Side], @HeaderPositionItemClick, - HeaderPosItem); - if Item=nil then continue; - Item.Tag:=ord(Side)+1; - Item.Checked:=HeaderPosition=TADLHeaderPosition(Item.Tag); - end; - - // menu items: enlarge - for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin - Item:=DockMaster.AddRemovePopupMenuItem(ParentSite.EnlargeSide(Side,true), - 'Enlarge'+DbgS(Side)+'MenuItem', Format(adrsEnlargeSide, [ - SideCaptions[Side]]),@EnlargeSideClick); - if Item<>nil then Item.Tag:=ord(Side); - end; - - // menu item: close or quit - ContainsMainForm:=ParentSite.IsParentOf(Application.MainForm); - if ContainsMainForm then - s:=Format(adrsQuit, [Application.Title]) - else - s:=adrsClose; - DockMaster.AddRemovePopupMenuItem(CloseButton.Visible,'CloseMenuItem',s, - @CloseButtonClick); -end; - -procedure TAnchorDockHeader.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{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SetAlign'){$ENDIF}; - try - inherited SetAlign(Value); - UpdateHeaderControls; - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockHostSite.SetAlign'){$ENDIF}; - end; -end; - -procedure TAnchorDockHeader.DoOnShowHint(HintInfo: PHintInfo); -var - s: String; - p: LongInt; - c: String; -begin - s:=DockMaster.GetLocalizedHeaderHint; - p:=Pos('%s',s); - if p>0 then begin - if Parent<>nil then - c:=Parent.Caption - else - c:=''; - s:=Format(s,[c]); - end; - //debugln(['TAnchorDockHeader.DoOnShowHint "',s,'" "',DockMaster.HeaderHint,'"']); - HintInfo^.HintStr:=s; - inherited DoOnShowHint(HintInfo); -end; - -constructor TAnchorDockHeader.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - FHeaderPosition:=adlhpAuto; - 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; - PreferredHeight:=cy; - {$IF defined(LCLGtk2) or defined(Carbon)} - inc(PreferredWidth,2); - inc(PreferredHeight,2); - {$ENDIF} - 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{$IFDEF DebugDisableAutoSizing}('TAnchorDockManager.InsertControl'){$ENDIF}; - try - // align dragged Control - Child:=ADockObject.Control; - Child.Parent:=Site; - Child.Align:=ADockObject.DropAlign; - Child.Width:=ADockObject.DockRect.Right-ADockObject.DockRect.Left; - Child.Height:=ADockObject.DockRect.Bottom-ADockObject.DockRect.Top; - - SplitterWidth:=0; - ChildSite:=nil; - if Child is TAnchorDockHostSite then begin - ChildSite:=TAnchorDockHostSite(Child); - ChildSite.CreateBoundSplitter; - 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{$IFDEF DebugDisableAutoSizing}('TAnchorDockManager.InsertControl'){$ENDIF}; - end; - end; -end; - -procedure TAnchorDockManager.LoadFromStream(Stream: TStream); -begin - debugln(['TAnchorDockManager.LoadFromStream not implemented Site="',DbgSName(Site),'"']); - if Stream=nil then ; -end; - -procedure TAnchorDockManager.PositionDockRect(Client, DropCtl: TControl; - DropAlign: TAlign; var DockRect: TRect); -{ Client = dragged source site (a TAnchorDockHostSite) - DropCtl is target control (the DockSite, DockSite.Pages or one of the pages) - DropAlign: where on Client DropCtl should be placed - DockRect: the estimated new bounds of DropCtl -} -var - Offset: TPoint; - Inside: Boolean; -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 - {$IFDEF VerboseAnchorDocking} - debugln(['TAnchorDockManager.RemoveControl DockSite="',DockSite.Caption,'" Control=',DbgSName(Control)]) - {$ENDIF} - else begin - {$IFDEF VerboseAnchorDocking} - debugln(['TAnchorDockManager.RemoveControl Site="',DbgSName(Site),'" Control=',DbgSName(Control)]); - {$ENDIF} - if Control is TAnchorDockHostSite then begin - SplitterWidth:=0; - if Control is TAnchorDockHostSite then begin - ChildSite:=TAnchorDockHostSite(Control); - if ChildSite.BoundSplitter<>nil then - SplitterWidth:=DockMaster.SplitterWidth; - end; - - // shrink Site - NewBounds:=Site.BoundsRect; - case Control.Align of - alTop: inc(NewBounds.Top,Control.Height+SplitterWidth); - alBottom: dec(NewBounds.Bottom,Control.Height+SplitterWidth); - alLeft: inc(NewBounds.Left,Control.Width+SplitterWidth); - alRight: dec(NewBounds.Right,Control.Width+SplitterWidth); - end; - if StoredConstraintsValid then begin - // restore constraints - with Site.Constraints do begin - MinWidth:=FStoredConstraints.Left; - MinHeight:=FStoredConstraints.Top; - MaxWidth:=FStoredConstraints.Right; - MaxHeight:=FStoredConstraints.Bottom; - end; - FStoredConstraints:=Rect(0,0,0,0); - end; - Site.BoundsRect:=NewBounds; - {$IFDEF VerboseAnchorDocking} - debugln(['TAnchorDockManager.RemoveControl Site=',DbgSName(Site),' ',dbgs(Site.BoundsRect)]); - {$ENDIF} - - // Site can dock a control again - DragManager.RegisterDockSite(Site,true); - end; - end; -end; - -procedure TAnchorDockManager.ResetBounds(Force: Boolean); -var - OldSiteClientRect: TRect; - WidthDiff: Integer; - HeightDiff: Integer; - ClientRectChanged: Boolean; - - procedure AlignChilds; - var - i: Integer; - b: TRect; - AControl: TControl; - ChildMaxSize: TPoint; - SiteMinSize: TPoint; - Child: TAnchorDockHostSite; - begin - if ClientRectChanged and DockMaster.Restoring then begin - // ClientRect changed => restore bounds - for i:=0 to Site.ControlCount-1 do begin - AControl:=Site.Controls[i]; - b:=Rect(0,0,0,0); - if AControl is TAnchorDockHostSite then - b:=TAnchorDockHostSite(AControl).DockRestoreBounds - else if AControl is TAnchorDockSplitter then - b:=TAnchorDockSplitter(AControl).DockRestoreBounds; - if (b.Right<=b.Left) or (b.Bottom<=b.Top) then - b:=AControl.BoundsRect; - {$IFDEF VerboseAnchorDockRestore} - debugln(['TAnchorDockManager.ResetBounds RESTORE ',DbgSName(AControl),' Cur=',dbgs(AControl.BoundsRect),' Restore=',dbgs(b)]); - {$ENDIF} - if AControl is TAnchorDockSplitter then begin - // fit splitter into clientarea - if AControl.AnchorSide[akLeft].Control=nil then - b.Left:=Max(0,Min(b.Left,Site.ClientWidth-10)); - if AControl.AnchorSide[akTop].Control=nil then - b.Top:=Max(0,Min(b.Top,Site.ClientHeight-10)); - if TAnchorDockSplitter(AControl).ResizeAnchor in [akLeft,akRight] then - begin - b.Right:=b.Left+DockMaster.SplitterWidth; - b.Bottom:=Max(1,Min(b.Bottom,Site.ClientHeight-b.Top)); - end - else begin - b.Right:=Max(1,Min(b.Right,Site.ClientWidth-b.Left)); - b.Bottom:=b.Top+DockMaster.SplitterWidth; - end; - end; - - AControl.BoundsRect:=b; - if AControl is TAnchorDockSplitter then - TAnchorDockSplitter(AControl).UpdateDockBounds; - end; - exit; - end; - - if DockSite<>nil then exit; - Child:=GetChildSite; - if Child=nil then exit; - - {$IFDEF VerboseAnchorDockRestore} - debugln(['TAnchorDockManager.ResetBounds ',DbgSName(Site),' ',dbgs(Child.BaseBounds),' ',WidthDiff,',',HeightDiff]); - {$ENDIF} - ChildMaxSize:=Point(Site.ClientWidth-DockMaster.SplitterWidth, - Site.ClientHeight-DockMaster.SplitterWidth); - if PreferredSiteSizeAsSiteMinimum then begin - SiteMinSize:=GetSitePreferredClientSize; - if Child.Align in [alLeft,alRight] then begin - ChildMaxSize.X:=Max(0,(ChildMaxSize.X-SiteMinSize.X)); - end else begin - ChildMaxSize.Y:=Max(0,(ChildMaxSize.Y-SiteMinSize.Y)); - end; - {$IF defined(VerboseAnchorDockRestore) or defined(VerboseADCustomSite)} - debugln(['TAnchorDockManager.ResetBounds ChildMaxSize=',dbgs(ChildMaxSize),' SiteMinSize=',dbgs(SiteMinSize),' Site.Client=',dbgs(Site.ClientRect)]); - {$ENDIF} - end; - - case ResizePolicy of - admrpChild: - begin - if Child.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.X0) or (Top<>0) or (Right<>0) or (Bottom<>0); -end; - -{ TAnchorDockSplitter } - -procedure TAnchorDockSplitter.SetResizeAnchor(const AValue: TAnchorKind); -begin - inherited SetResizeAnchor(AValue); - - case ResizeAnchor of - akLeft: Anchors:=AnchorAlign[alLeft]; - akTop: Anchors:=AnchorAlign[alTop]; - akRight: Anchors:=AnchorAlign[alRight]; - akBottom: Anchors:=AnchorAlign[alBottom]; - end; - - UpdatePercentPosition; - - //debugln(['TAnchorDockSplitter.SetResizeAnchor ',DbgSName(Self),' ResizeAnchor=',dbgs(ResizeAnchor),' Align=',dbgs(Align),' Anchors=',dbgs(Anchors)]); -end; - -procedure TAnchorDockSplitter.PopupMenuPopup(Sender: TObject); -begin - -end; - -procedure TAnchorDockSplitter.UpdateDockBounds; -begin - FDockBounds:=BoundsRect; - if Parent<>nil then begin - FDockParentClientSize.cx:=Parent.ClientWidth; - FDockParentClientSize.cy:=Parent.ClientHeight; - end else begin - FDockParentClientSize.cx:=0; - FDockParentClientSize.cy:=0; - end; - if FPercentPosition < 0 then - UpdatePercentPosition; -end; - -procedure TAnchorDockSplitter.UpdatePercentPosition; -begin - case ResizeAnchor of - akTop, akBottom: - if FDockParentClientSize.cy > 0 then - FPercentPosition := Top / FDockParentClientSize.cy - else - FPercentPosition := -1; - else - if FDockParentClientSize.cx > 0 then - FPercentPosition := Left / FDockParentClientSize.cx - else - FPercentPosition := -1; - end; -end; - -procedure TAnchorDockSplitter.SetBounds(ALeft, ATop, AWidth, AHeight: integer); -begin - DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockSplitter.SetBounds'){$ENDIF}; - try - inherited SetBounds(ALeft, ATop, AWidth, AHeight); - UpdateDockBounds; - finally - EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockSplitter.SetBounds'){$ENDIF}; - end; -end; - -procedure TAnchorDockSplitter.SetBoundsKeepDockBounds(ALeft, ATop, AWidth, AHeight: integer); -begin - inherited SetBounds(ALeft,ATop,AWidth,AHeight); -end; - -procedure TAnchorDockSplitter.SetBoundsPercentually; -var - NewLeft, NewTop: Integer; -begin - if ResizeAnchor in [akLeft,akRight] then - begin - if DockParentClientSize.cx> 0 then - begin - if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then - NewLeft := Round(FPercentPosition*Parent.ClientWidth) - else - NewLeft := (DockBounds.Left*Parent.ClientWidth) div DockParentClientSize.cx; - NewTop := Top; - SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height); - end; - end else - begin - if DockParentClientSize.cy> 0 then - begin - NewLeft := Left; - if (FPercentPosition > 0) or SameValue(FPercentPosition, 0) then - NewTop := Round(FPercentPosition*Parent.ClientHeight) - else - NewTop := (DockBounds.Top*Parent.ClientHeight) div DockParentClientSize.cy; - SetBoundsKeepDockBounds(NewLeft,NewTop,Width,Height); - end; - end; - if FPercentPosition < 0 then - UpdatePercentPosition; -end; - -function TAnchorDockSplitter.SideAnchoredControlCount(Side: TAnchorKind): integer; -var - Sibling: TControl; - i: Integer; -begin - Result:=0; - for i:=0 to AnchoredControlCount-1 do begin - Sibling:=AnchoredControls[i]; - if Sibling.AnchorSide[OppositeAnchor[Side]].Control=Self then - inc(Result); - end; -end; - -function TAnchorDockSplitter.HasAnchoredControls: boolean; -// returns true if this splitter has at least one non splitter control anchored to it -var - i: Integer; - Sibling: TControl; -begin - Result:=false; - for i:=0 to AnchoredControlCount-1 do begin - Sibling:=AnchoredControls[i]; - if Sibling is TAnchorDockSplitter then continue; - exit(true); - end; -end; - -procedure TAnchorDockSplitter.SaveLayout( - LayoutNode: TAnchorDockLayoutTreeNode); -begin - if ResizeAnchor in [akLeft,akRight] then - LayoutNode.NodeType:=adltnSplitterVertical - else - LayoutNode.NodeType:=adltnSplitterHorizontal; - LayoutNode.Assign(Self); -end; - -function TAnchorDockSplitter.HasOnlyOneSibling(Side: TAnchorKind; MinPos, - MaxPos: integer): TControl; -var - i: Integer; - AControl: TControl; -begin - Result:=nil; - for i:=0 to AnchoredControlCount-1 do begin - AControl:=AnchoredControls[i]; - if AControl.AnchorSide[OppositeAnchor[Side]].Control<>Self then continue; - // AControl is anchored at Side to this splitter - if (Side in [akLeft,akRight]) then begin - if (AControl.Left>MaxPos) or (AControl.Left+AControl.WidthMaxPos) or (AControl.Top+AControl.Height= 0) then - begin - APage:=Page[ATabIndex]; - if (APage.ControlCount>0) and (APage.Controls[0] is TAnchorDockHostSite) then - begin - Site:=TAnchorDockHostSite(APage.Controls[0]); - DragManager.DragStart(Site,false,DockMaster.DragTreshold); - end; - end; -end; - -procedure TAnchorDockPageControl.PopupMenuPopup(Sender: TObject); -var - ContainsMainForm: Boolean; - s: String; - TabPositionSection: TMenuItem; - Item: TMenuItem; - tp: TTabPosition; -begin - // movement - if PageIndex>0 then - DockMaster.AddPopupMenuItem('MoveLeftMenuItem', adrsMovePageLeft, - @MoveLeftButtonClick); - if PageIndex>1 then - DockMaster.AddPopupMenuItem('MoveLeftMostMenuItem', adrsMovePageLeftmost, - @MoveLeftMostButtonClick); - - if PageIndex0 then - Page[PageIndex].PageIndex:=Page[PageIndex].PageIndex-1; -end; - -procedure TAnchorDockPageControl.MoveLeftMostButtonClick(Sender: TObject); -begin - if PageIndex>0 then - Page[PageIndex].PageIndex:=0; -end; - -procedure TAnchorDockPageControl.MoveRightButtonClick(Sender: TObject); -begin - if PageIndex'' then - NewCaption:=NewCaption+','; - NewCaption:=NewCaption+Child.Caption; - end; - //debugln(['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. - diff --git a/etc/anchordocking/xanchordockoptionsdlg.lfm b/etc/anchordocking/xanchordockoptionsdlg.lfm deleted file mode 100644 index aee621a6..00000000 --- a/etc/anchordocking/xanchordockoptionsdlg.lfm +++ /dev/null @@ -1,248 +0,0 @@ -object AnchorDockOptionsFrame: TAnchorDockOptionsFrame - Left = 0 - Height = 482 - Top = 0 - Width = 416 - ClientHeight = 482 - ClientWidth = 416 - OnClick = FrameClick - TabOrder = 0 - DesignLeft = 513 - DesignTop = 189 - object DragThresholdLabel: TLabel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = HeaderStyleComboBox - AnchorSideTop.Side = asrBottom - Left = 10 - Height = 15 - Top = 35 - Width = 106 - BorderSpacing.Left = 10 - Caption = 'DragThresholdLabel' - ParentColor = False - end - object HeaderAlignTopLabel: TLabel - AnchorSideLeft.Control = DragThresholdLabel - AnchorSideTop.Control = FilledHeaders - AnchorSideTop.Side = asrBottom - Left = 10 - Height = 15 - Top = 295 - Width = 114 - BorderSpacing.Top = 10 - Caption = 'HeaderAlignTopLabel' - ParentColor = False - end - object HeaderAlignLeftLabel: TLabel - AnchorSideLeft.Control = DragThresholdLabel - AnchorSideTop.Control = HeaderAlignTopTrackBar - AnchorSideTop.Side = asrBottom - Left = 10 - Height = 15 - Top = 367 - Width = 114 - BorderSpacing.Top = 10 - Caption = 'HeaderAlignLeftLabel' - ParentColor = False - end - object SplitterWidthLabel: TLabel - AnchorSideLeft.Control = DragThresholdLabel - AnchorSideTop.Control = DragThresholdTrackBar - AnchorSideTop.Side = asrBottom - Left = 10 - Height = 15 - Top = 106 - Width = 97 - BorderSpacing.Top = 10 - Caption = 'SplitterWidthLabel' - ParentColor = False - end - object ScaleOnResizeCheckBox: TCheckBox - AnchorSideLeft.Control = DragThresholdLabel - AnchorSideTop.Control = SplitterWidthTrackBar - AnchorSideTop.Side = asrBottom - Left = 10 - Height = 19 - Top = 171 - Width = 147 - BorderSpacing.Top = 4 - Caption = 'ScaleOnResizeCheckBox' - ParentShowHint = False - ShowHint = True - TabOrder = 0 - end - object DragThresholdTrackBar: TTrackBar - AnchorSideLeft.Control = DragThresholdLabel - AnchorSideTop.Control = DragThresholdLabel - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 10 - Height = 46 - Top = 50 - Width = 396 - Max = 20 - OnChange = DragThresholdTrackBarChange - Position = 0 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Right = 10 - ParentShowHint = False - ShowHint = True - TabOrder = 1 - end - object HeaderAlignTopTrackBar: TTrackBar - AnchorSideLeft.Control = DragThresholdTrackBar - AnchorSideTop.Control = HeaderAlignTopLabel - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = DragThresholdTrackBar - AnchorSideRight.Side = asrBottom - Left = 10 - Height = 47 - Top = 310 - Width = 396 - Frequency = 10 - Max = 150 - OnChange = HeaderAlignTopTrackBarChange - PageSize = 10 - Position = 0 - Anchors = [akTop, akLeft, akRight] - ParentShowHint = False - ShowHint = True - TabOrder = 2 - end - object HeaderAlignLeftTrackBar: TTrackBar - AnchorSideLeft.Control = DragThresholdTrackBar - AnchorSideTop.Control = HeaderAlignLeftLabel - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = DragThresholdTrackBar - AnchorSideRight.Side = asrBottom - Left = 10 - Height = 47 - Top = 382 - Width = 396 - Frequency = 10 - Max = 200 - OnChange = HeaderAlignLeftTrackBarChange - PageSize = 10 - Position = 0 - Anchors = [akTop, akLeft, akRight] - ParentShowHint = False - ShowHint = True - TabOrder = 3 - end - object SplitterWidthTrackBar: TTrackBar - AnchorSideLeft.Control = DragThresholdTrackBar - AnchorSideTop.Control = SplitterWidthLabel - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = DragThresholdTrackBar - AnchorSideRight.Side = asrBottom - Left = 10 - Height = 46 - Top = 121 - Width = 396 - Min = 1 - OnChange = SplitterWidthTrackBarChange - Position = 1 - Anchors = [akTop, akLeft, akRight] - ParentShowHint = False - ShowHint = True - TabOrder = 4 - end - object ShowHeaderCaptionCheckBox: TCheckBox - AnchorSideLeft.Control = ScaleOnResizeCheckBox - AnchorSideTop.Control = ShowHeaderCheckBox - AnchorSideTop.Side = asrBottom - Left = 25 - Height = 19 - Top = 209 - Width = 181 - BorderSpacing.Left = 15 - Caption = 'ShowHeaderCaptionCheckBox' - ParentShowHint = False - ShowHint = True - TabOrder = 6 - end - object HideHeaderCaptionForFloatingCheckBox: TCheckBox - AnchorSideLeft.Control = ShowHeaderCaptionCheckBox - AnchorSideTop.Control = ShowHeaderCaptionCheckBox - AnchorSideTop.Side = asrBottom - Left = 25 - Height = 19 - Top = 228 - Width = 237 - Caption = 'HideHeaderCaptionForFloatingCheckBox' - ParentShowHint = False - ShowHint = True - TabOrder = 5 - end - object ShowHeaderCheckBox: TCheckBox - AnchorSideLeft.Control = ScaleOnResizeCheckBox - AnchorSideTop.Control = ScaleOnResizeCheckBox - AnchorSideTop.Side = asrBottom - Left = 10 - Height = 19 - Top = 190 - Width = 139 - Caption = 'ShowHeaderCheckBox' - OnChange = ShowHeaderCheckBoxChange - ParentShowHint = False - ShowHint = True - TabOrder = 7 - end - object HeaderStyleComboBox: TComboBox - AnchorSideLeft.Control = HeaderStyleLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 107 - Height = 23 - Top = 6 - Width = 299 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Right = 4 - BorderSpacing.Around = 6 - ItemHeight = 15 - OnDrawItem = HeaderStyleComboBoxDrawItem - Style = csDropDownList - TabOrder = 8 - end - object HeaderStyleLabel: TLabel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = HeaderStyleComboBox - AnchorSideTop.Side = asrCenter - Left = 10 - Height = 15 - Top = 10 - Width = 91 - BorderSpacing.Left = 10 - Caption = 'HeaderStyleLabel' - ParentColor = False - end - object FlattenHeaders: TCheckBox - AnchorSideLeft.Control = HideHeaderCaptionForFloatingCheckBox - AnchorSideTop.Control = HideHeaderCaptionForFloatingCheckBox - AnchorSideTop.Side = asrBottom - Left = 25 - Height = 19 - Top = 247 - Width = 99 - Caption = 'FlattenHeaders' - ParentShowHint = False - ShowHint = True - TabOrder = 9 - end - object FilledHeaders: TCheckBox - AnchorSideLeft.Control = FlattenHeaders - AnchorSideTop.Control = FlattenHeaders - AnchorSideTop.Side = asrBottom - Left = 25 - Height = 19 - Top = 266 - Width = 91 - Caption = 'FilledHeaders' - ParentShowHint = False - ShowHint = True - TabOrder = 10 - end -end diff --git a/etc/anchordocking/xanchordockoptionsdlg.pas b/etc/anchordocking/xanchordockoptionsdlg.pas deleted file mode 100644 index a6e49341..00000000 --- a/etc/anchordocking/xanchordockoptionsdlg.pas +++ /dev/null @@ -1,369 +0,0 @@ -{ 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. -} -unit xAnchorDockOptionsDlg; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, types, - Forms, Controls, ButtonPanel, StdCtrls, ComCtrls, - xAnchorDocking, xAnchorDockStr; - -type - TAnchorDockOptionsFlag = ( - adofShow_ShowHeader - ); - TAnchorDockOptionsFlags = set of TAnchorDockOptionsFlag; - - { TAnchorDockOptionsFrame } - - TAnchorDockOptionsFrame = class(TFrame) - FlattenHeaders: TCheckBox; - FilledHeaders: TCheckBox; - DragThresholdLabel: TLabel; - DragThresholdTrackBar: TTrackBar; - HeaderAlignLeftLabel: TLabel; - HeaderAlignLeftTrackBar: TTrackBar; - HeaderAlignTopLabel: TLabel; - HeaderAlignTopTrackBar: TTrackBar; - HeaderStyleComboBox: TComboBox; - HeaderStyleLabel: TLabel; - HideHeaderCaptionForFloatingCheckBox: TCheckBox; - ScaleOnResizeCheckBox: TCheckBox; - ShowHeaderCaptionCheckBox: TCheckBox; - ShowHeaderCheckBox: TCheckBox; - SplitterWidthLabel: TLabel; - SplitterWidthTrackBar: TTrackBar; - procedure FrameClick(Sender: TObject); - procedure HeaderStyleComboBoxDrawItem(Control: TWinControl; Index: Integer; - ARect: TRect; {%H-}State: TOwnerDrawState); - procedure OkClick(Sender: TObject); - procedure DragThresholdTrackBarChange(Sender: TObject); - procedure HeaderAlignLeftTrackBarChange(Sender: TObject); - procedure HeaderAlignTopTrackBarChange(Sender: TObject); - procedure ShowHeaderCheckBoxChange(Sender: TObject); - procedure SplitterWidthTrackBarChange(Sender: TObject); - private - FFlags: TAnchorDockOptionsFlags; - FMaster: TAnchorDockMaster; - FSettings: TAnchorDockSettings; - procedure SetFlags(AValue: TAnchorDockOptionsFlags); - procedure SetMaster(const AValue: TAnchorDockMaster); - procedure SetSettings(AValue: TAnchorDockSettings); - procedure UpdateDragThresholdLabel; - procedure UpdateHeaderAlignTopLabel; - procedure UpdateHeaderAlignLeftLabel; - procedure UpdateSplitterWidthLabel; - procedure UpdateHeaderOptions; - procedure ApplyFlags; - public - constructor Create(TheOwner: TComponent); override; - procedure SaveToMaster; - procedure LoadFromMaster; - procedure SaveToSettings(TheSettings: TAnchorDockSettings); - procedure LoadFromSettings(TheSettings: TAnchorDockSettings); - property Master: TAnchorDockMaster read FMaster write SetMaster; - property Settings: TAnchorDockSettings read FSettings write SetSettings; - property Flags: TAnchorDockOptionsFlags read FFlags write SetFlags; - end; - -var - DefaultAnchorDockOptionFlags: TAnchorDockOptionsFlags = []; - -function ShowAnchorDockOptions(ADockMaster: TAnchorDockMaster): TModalResult; - -implementation - -function ShowAnchorDockOptions(ADockMaster: TAnchorDockMaster): TModalResult; -var - Dlg: TForm; - OptsFrame: TAnchorDockOptionsFrame; - BtnPanel: TButtonPanel; -begin - Dlg:=TForm.Create(nil); - try - Dlg.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('ShowAnchorDockOptions'){$ENDIF}; - try - Dlg.Position:=poScreenCenter; - Dlg.AutoSize:=true; - Dlg.Caption:=adrsGeneralDockingOptions; - - OptsFrame:=TAnchorDockOptionsFrame.Create(Dlg); - OptsFrame.Align:=alClient; - OptsFrame.Parent:=Dlg; - OptsFrame.Master:=ADockMaster; - - BtnPanel:=TButtonPanel.Create(Dlg); - BtnPanel.ShowButtons:=[pbOK, pbCancel]; - BtnPanel.OKButton.OnClick:=@OptsFrame.OkClick; - BtnPanel.Parent:=Dlg; - finally - Dlg.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('ShowAnchorDockOptions'){$ENDIF}; - end; - Result:=Dlg.ShowModal; - finally - Dlg.Free; - end; -end; - -{$R *.lfm} - -{ TAnchorDockOptionsFrame } - -procedure TAnchorDockOptionsFrame.HeaderAlignLeftTrackBarChange(Sender: TObject); -begin - UpdateHeaderAlignLeftLabel; -end; - -procedure TAnchorDockOptionsFrame.HeaderAlignTopTrackBarChange(Sender: TObject); -begin - UpdateHeaderAlignTopLabel; -end; - -procedure TAnchorDockOptionsFrame.ShowHeaderCheckBoxChange(Sender: TObject); -begin - UpdateHeaderOptions; -end; - -procedure TAnchorDockOptionsFrame.SplitterWidthTrackBarChange(Sender: TObject); -begin - UpdateSplitterWidthLabel; -end; - -procedure TAnchorDockOptionsFrame.OkClick(Sender: TObject); -begin - if Settings<>nil then - SaveToSettings(Settings); - if Master<>nil then - SaveToMaster; -end; - -procedure TAnchorDockOptionsFrame.HeaderStyleComboBoxDrawItem( - Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); -begin - DrawADHeader(TComboBox(Control).Canvas,TADHeaderStyle(Index),ARect,true); -end; - -procedure TAnchorDockOptionsFrame.FrameClick(Sender: TObject); -begin - -end; - -procedure TAnchorDockOptionsFrame.DragThresholdTrackBarChange(Sender: TObject); -begin - UpdateDragThresholdLabel; -end; - -procedure TAnchorDockOptionsFrame.SetMaster(const AValue: TAnchorDockMaster); -begin - if FMaster=AValue then exit; - FMaster:=AValue; - if Master<>nil then - LoadFromMaster; -end; - -procedure TAnchorDockOptionsFrame.SetFlags(AValue: TAnchorDockOptionsFlags); -begin - if FFlags=AValue then Exit; - FFlags:=AValue; - ApplyFlags; - UpdateHeaderOptions; -end; - -procedure TAnchorDockOptionsFrame.SetSettings(AValue: TAnchorDockSettings); -begin - if FSettings=AValue then Exit; - FSettings:=AValue; - if Settings<>nil then - LoadFromSettings(Settings); -end; - -procedure TAnchorDockOptionsFrame.UpdateDragThresholdLabel; -begin - DragThresholdLabel.Caption:=adrsDragThreshold - +' ('+IntToStr(DragThresholdTrackBar.Position)+')'; -end; - -procedure TAnchorDockOptionsFrame.UpdateHeaderAlignTopLabel; -begin - HeaderAlignTopLabel.Caption:=adrsHeaderAlignTop - +' ('+IntToStr(HeaderAlignTopTrackBar.Position)+')'; -end; - -procedure TAnchorDockOptionsFrame.UpdateHeaderAlignLeftLabel; -begin - HeaderAlignLeftLabel.Caption:=adrsHeaderAlignLeft - +' ('+IntToStr(HeaderAlignLeftTrackBar.Position)+')'; -end; - -procedure TAnchorDockOptionsFrame.UpdateSplitterWidthLabel; -begin - SplitterWidthLabel.Caption:=adrsSplitterWidth - +' ('+IntToStr(SplitterWidthTrackBar.Position)+')'; -end; - -procedure TAnchorDockOptionsFrame.UpdateHeaderOptions; -var - HasHeaders: Boolean; -begin - HasHeaders:=ShowHeaderCheckBox.Checked; - ShowHeaderCaptionCheckBox.Enabled:=HasHeaders; - HideHeaderCaptionForFloatingCheckBox.Enabled:=HasHeaders; - FlattenHeaders.Enabled:=HasHeaders; - FilledHeaders.Enabled:=HasHeaders; -end; - -procedure TAnchorDockOptionsFrame.ApplyFlags; -begin - ShowHeaderCheckBox.Visible:=adofShow_ShowHeader in Flags; - if ShowHeaderCheckBox.Visible then - ShowHeaderCaptionCheckBox.BorderSpacing.Left:=15 - else - ShowHeaderCaptionCheckBox.BorderSpacing.Left:=0; -end; - -constructor TAnchorDockOptionsFrame.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - FFlags:=DefaultAnchorDockOptionFlags; -end; - -procedure TAnchorDockOptionsFrame.SaveToMaster; -var - CurSettings: TAnchorDockSettings; -begin - CurSettings:=TAnchorDockSettings.Create; - try - Master.SaveSettings(CurSettings); - SaveToSettings(CurSettings); - Master.LoadSettings(CurSettings); - finally - CurSettings.Free; - end; -end; - -procedure TAnchorDockOptionsFrame.LoadFromMaster; -var - CurSettings: TAnchorDockSettings; -begin - CurSettings:=TAnchorDockSettings.Create; - try - Master.SaveSettings(CurSettings); - LoadFromSettings(CurSettings); - finally - CurSettings.Free; - end; -end; - -procedure TAnchorDockOptionsFrame.SaveToSettings( - TheSettings: TAnchorDockSettings); -begin - TheSettings.HeaderStyle:=TADHeaderStyle(HeaderStyleComboBox.ItemIndex); - TheSettings.DragTreshold:=DragThresholdTrackBar.Position; - TheSettings.HeaderAlignTop:=HeaderAlignTopTrackBar.Position; - TheSettings.HeaderAlignLeft:=HeaderAlignLeftTrackBar.Position; - TheSettings.SplitterWidth:=SplitterWidthTrackBar.Position; - TheSettings.ScaleOnResize:=ScaleOnResizeCheckBox.Checked; - TheSettings.ShowHeader:=ShowHeaderCheckBox.Checked; - TheSettings.ShowHeaderCaption:=ShowHeaderCaptionCheckBox.Checked; - TheSettings.HideHeaderCaptionFloatingControl:=HideHeaderCaptionForFloatingCheckBox.Checked; - TheSettings.HeaderFlatten:=FlattenHeaders.Checked; - TheSettings.HeaderFilled:=FilledHeaders.Checked; -end; - -procedure TAnchorDockOptionsFrame.LoadFromSettings( - TheSettings: TAnchorDockSettings); -var - hs: TADHeaderStyle; - sl: TStringList; -begin - sl:=TStringList.Create; - try - for hs:=Low(TADHeaderStyle) to High(TADHeaderStyle) do - sl.Add(ADHeaderStyleNames[hs]); - HeaderStyleComboBox.Items.Assign(sl); - finally - sl.Free; - end; - HeaderStyleLabel.Caption:=adrsHeaderStyle; - HeaderStyleComboBox.ItemIndex:=ord(TheSettings.HeaderStyle); - - DragThresholdTrackBar.Hint:= - adrsAmountOfPixelTheMouseHasToDragBeforeDragStarts; - DragThresholdTrackBar.Position:=TheSettings.DragTreshold; - UpdateDragThresholdLabel; - - HeaderAlignTopTrackBar.Hint:= - adrsMoveHeaderToTopWhenWidthHeight100HeaderAlignTop; - HeaderAlignTopTrackBar.Position:=TheSettings.HeaderAlignTop; - UpdateHeaderAlignTopLabel; - - HeaderAlignLeftTrackBar.Hint:= - adrsMoveHeaderToLeftWhenWidthHeight100HeaderAlignLeft; - HeaderAlignLeftTrackBar.Position:=TheSettings.HeaderAlignLeft; - UpdateHeaderAlignLeftLabel; - - SplitterWidthTrackBar.Hint:=adrsSplitterThickness; - SplitterWidthTrackBar.Position:=TheSettings.SplitterWidth; - UpdateSplitterWidthLabel; - - ScaleOnResizeCheckBox.Caption:=adrsScaleOnResize; - ScaleOnResizeCheckBox.Hint:=adrsScaleSubSitesWhenASiteIsResized; - ScaleOnResizeCheckBox.Checked:=TheSettings.ScaleOnResize; - - ShowHeaderCheckBox.Caption:=adrsShowHeaders; - ShowHeaderCheckBox.Hint:= - adrsEachDockedWindowHasAHeaderThatAllowsDraggingHasACo; - ShowHeaderCheckBox.Checked:=TheSettings.ShowHeader; - UpdateHeaderOptions; - - ShowHeaderCaptionCheckBox.Caption:=adrsShowHeaderCaptions; - ShowHeaderCaptionCheckBox.Hint:=adrsShowCaptionsOfDockedControlsInTheHeader; - ShowHeaderCaptionCheckBox.Checked:=TheSettings.ShowHeaderCaption; - - HideHeaderCaptionForFloatingCheckBox.Caption:=adrsNoCaptionsForFloatingSites; - HideHeaderCaptionForFloatingCheckBox.Hint:= - adrsHideHeaderCaptionsForSitesWithOnlyOneDockedControl; - HideHeaderCaptionForFloatingCheckBox.Checked:= - TheSettings.HideHeaderCaptionFloatingControl; - - FlattenHeaders.Checked:=TheSettings.HeaderFlatten; - FlattenHeaders.Caption:=adrsFlattenHeaders; - FlattenHeaders.Hint:=adrsFlattenHeadersHint; - - FilledHeaders.Checked:=TheSettings.HeaderFilled; - FilledHeaders.Caption:=adrsFilledHeaders; - FilledHeaders.Hint:=adrsFilledHeadersHint; -end; - -end. - diff --git a/etc/anchordocking/xanchordockstorage.pas b/etc/anchordocking/xanchordockstorage.pas deleted file mode 100644 index 5975d55c..00000000 --- a/etc/anchordocking/xanchordockstorage.pas +++ /dev/null @@ -1,2178 +0,0 @@ -{ Unit implementing anchor docking storage tree. - - 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. -} -Unit xAnchorDockStorage; - -{$mode objfpc}{$H+} - -interface - -uses - Math, Classes, SysUtils, LCLProc, ExtCtrls, ComCtrls, Forms, Controls, - AvgLvlTree, LazConfigStorage, Laz2_XMLCfg, - xAnchorDockStr; - -const - AnchorDockSplitterName = 'AnchorDockSplitter'; - AnchorDockSiteName = 'AnchorDockSite'; -type - TADLTreeNodeType = ( - adltnNone, - adltnLayout, - adltnControl, - adltnSplitterHorizontal, - adltnSplitterVertical, - adltnPages, - adltnCustomSite - ); - TADLTreeNodeTypes = set of TADLTreeNodeType; - - TADLHeaderPosition = ( - adlhpAuto, - adlhpTop, - adlhpLeft, - adlhpRight, - adlhpBottom - ); - TADLHeaderPositions = set of TADLHeaderPosition; - - EAnchorDockLayoutError = class(Exception); - - { TAnchorDockLayoutTreeNode } - - TAnchorDockLayoutTreeNode = class - private - FAlign: TAlign; - fAnchors: array[TAnchorKind] of string; - FBoundSplitterPos: integer; - FBoundsRect: TRect; - FHeaderPosition: TADLHeaderPosition; - FMonitor: integer; - FName: string; - FNodes: TFPList; // list of TAnchorDockLayoutTreeNode - FNodeType: TADLTreeNodeType; - FParent: TAnchorDockLayoutTreeNode; - FWorkAreaRect: TRect; - FTabPosition: TTabPosition; - FWindowState: TWindowState; - function GetAnchors(Site: TAnchorKind): string; - function GetBottom: integer; - function GetHeight: integer; - function GetLeft: integer; - function GetNodes(Index: integer): TAnchorDockLayoutTreeNode; - function GetRight: integer; - function GetTop: integer; - function GetWidth: integer; - procedure SetAlign(const AValue: TAlign); - procedure SetAnchors(Site: TAnchorKind; const AValue: string); - procedure SetBottom(const AValue: integer); - procedure SetBoundSplitterPos(const AValue: integer); - procedure SetBoundsRect(const AValue: TRect); - procedure SetHeaderPosition(const AValue: TADLHeaderPosition); - procedure SetHeight(const AValue: integer); - procedure SetLeft(const AValue: integer); - procedure SetMonitor(const AValue: integer); - procedure SetName(const AValue: string); - procedure SetNodeType(const AValue: TADLTreeNodeType); - procedure SetParent(const AValue: TAnchorDockLayoutTreeNode); - procedure SetRight(const AValue: integer); - procedure SetWorkAreaRect(const AValue: TRect); - procedure SetTabPosition(const AValue: TTabPosition); - procedure SetTop(const AValue: integer); - procedure SetWidth(const AValue: integer); - procedure SetWindowState(const AValue: TWindowState); - public - constructor Create; - destructor Destroy; override; - procedure Clear; - function IsEqual(Node: TAnchorDockLayoutTreeNode): boolean; - procedure Assign(Node: TAnchorDockLayoutTreeNode); overload; - procedure Assign(AControl: TControl); overload; - procedure LoadFromConfig(Config: TConfigStorage); overload; - procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload; - procedure SaveToConfig(Config: TConfigStorage); overload; - procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload; - function FindChildNode(aName: string; Recursive: boolean): TAnchorDockLayoutTreeNode; - function FindControlNode: TAnchorDockLayoutTreeNode; - procedure CheckConsistency; virtual; - - // simplifying - procedure Simplify(ExistingNames: TStrings); - procedure DeleteNode(ChildNode: TAnchorDockLayoutTreeNode); - function FindNodeBoundSplitter(ChildNode: TAnchorDockLayoutTreeNode; - Side: TAnchorKind): TAnchorDockLayoutTreeNode; - procedure DeleteNodeBoundSplitter(Splitter, ChildNode: TAnchorDockLayoutTreeNode; - Side: TAnchorKind); - procedure DeleteSpiralSplitter(ChildNode: TAnchorDockLayoutTreeNode); - procedure ReplaceWithChildren(ChildNode: TAnchorDockLayoutTreeNode); - - // properties - procedure IncreaseChangeStamp; virtual; - property Name: string read FName write SetName; - property NodeType: TADLTreeNodeType read FNodeType write SetNodeType; - property Parent: TAnchorDockLayoutTreeNode read FParent write SetParent; - property Left: integer read GetLeft write SetLeft; - property Top: integer read GetTop write SetTop; - property Width: integer read GetWidth write SetWidth; - property Height: integer read GetHeight write SetHeight; - property Right: integer read GetRight write SetRight; - property Bottom: integer read GetBottom write SetBottom; - property BoundsRect: TRect read FBoundsRect write SetBoundsRect; - property BoundSplitterPos: integer read FBoundSplitterPos write SetBoundSplitterPos; - property WorkAreaRect: TRect read FWorkAreaRect write SetWorkAreaRect; - property Anchors[Site: TAnchorKind]: string read GetAnchors write SetAnchors; // empty means default (parent) - property Align: TAlign read FAlign write SetAlign; - property WindowState: TWindowState read FWindowState write SetWindowState; - property Monitor: integer read FMonitor write SetMonitor; - property HeaderPosition: TADLHeaderPosition read FHeaderPosition write SetHeaderPosition; - property TabPosition: TTabPosition read FTabPosition write SetTabPosition; - function Count: integer; - function IsSplitter: boolean; - function IsRootWindow: boolean; - property Nodes[Index: integer]: TAnchorDockLayoutTreeNode read GetNodes; default; - end; - - TAnchorDockLayoutTree = class; - - { TAnchorDockLayoutTreeRootNode } - - TAnchorDockLayoutTreeRootNode = class(TAnchorDockLayoutTreeNode) - private - FTree: TAnchorDockLayoutTree; - public - procedure IncreaseChangeStamp; override; - property Tree: TAnchorDockLayoutTree read FTree write FTree; - procedure CheckConsistency; override; - end; - - { TAnchorDockLayoutTree } - - TAnchorDockLayoutTree = class - private - FChangeStamp: int64; - FSavedChangeStamp: int64; - FRoot: TAnchorDockLayoutTreeRootNode; - function GetModified: boolean; - procedure SetModified(const AValue: boolean); - public - constructor Create; - destructor Destroy; override; - procedure Clear; - procedure Assign(Source: TObject); - procedure LoadFromConfig(Config: TConfigStorage); overload; - procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload; - procedure SaveToConfig(Config: TConfigStorage); overload; - procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload; - procedure IncreaseChangeStamp; - property ChangeStamp: int64 read FChangeStamp; - property Modified: boolean read GetModified write SetModified; - property Root: TAnchorDockLayoutTreeRootNode read FRoot; - function NewNode(aParent: TAnchorDockLayoutTreeNode): TAnchorDockLayoutTreeNode; - end; - - { TAnchorDockRestoreLayout } - - TAnchorDockRestoreLayout = class - private - FControlNames: TStrings; - FLayout: TAnchorDockLayoutTree; - procedure SetControlNames(const AValue: TStrings); - public - constructor Create; overload; - constructor Create(aLayout: TAnchorDockLayoutTree); overload; - destructor Destroy; override; - procedure Assign(Source: TAnchorDockRestoreLayout); - function IndexOfControlName(AName: string): integer; - function HasControlName(AName: string): boolean; - procedure RemoveControlName(AName: string); - procedure UpdateControlNames; - procedure LoadFromConfig(Config: TConfigStorage); overload; - procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload; - procedure SaveToConfig(Config: TConfigStorage); overload; - procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload; - property ControlNames: TStrings read FControlNames write SetControlNames; - property Layout: TAnchorDockLayoutTree read FLayout; - end; - - { TAnchorDockRestoreLayouts } - - TAnchorDockRestoreLayouts = class - private - fItems: TFPList; - function GetItems(Index: integer): TAnchorDockRestoreLayout; - public - constructor Create; - destructor Destroy; override; - procedure Clear; - procedure Assign(Source: TAnchorDockRestoreLayouts); - procedure Delete(Index: integer); - function IndexOfName(AControlName: string): integer; - function FindByName(AControlName: string): TAnchorDockRestoreLayout; - procedure Add(Layout: TAnchorDockRestoreLayout; RemoveOther: boolean); - procedure RemoveByName(AControlName: string); - procedure LoadFromConfig(Config: TConfigStorage); overload; - procedure LoadFromConfig(Path: string; Config: TRttiXMLConfig); overload; - procedure SaveToConfig(Config: TConfigStorage); overload; - procedure SaveToConfig(Path: string; Config: TRttiXMLConfig); overload; - function ConfigIsEmpty(Config: TConfigStorage): boolean; - function Count: integer; - property Items[Index: integer]: TAnchorDockRestoreLayout read GetItems; default; - end; - - { TADNameToControl } - - TADNameToControl = class - private - fItems: TStringList; - function IndexOfName(const aName: string): integer; - function GetControl(const aName: string): TControl; - procedure SetControl(const aName: string; const AValue: TControl); - public - constructor Create; - destructor Destroy; override; - function ControlToName(AControl: TControl): string; - property Control[const aName: string]: TControl read GetControl write SetControl; default; - procedure RemoveControl(AControl: TControl); - procedure WriteDebugReport(Msg: string); - end; - -const - ADLTreeNodeTypeNames: array[TADLTreeNodeType] of string = ( - 'None', - 'Layout', - 'Control', - 'SplitterHorizontal', - 'SplitterVertical', - 'Pages', - 'CustomSite' - ); - ADLWindowStateNames: array[TWindowState] of string = ( - 'Normal', - 'Minimized', - 'Maximized', - 'Fullscreen' - ); - ADLHeaderPositionNames: array[TADLHeaderPosition] of string = ( - 'auto', - 'left', - 'top', - 'right', - 'bottom' - ); - ADLTabPostionNames: array[TTabPosition] of string = ( - 'Top', - 'Bottom', - 'Left', - 'Right' - ); - ADLAlignNames: array[TAlign] of string = ( - 'None', - 'Top', - 'Bottom', - 'Left', - 'Right', - 'Client', - 'Custom' - ); - -function NameToADLTreeNodeType(s: string): TADLTreeNodeType; -function NameToADLWindowState(s: string): TWindowState; -function NameToADLHeaderPosition(s: string): TADLHeaderPosition; -function NameToADLTabPosition(s: string): TTabPosition; -function NameToADLAlign(s: string): TAlign; -function dbgs(const NodeType: TADLTreeNodeType): string; overload; - -procedure WriteDebugLayout(Title: string; RootNode: TObject); -function DebugLayoutAsString(RootNode: TObject): string; -procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode); overload; -procedure DebugWriteChildAnchors(RootControl: TWinControl; - OnlyWinControls, OnlyForms: boolean); overload; - -implementation - -function NameToADLTreeNodeType(s: string): TADLTreeNodeType; -begin - for Result:=low(TADLTreeNodeType) to high(TADLTreeNodeType) do - if s=ADLTreeNodeTypeNames[Result] then exit; - Result:=adltnNone; -end; - -function NameToADLWindowState(s: string): TWindowState; -begin - for Result:=low(TWindowState) to high(TWindowState) do - if s=ADLWindowStateNames[Result] then exit; - Result:=wsNormal; -end; - -function NameToADLHeaderPosition(s: string): TADLHeaderPosition; -begin - for Result:=low(TADLHeaderPosition) to high(TADLHeaderPosition) do - if s=ADLHeaderPositionNames[Result] then exit; - Result:=adlhpAuto; -end; - -function NameToADLTabPosition(s: string): TTabPosition; -begin - for Result:=low(TTabPosition) to high(TTabPosition) do - if s=ADLTabPostionNames[Result] then exit; - Result:=tpTop; -end; - -function NameToADLAlign(s: string): TAlign; -begin - for Result:=low(TAlign) to high(TAlign) do - if s=ADLAlignNames[Result] then exit; - Result:=alNone; -end; - -function dbgs(const NodeType: TADLTreeNodeType): string; overload; -begin - Result:=ADLTreeNodeTypeNames[NodeType]; -end; - -procedure WriteDebugLayout(Title: string; RootNode: TObject); -begin - debugln(['WriteDebugLayout ',Title,':']); - debugln(DebugLayoutAsString(RootNode)); -end; - -function DebugLayoutAsString(RootNode: TObject): string; -type - TNodeInfo = record - MinSize: TPoint; - MinSizeValid, MinSizeCalculating: boolean; - MinLeft: integer; - MinLeftValid, MinLeftCalculating: boolean; - MinTop: Integer; - MinTopValid, MinTopCalculating: boolean; - end; - PNodeInfo = ^TNodeInfo; -var - Cols: LongInt; - Rows: LongInt; - LogCols: Integer; - NodeInfos: TPointerToPointerTree;// TObject to PNodeInfo - - procedure InitNodeInfos; - begin - NodeInfos:=TPointerToPointerTree.Create; - end; - - procedure FreeNodeInfos; - var - Item: PNodeInfo; - NodePtr, InfoPtr: Pointer; - begin - NodeInfos.GetFirst(NodePtr,InfoPtr); - repeat - Item:=PNodeInfo(InfoPtr); - if Item=nil then break; - Dispose(Item); - until not NodeInfos.GetNext(NodePtr,NodePtr,InfoPtr); - NodeInfos.Free; - end; - - function GetNodeInfo(Node: TObject): PNodeInfo; - begin - Result:=PNodeInfo(NodeInfos[Node]); - if Result=nil then begin - New(Result); - FillChar(Result^,SizeOf(TNodeInfo),0); - NodeInfos[Node]:=Result; - end; - end; - - procedure w(x,y: Integer; const s: string; MaxX: Integer = 0); - var - i: Integer; - begin - for i:=1 to length(s) do begin - if (MaxX>0) and (x+i>MaxX) then exit; - Result[LogCols*(y-1) + x + i-1]:=s[i]; - end; - end; - - procedure wfillrect(const ARect: TRect; c: char); - var - x: LongInt; - y: LongInt; - begin - for x:=ARect.Left to ARect.Right do - for y:=ARect.Top to ARect.Bottom do - w(x,y,c); - end; - - procedure wrectangle(const ARect: TRect); - begin - w(ARect.Left,ARect.Top,'+'); - w(ARect.Right,ARect.Top,'+'); - w(ARect.Left,ARect.Bottom,'+'); - w(ARect.Right,ARect.Bottom,'+'); - if ARect.Leftnil then - Result:=TAnchorDockLayoutTreeNode(Node).Parent.FindChildNode( - TAnchorDockLayoutTreeNode(Node).Anchors[Side],false); - end; - end; - - function GetAnchorNode(Node: TObject; Side: TAnchorKind): TObject; - var - ADLNode: TAnchorDockLayoutTreeNode; - begin - Result:=nil; - if Node=nil then exit; - if Node is TControl then begin - if not (Side in TControl(Node).Anchors) then exit; - Result:=TControl(Node).AnchorSide[Side].Control; - end else if Node is TAnchorDockLayoutTreeNode then begin - ADLNode:=TAnchorDockLayoutTreeNode(Node); - if ((ADLNode.NodeType=adltnSplitterVertical) - and (Side in [akLeft,akRight])) - or ((ADLNode.NodeType=adltnSplitterHorizontal) - and (Side in [akTop,akBottom])) - then - Result:=nil - else if (ADLNode.Anchors[Side]<>'') then begin - if ADLNode.Parent<>nil then - Result:=ADLNode.Parent.FindChildNode( - ADLNode.Anchors[Side],false); - end else - Result:=GetParentNode(Node); - end; - end; - - function IsSplitter(Node: TObject): boolean; - begin - Result:=(Node is TCustomSplitter) - or ((Node is TAnchorDockLayoutTreeNode) - and (TAnchorDockLayoutTreeNode(Node).IsSplitter)); - end; - - function IsPages(Node: TObject): boolean; - begin - Result:=(Node is TCustomTabControl) - or ((Node is TAnchorDockLayoutTreeNode) - and (TAnchorDockLayoutTreeNode(Node).NodeType in [adltnPages,adltnNone])); - end; - - function GetName(Node: TObject): string; - begin - if Node is TControl then - Result:=TControl(Node).Name - else if Node is TAnchorDockLayoutTreeNode then - Result:=TAnchorDockLayoutTreeNode(Node).Name - else - Result:=DbgSName(Node); - end; - - function GetChildCount(Node: TObject): integer; - begin - if Node is TWinControl then - Result:=TWinControl(Node).ControlCount - else if Node is TAnchorDockLayoutTreeNode then - Result:=TAnchorDockLayoutTreeNode(Node).Count - else - Result:=0; - end; - - function GetChild(Node: TObject; Index: integer): TObject; - begin - if Node is TWinControl then - Result:=TWinControl(Node).Controls[Index] - else if Node is TAnchorDockLayoutTreeNode then - Result:=TAnchorDockLayoutTreeNode(Node).Nodes[Index] - else - Result:=nil; - end; - - function GetMinSize(Node: TObject): TPoint; forward; - - function GetMinPos(Node: TObject; Side: TAnchorKind): Integer; - // calculates left or top position of Node - - function Compute(var MinPosValid, MinPosCalculating: boolean; - var MinPos: Integer): Integer; - - procedure Improve(Neighbour: TObject); - var - NeighbourPos: LongInt; - NeighbourSize: TPoint; - NeighbourLength: LongInt; - begin - if Neighbour=nil then exit; - if GetParentNode(Neighbour)<>GetParentNode(Node) then exit; - NeighbourPos:=GetMinPos(Neighbour,Side); - NeighbourSize:=GetMinSize(Neighbour); - if Side=akLeft then - NeighbourLength:=NeighbourSize.X - else - NeighbourLength:=NeighbourSize.Y; - MinPos:=Max(MinPos,NeighbourPos+NeighbourLength); - end; - - var - Sibling: TObject; - i: Integer; - ParentNode: TObject; - begin - if MinPosCalculating then begin - DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected RootNode=',DbgSName(RootNode)]); - if RootNode is TWinControl then - DebugWriteChildAnchors(TWinControl(RootNode),true,true) - else if RootNode is TAnchorDockLayoutTreeNode then - DebugWriteChildAnchors(TAnchorDockLayoutTreeNode(RootNode)); - RaiseGDBException('circle detected'); - end; - if (not MinPosValid) then begin - MinPosValid:=true; - MinPosCalculating:=true; - Sibling:=GetSiblingNode(Node,Side); - if Sibling<>nil then - Improve(Sibling); - ParentNode:=GetParentNode(Node); - if ParentNode<>nil then begin - for i:=0 to GetChildCount(ParentNode)-1 do begin - Sibling:=GetChild(ParentNode,i); - if Node=GetSiblingNode(Sibling,OppositeAnchor[Side]) then - Improve(Sibling); - end; - end; - MinPosCalculating:=false; - end; - Result:=MinPos; - end; - - var - Info: PNodeInfo; - begin - Info:=GetNodeInfo(Node); - //DebugLn(['GetMinPos ',Node.Name,' ',DbgS(Side),' ',Info^.MinLeftCalculating]); - if Side=akLeft then - Result:=Compute(Info^.MinLeftValid,Info^.MinLeftCalculating,Info^.MinLeft) - else - Result:=Compute(Info^.MinTopValid,Info^.MinTopCalculating,Info^.MinTop); - end; - - function GetChildsMinSize(Node: TObject): TPoint; - // calculate the minimum size needed to draw the content of the node - var - i: Integer; - Child: TObject; - ChildMinSize: TPoint; - begin - //DebugLn(['GetChildsMinSize ',Node.name]); - Result:=Point(0,0); - if IsPages(Node) then begin - // maximum size of all pages - for i:=0 to GetChildCount(Node)-1 do begin - ChildMinSize:=GetMinSize(GetChild(Node,i)); - Result.X:=Max(Result.X,ChildMinSize.X); - Result.Y:=Max(Result.Y,ChildMinSize.Y); - end; - end else begin - for i:=0 to GetChildCount(Node)-1 do begin - Child:=GetChild(Node,i); - ChildMinSize:=GetMinSize(Child); - Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildMinSize.X); - Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildMinSize.Y); - end; - end; - end; - - function GetMinSize(Node: TObject): TPoint; - // calculate the minimum size needed to draw the node - var - ChildMinSize: TPoint; - Info: PNodeInfo; - begin - //DebugLn(['GetMinSize ',Node.name]); - Info:=GetNodeInfo(Node); - if Info^.MinSizeValid then begin - Result:=Info^.MinSize; - exit; - end; - if Info^.MinSizeCalculating then begin - DebugLn(['DebugLayoutAsString.GetMinSize WARNING: anchor circle detected']); - DumpStack; - Result:=Point(1,1); - exit; - end; - Info^.MinSizeCalculating:=true; - Result.X:=2+length(GetName(Node));// border plus name - Result.Y:=2; // border - if GetChildCount(Node)=0 then begin - if IsSplitter(Node) then - Result:=Point(1,1); // splitters don't need captions - end else begin - ChildMinSize:=GetChildsMinSize(Node); - Result.X:=Max(Result.X,ChildMinSize.X+2); - Result.Y:=Max(Result.Y,ChildMinSize.Y+2); - end; - //debugln(['GetMinSize ',GetName(Node),' Splitter=',IsSplitter(Node),' MinSize=',dbgs(Result)]); - Info^.MinSize:=Result; - Info^.MinSizeValid:=true; - Info^.MinSizeCalculating:=false; - end; - - procedure DrawNode(Node: TObject; ARect: TRect); - var - i: Integer; - Child: TObject; - ChildSize: TPoint; - ChildRect: TRect; - AnchorNode: TObject; - begin - DebugLn(['DrawNode Node=',GetName(Node),' ARect=',dbgs(ARect)]); - wrectangle(ARect); - w(ARect.Left+1,ARect.Top,GetName(Node),ARect.Right); - - for i := 0 to GetChildCount(Node)-1 do begin - Child:=GetChild(Node,i); - ChildRect.Left:=ARect.Left+1+GetMinPos(Child,akLeft); - ChildRect.Top:=ARect.Top+1+GetMinPos(Child,akTop); - ChildSize:=GetMinSize(Child); - ChildRect.Right:=ChildRect.Left+ChildSize.X-1; - ChildRect.Bottom:=ChildRect.Top+ChildSize.Y-1; - AnchorNode:=GetAnchorNode(Child,akRight); - if AnchorNode<>nil then begin - if AnchorNode=Node then - ChildRect.Right:=ARect.Right-1 - else if GetParentNode(AnchorNode)=Node then - ChildRect.Right:=ARect.Left+1+GetMinPos(AnchorNode,akLeft)-1; - end; - AnchorNode:=GetAnchorNode(Child,akBottom); - if AnchorNode<>nil then begin - if AnchorNode=Node then - ChildRect.Bottom:=ARect.Bottom-1 - else if GetParentNode(AnchorNode)=Node then - ChildRect.Bottom:=ARect.Top+1+GetMinPos(AnchorNode,akTop)-1; - end; - DrawNode(Child,ChildRect); - if IsPages(Node) then begin - // paint only one page - break; - end; - end; - end; - -var - e: string; - y: Integer; -begin - Cols:=StrToIntDef(Application.GetOptionValue('ldcn-colunms'),79); - Rows:=StrToIntDef(Application.GetOptionValue('ldcn-rows'),20); - - InitNodeInfos; - try - e:=LineEnding; - LogCols:=Cols+length(e); - SetLength(Result,LogCols*Rows); - // fill space - FillChar(Result[1],length(Result),' '); - // add line endings - for y:=1 to Rows do - w(Cols+1,y,e); - // draw node - DrawNode(RootNode,Rect(1,1,Cols,Rows)); - finally - FreeNodeInfos; - end; -end; - -procedure DebugWriteChildAnchors(RootNode: TAnchorDockLayoutTreeNode); - - procedure WriteControl(Node: TAnchorDockLayoutTreeNode; Prefix: string); - var - i: Integer; - a: TAnchorKind; - AnchorControl: TAnchorDockLayoutTreeNode; - AnchorName: String; - begin - DbgOut(Prefix); - DbgOut('"'+Node.Name+'"'); - DbgOut(' Type='+dbgs(Node.NodeType)); - DbgOut(' Bounds=',dbgs(Node.BoundsRect) - ,',w=',dbgs(Node.BoundsRect.Right-Node.BoundsRect.Left) - ,',h=',dbgs(Node.BoundsRect.Bottom-Node.BoundsRect.Top)); - if Node.WindowState<>wsNormal then - DbgOut(' WindowState=',dbgs(Node.WindowState)); - if Node.Monitor<>0 then - DbgOut(' Monitor=',dbgs(Node.Monitor)); - if Node.BoundSplitterPos<>0 then - DbgOut(' SplitterPos=',dbgs(Node.BoundSplitterPos)); - if (Node.WorkAreaRect.Right>0) and (Node.WorkAreaRect.Bottom>0) then - DbgOut(' WorkArea=',dbgs(Node.WorkAreaRect)); - debugln; - for a:=low(TAnchorKind) to high(TAnchorKind) do begin - if Node.Anchors[a]<>'' then - AnchorControl:=Node.Parent.FindChildNode(Node.Anchors[a],False) - else - AnchorControl:=nil; - if AnchorControl=nil then - AnchorName:='Parent' - else - AnchorName:=AnchorControl.Name; - debugln([Prefix,' ',dbgs(a),'=',AnchorName]); - end; - for i:=0 to Node.Count-1 do - WriteControl(Node[i],Prefix+' '); - end; - -var - i: Integer; -begin - debugln(['DebugWriteChildAnchors RootNode="',RootNode.Name,'" Type=',dbgs(RootNode.NodeType)]); - for i:=0 to RootNode.Count-1 do - WriteControl(RootNode[i],' '); -end; - -procedure DebugWriteChildAnchors(RootControl: TWinControl; - OnlyWinControls, OnlyForms: boolean); overload; - - procedure WriteControl(AControl: TControl; Prefix: string); - var - i: Integer; - a: TAnchorKind; - AnchorControl: TControl; - AnchorName: String; - begin - if OnlyWinControls and (not (AControl is TWinControl)) then exit; - if OnlyForms and (not (AControl is TCustomForm)) then exit; - if not AControl.IsControlVisible then exit; - - debugln([Prefix,DbgSName(AControl),' Caption="',dbgstr(AControl.Caption),'" Align=',dbgs(AControl.Align),' Bounds=',dbgs(AControl.BoundsRect)]); - for a:=low(TAnchorKind) to high(TAnchorKind) do begin - AnchorControl:=AControl.AnchorSide[a].Control; - if AnchorControl=AControl.Parent then - AnchorName:='Parent' - else if AnchorControl is TCustomForm then - AnchorName:='"'+AnchorControl.Name+'"' - else - AnchorName:=DbgSName(AnchorControl); - debugln([Prefix,' ',dbgs(a),'=',a in AControl.Anchors,' ',AnchorName,' ',dbgs(a,AControl.AnchorSide[a].Side)]); - end; - if AControl is TWinControl then begin - for i:=0 to TWinControl(AControl).ControlCount-1 do - WriteControl(TWinControl(AControl).Controls[i],Prefix+' '); - end; - end; - -var - i: Integer; -begin - debugln(['WriteChildAnchors ',DbgSName(RootControl),' Caption="',RootControl.Caption,'" Align=',dbgs(RootControl.Align)]); - for i:=0 to RootControl.ControlCount-1 do - WriteControl(RootControl.Controls[i],' '); -end; - -{ TAnchorDockLayoutTreeNode } - -function TAnchorDockLayoutTreeNode.GetNodes(Index: integer - ): TAnchorDockLayoutTreeNode; -begin - Result:=TAnchorDockLayoutTreeNode(FNodes[Index]); -end; - -function TAnchorDockLayoutTreeNode.GetRight: integer; -begin - Result:=FBoundsRect.Right; -end; - -function TAnchorDockLayoutTreeNode.GetHeight: integer; -begin - Result:=FBoundsRect.Bottom-FBoundsRect.Top; -end; - -function TAnchorDockLayoutTreeNode.GetBottom: integer; -begin - Result:=FBoundsRect.Bottom; -end; - -function TAnchorDockLayoutTreeNode.GetAnchors(Site: TAnchorKind): string; -begin - Result:=fAnchors[Site]; -end; - -function TAnchorDockLayoutTreeNode.GetLeft: integer; -begin - Result:=FBoundsRect.Left; -end; - -function TAnchorDockLayoutTreeNode.GetTop: integer; -begin - Result:=FBoundsRect.Top; -end; - -function TAnchorDockLayoutTreeNode.GetWidth: integer; -begin - Result:=FBoundsRect.Right-FBoundsRect.Left; -end; - -procedure TAnchorDockLayoutTreeNode.SetAlign(const AValue: TAlign); -begin - if FAlign=AValue then exit; - FAlign:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetAnchors(Site: TAnchorKind; - const AValue: string); -begin - if Anchors[Site]=AValue then exit; - fAnchors[Site]:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetBottom(const AValue: integer); -begin - if GetBottom=AValue then exit; - FBoundsRect.Bottom:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetBoundSplitterPos(const AValue: integer); -begin - if FBoundSplitterPos=AValue then exit; - FBoundSplitterPos:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetBoundsRect(const AValue: TRect); -begin - if CompareRect(@FBoundsRect,@AValue) then exit; - FBoundsRect:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetHeaderPosition( - const AValue: TADLHeaderPosition); -begin - if FHeaderPosition=AValue then exit; - FHeaderPosition:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetHeight(const AValue: integer); -begin - if Height=AValue then exit; - FBoundsRect.Bottom:=FBoundsRect.Top+AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetLeft(const AValue: integer); -begin - if Left=AValue then exit; - FBoundsRect.Left:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetMonitor(const AValue: integer); -begin - if FMonitor=AValue then exit; - FMonitor:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetName(const AValue: string); -begin - if FName=AValue then exit; - FName:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetNodeType(const AValue: TADLTreeNodeType); -begin - if FNodeType=AValue then exit; - FNodeType:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetParent( - const AValue: TAnchorDockLayoutTreeNode); -begin - if FParent=AValue then exit; - if FParent<>nil then begin - FParent.FNodes.Remove(Self); - FParent.IncreaseChangeStamp; - end; - FParent:=AValue; - if FParent<>nil then - FParent.FNodes.Add(Self); - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetRight(const AValue: integer); -begin - if Right=AValue then exit; - FBoundsRect.Right:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetWorkAreaRect(const AValue: TRect); -begin - if CompareRect(@FWorkAreaRect,@AValue) then exit; - FWorkAreaRect:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetTabPosition(const AValue: TTabPosition); -begin - if FTabPosition=AValue then exit; - FTabPosition:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetTop(const AValue: integer); -begin - if Top=AValue then exit; - FBoundsRect.Top:=AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetWidth(const AValue: integer); -begin - if Width=AValue then exit; - FBoundsRect.Right:=FBoundsRect.Left+AValue; - IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeNode.SetWindowState(const AValue: TWindowState); -begin - if FWindowState=AValue then exit; - FWindowState:=AValue; - IncreaseChangeStamp; -end; - -constructor TAnchorDockLayoutTreeNode.Create; -begin - FNodes:=TFPList.Create; -end; - -destructor TAnchorDockLayoutTreeNode.Destroy; -begin - Parent:=nil; - Clear; - FreeAndNil(FNodes); - inherited Destroy; -end; - -procedure TAnchorDockLayoutTreeNode.Clear; -var - a: TAnchorKind; -begin - Name:=''; - FillByte(FBoundsRect,sizeOf(FBoundsRect),0); - while Count>0 do Nodes[Count-1].Free; - NodeType:=adltnNone; - WindowState:=wsNormal; - Monitor:=0; - Align:=alNone; - HeaderPosition:=adlhpAuto; - TabPosition:=tpTop; - BoundSplitterPos:=0; - WorkAreaRect:=Rect(0,0,0,0); - for a:=low(TAnchorKind) to high(TAnchorKind) do - Anchors[a]:=''; -end; - -function TAnchorDockLayoutTreeNode.IsEqual(Node: TAnchorDockLayoutTreeNode - ): boolean; -var - i: Integer; - a: TAnchorKind; -begin - Result:=false; - if (not CompareRect(@FBoundsRect,@Node.FBoundsRect)) - or (Count<>Node.Count) - or (NodeType<>Node.NodeType) - or (Name<>Node.Name) - or (Align<>Node.Align) - or (WindowState<>Node.WindowState) - or (HeaderPosition<>Node.HeaderPosition) - or (TabPosition<>Node.TabPosition) - or (BoundSplitterPos<>Node.BoundSplitterPos) - or (not CompareRect(@FWorkAreaRect,@Node.FWorkAreaRect)) - then - exit; - for a:=low(TAnchorKind) to high(TAnchorKind) do - if Anchors[a]<>Node.Anchors[a] then exit; - for i:=0 to Count-1 do - if not Nodes[i].IsEqual(Node.Nodes[i]) then exit; - Result:=true; -end; - -procedure TAnchorDockLayoutTreeNode.Assign(Node: TAnchorDockLayoutTreeNode); -var - i: Integer; - Child: TAnchorDockLayoutTreeNode; - a: TAnchorKind; -begin - Name:=Node.Name; - NodeType:=Node.NodeType; - BoundsRect:=Node.BoundsRect; - Align:=Node.Align; - WindowState:=Node.WindowState; - HeaderPosition:=Node.HeaderPosition; - TabPosition:=Node.TabPosition; - BoundSplitterPos:=Node.BoundSplitterPos; - WorkAreaRect:=Node.WorkAreaRect; - Monitor:=Node.Monitor; - for a:=low(TAnchorKind) to high(TAnchorKind) do - Anchors[a]:=Node.Anchors[a]; - while Count>Node.Count do Nodes[Count-1].Free; - for i:=0 to Node.Count-1 do begin - if i=Count then begin - Child:=TAnchorDockLayoutTreeNode.Create; - Child.Parent:=Self; - end else begin - Child:=Nodes[i]; - end; - Child.Assign(Node.Nodes[i]); - end; -end; - -procedure TAnchorDockLayoutTreeNode.Assign(AControl: TControl); -var - AnchorControl: TControl; - a: TAnchorKind; -begin - Name:=AControl.Name; - BoundsRect:=AControl.BoundsRect; - Align:=AControl.Align; - if (AControl.Parent=nil) and (AControl is TCustomForm) then begin - WindowState:=TCustomForm(AControl).WindowState; - Monitor:=TCustomForm(AControl).Monitor.MonitorNum; - WorkAreaRect:=TCustomForm(AControl).Monitor.WorkareaRect; - end else - WindowState:=wsNormal; - if AControl is TCustomTabControl then - TabPosition:=TCustomTabControl(AControl).TabPosition - else - TabPosition:=tpTop; - for a:=low(TAnchorKind) to high(TAnchorKind) do begin - AnchorControl:=AControl.AnchorSide[a].Control; - if (AnchorControl=nil) or (AnchorControl=AControl.Parent) then - Anchors[a]:='' - else if AnchorControl.Parent=AControl.Parent then - Anchors[a]:=AnchorControl.Name; - end; -end; - -procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Config: TConfigStorage); -var - i: Integer; - Child: TAnchorDockLayoutTreeNode; - NewCount: longint; -begin - Clear; - Name:=Config.GetValue('Name',''); - NodeType:=NameToADLTreeNodeType(Config.GetValue('Type',ADLTreeNodeTypeNames[adltnNone])); - Left:=Config.GetValue('Bounds/Left',0); - Top:=Config.GetValue('Bounds/Top',0); - Width:=Config.GetValue('Bounds/Width',0); - Height:=Config.GetValue('Bounds/Height',0); - BoundSplitterPos:=Config.GetValue('Bounds/SplitterPos',0); - Config.GetValue('Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0)); - Anchors[akLeft]:=Config.GetValue('Anchors/Left',''); - Anchors[akTop]:=Config.GetValue('Anchors/Top',''); - Anchors[akRight]:=Config.GetValue('Anchors/Right',''); - Anchors[akBottom]:=Config.GetValue('Anchors/Bottom',''); - Align:=NameToADLAlign(Config.GetValue('Anchors/Align',dbgs(alNone))); - WindowState:=NameToADLWindowState(Config.GetValue('WindowState',ADLWindowStateNames[wsNormal])); - HeaderPosition:=NameToADLHeaderPosition(Config.GetValue('Header/Position',ADLHeaderPositionNames[adlhpAuto])); - TabPosition:=NameToADLTabPosition(Config.GetValue('Header/TabPosition',ADLTabPostionNames[tpTop])); - Monitor:=Config.GetValue('Monitor',0); - NewCount:=Config.GetValue('ChildCount',0); - for i:=1 to NewCount do begin - Config.AppendBasePath('Item'+IntToStr(i)+'/'); - Child:=TAnchorDockLayoutTreeNode.Create; - Child.Parent:=Self; - Child.LoadFromConfig(Config); - Config.UndoAppendBasePath; - end; -end; - -procedure TAnchorDockLayoutTreeNode.LoadFromConfig(Path: string; Config: TRttiXMLConfig); -var - i: Integer; - Child: TAnchorDockLayoutTreeNode; - NewCount: longint; -begin - Clear; - Name:=Config.GetValue(Path+'Name',''); - NodeType:=NameToADLTreeNodeType(Config.GetValue(Path+'Type',ADLTreeNodeTypeNames[adltnNone])); - Left:=Config.GetValue(Path+'Bounds/Left',0); - Top:=Config.GetValue(Path+'Bounds/Top',0); - Width:=Config.GetValue(Path+'Bounds/Width',0); - Height:=Config.GetValue(Path+'Bounds/Height',0); - BoundSplitterPos:=Config.GetValue(Path+'Bounds/SplitterPos',0); - Config.GetValue(Path+'Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0)); - Anchors[akLeft]:=Config.GetValue(Path+'Anchors/Left',''); - Anchors[akTop]:=Config.GetValue(Path+'Anchors/Top',''); - Anchors[akRight]:=Config.GetValue(Path+'Anchors/Right',''); - Anchors[akBottom]:=Config.GetValue(Path+'Anchors/Bottom',''); - Align:=NameToADLAlign(Config.GetValue(Path+'Anchors/Align',dbgs(alNone))); - WindowState:=NameToADLWindowState(Config.GetValue(Path+'WindowState',ADLWindowStateNames[wsNormal])); - HeaderPosition:=NameToADLHeaderPosition(Config.GetValue(Path+'Header/Position',ADLHeaderPositionNames[adlhpAuto])); - TabPosition:=NameToADLTabPosition(Config.GetValue(Path+'Header/TabPosition',ADLTabPostionNames[tpTop])); - Monitor:=Config.GetValue(Path+'Monitor',0); - NewCount:=Config.GetValue(Path+'ChildCount',0); - for i:=1 to NewCount do - begin - Child:=TAnchorDockLayoutTreeNode.Create; - Child.Parent:=Self; - Child.LoadFromConfig(Path+'Item'+IntToStr(i)+'/', Config); - end; -end; - -procedure TAnchorDockLayoutTreeNode.SaveToConfig(Config: TConfigStorage); -var - i: Integer; -begin - Config.SetDeleteValue('Name',Name,''); - Config.SetDeleteValue('Type',ADLTreeNodeTypeNames[NodeType], - ADLTreeNodeTypeNames[adltnNone]); - Config.SetDeleteValue('Bounds/Left',Left,0); - Config.SetDeleteValue('Bounds/Top',Top,0); - Config.SetDeleteValue('Bounds/Width',Width,0); - Config.SetDeleteValue('Bounds/Height',Height,0); - Config.SetDeleteValue('Bounds/SplitterPos',BoundSplitterPos,0); - Config.SetDeleteValue('Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0)); - Config.SetDeleteValue('Anchors/Left',Anchors[akLeft],''); - Config.SetDeleteValue('Anchors/Top',Anchors[akTop],''); - Config.SetDeleteValue('Anchors/Right',Anchors[akRight],''); - Config.SetDeleteValue('Anchors/Bottom',Anchors[akBottom],''); - Config.SetDeleteValue('Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]); - Config.SetDeleteValue('WindowState',ADLWindowStateNames[WindowState], - ADLWindowStateNames[wsNormal]); - Config.SetDeleteValue('Header/Position',ADLHeaderPositionNames[HeaderPosition], - ADLHeaderPositionNames[adlhpAuto]); - Config.SetDeleteValue('Header/TabPosition',ADLTabPostionNames[TabPosition], - ADLTabPostionNames[tpTop]); - Config.SetDeleteValue('Monitor',Monitor,0); - Config.SetDeleteValue('ChildCount',Count,0); - for i:=1 to Count do begin - Config.AppendBasePath('Item'+IntToStr(i)+'/'); - Nodes[i-1].SaveToConfig(Config); - Config.UndoAppendBasePath; - end; -end; - -procedure TAnchorDockLayoutTreeNode.SaveToConfig(Path: string; Config: TRttiXMLConfig); -var - i: Integer; -begin - Config.SetDeleteValue(Path+'Name',Name,''); - Config.SetDeleteValue(Path+'Type',ADLTreeNodeTypeNames[NodeType], - ADLTreeNodeTypeNames[adltnNone]); - Config.SetDeleteValue(Path+'Bounds/Left',Left,0); - Config.SetDeleteValue(Path+'Bounds/Top',Top,0); - Config.SetDeleteValue(Path+'Bounds/Width',Width,0); - Config.SetDeleteValue(Path+'Bounds/Height',Height,0); - Config.SetDeleteValue(Path+'Bounds/SplitterPos',BoundSplitterPos,0); - Config.SetDeleteValue(Path+'Bounds/WorkArea/Rect/',FWorkAreaRect,Rect(0,0,0,0)); - Config.SetDeleteValue(Path+'Anchors/Left',Anchors[akLeft],''); - Config.SetDeleteValue(Path+'Anchors/Top',Anchors[akTop],''); - Config.SetDeleteValue(Path+'Anchors/Right',Anchors[akRight],''); - Config.SetDeleteValue(Path+'Anchors/Bottom',Anchors[akBottom],''); - Config.SetDeleteValue(Path+'Anchors/Align',ADLAlignNames[Align],ADLAlignNames[alNone]); - Config.SetDeleteValue(Path+'WindowState',ADLWindowStateNames[WindowState], - ADLWindowStateNames[wsNormal]); - Config.SetDeleteValue(Path+'Header/Position',ADLHeaderPositionNames[HeaderPosition], - ADLHeaderPositionNames[adlhpAuto]); - Config.SetDeleteValue(Path+'Header/TabPosition',ADLTabPostionNames[TabPosition], - ADLTabPostionNames[tpTop]); - Config.SetDeleteValue(Path+'Monitor',Monitor,0); - Config.SetDeleteValue(Path+'ChildCount',Count,0); - for i:=1 to Count do - Nodes[i-1].SaveToConfig(Path+'Item'+IntToStr(i)+'/', Config); -end; - -function TAnchorDockLayoutTreeNode.FindChildNode(aName: string; - Recursive: boolean): TAnchorDockLayoutTreeNode; -var - i: Integer; -begin - for i:=0 to Count-1 do begin - Result:=Nodes[i]; - if CompareText(aName,Result.Name)=0 then exit; - if Recursive then begin - Result:=Result.FindChildNode(aName,true); - if Result<>nil then exit; - end; - end; - Result:=nil; -end; - -function TAnchorDockLayoutTreeNode.FindControlNode: TAnchorDockLayoutTreeNode; -var - i: Integer; -begin - if NodeType=adltnControl then - Result:=Self - else - for i:=0 to Count-1 do begin - Result:=Nodes[i].FindControlNode; - if Result<>nil then exit; - end; -end; - -procedure TAnchorDockLayoutTreeNode.CheckConsistency; -{ ToDo: check for topological sort } - - procedure CheckCornerIsUnique(Side1: TAnchorKind; Side1AnchorName: string; - Side2: TAnchorKind; Side2AnchorName: string); - var - i: Integer; - Child, Found: TAnchorDockLayoutTreeNode; - begin - Found:=nil; - for i:=0 to Count-1 do begin - Child:=Nodes[i]; - if Child.IsSplitter then continue; - if CompareText(Child.Anchors[Side1],Side1AnchorName)<>0 then continue; - if CompareText(Child.Anchors[Side2],Side2AnchorName)<>0 then continue; - if Found<>nil then - raise EAnchorDockLayoutError.Create('overlapping controls found :'+Found.Name+','+Child.Name); - Found:=Child; - end; - if Found=nil then - raise EAnchorDockLayoutError.Create('empty space found :'+Name+' '+dbgs(Side1)+'='+Side1AnchorName+' '+dbgs(Side2)+'='+Side2AnchorName); - end; - -var - i: Integer; - Child: TAnchorDockLayoutTreeNode; - Side: TAnchorKind; - Sibling: TAnchorDockLayoutTreeNode; -begin - // check parent - if (NodeType=adltnNone) and (Parent<>nil) then - raise EAnchorDockLayoutError.Create('invalid parent, root node'); - if (NodeType=adltnCustomSite) and (Parent<>nil) and (Parent.NodeType<>adltnNone) then - raise EAnchorDockLayoutError.Create('invalid parent, custom sites parent must be nil'); - if (Parent<>nil) and IsSplitter and (Parent.NodeType<>adltnLayout) then - raise EAnchorDockLayoutError.Create('invalid parent, splitter needs parent layout'); - - // check sides - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - if Anchors[Side]<>'' then begin - // anchor must be a sibling - Sibling:=nil; - if Parent<>nil then - Sibling:=Parent.FindChildNode(Anchors[Side],false); - if (Sibling=nil) then - raise EAnchorDockLayoutError.Create( - Format(adrsAnchorNotFoundNodeAnchors, [Name, dbgs(Side), Anchors[Side]])); - // only anchor to splitter - if not Sibling.IsSplitter then - raise EAnchorDockLayoutError.Create( - Format(adrsAnchorIsNotSplitterNodeAnchors, [Name, dbgs(Side), Anchors[Side]])); - // the free sides of a splitter must not be anchored - if ((NodeType=adltnSplitterVertical) and (Side in [akLeft,akRight])) - or ((NodeType=adltnSplitterHorizontal) and (Side in [akTop,akBottom])) - then - raise EAnchorDockLayoutError.Create( - Format(adrsAFreeSideOfASplitterMustNotBeAnchoredNodeTypeAncho, - [Name, ADLTreeNodeTypeNames[NodeType], dbgs(Side), Anchors[Side]])); - // a page must not be anchored - if (Parent.NodeType=adltnPages) then - raise EAnchorDockLayoutError.Create( - Format(adrsAPageMustNotBeAnchoredNodeParentParentTypeAnchors, - [Name, Parent.Name, ADLTreeNodeTypeNames[Parent.NodeType], dbgs(Side), Anchors[Side]])); - // check if anchored to the wrong side of a splitter - if ((Sibling.NodeType=adltnSplitterHorizontal) and (Side in [akLeft,akRight])) - or ((Sibling.NodeType=adltnSplitterVertical) and (Side in [akTop,akBottom])) - then - raise EAnchorDockLayoutError.Create( - Format(adrsAnchorToWrongSideOfSplitterNodeAnchors, [Name, dbgs(Side), Anchors[Side]])); - end; - end; - - // only the root node, pages, layouts and customsite can have children - if (Parent<>nil) and (Count>0) - and (not (NodeType in [adltnLayout,adltnPages,adltnCustomSite])) - then - raise EAnchorDockLayoutError.Create( - Format(adrsNoChildrenAllowedForNodeType, [Name, ADLTreeNodeTypeNames[NodeType]])); - if (NodeType=adltnCustomSite) then begin - if (Count>1) then - raise EAnchorDockLayoutError.Create(Format(adrsCustomDockSiteCanHaveOnlyOneSite, [Name])); - end; - - // check if in each corner sits exactly one child - if NodeType=adltnLayout then - for Side:=low(TAnchorKind) to high(TAnchorKind) do - CheckCornerIsUnique(Side,'',ClockwiseAnchor[Side],''); - - // check grandchild - for i:=0 to Count-1 do begin - Child:=Nodes[i]; - Child.CheckConsistency; - - if (Child.NodeType=adltnSplitterHorizontal) then begin - // check if splitter corners have exactly one sibling - CheckCornerIsUnique(akLeft,Child.Anchors[akLeft],akTop,Child.Name); - CheckCornerIsUnique(akLeft,Child.Anchors[akLeft],akBottom,Child.Name); - CheckCornerIsUnique(akRight,Child.Anchors[akRight],akTop,Child.Name); - CheckCornerIsUnique(akRight,Child.Anchors[akRight],akBottom,Child.Name); - end; - if (Child.NodeType=adltnSplitterVertical) then begin - // check if splitter corners have exactly one sibling - CheckCornerIsUnique(akTop,Child.Anchors[akTop],akLeft,Child.Name); - CheckCornerIsUnique(akTop,Child.Anchors[akTop],akRight,Child.Name); - CheckCornerIsUnique(akBottom,Child.Anchors[akBottom],akLeft,Child.Name); - CheckCornerIsUnique(akBottom,Child.Anchors[akBottom],akRight,Child.Name); - end; - end; -end; - -procedure TAnchorDockLayoutTreeNode.Simplify(ExistingNames: TStrings); -{ Simplification rules: - 1. Control nodes without existing name are deleted. - 2. Empty layouts and pages are deleted - 3. pages and layouts with only one child are removed and its content moved up -} -var - i: Integer; - ChildNode: TAnchorDockLayoutTreeNode; -begin - // simplify children - i:=Count-1; - while i>=0 do begin - ChildNode:=Nodes[i]; - ChildNode.Simplify(ExistingNames); - - if (ChildNode.NodeType=adltnControl) then begin - // leaf node => check if there is a control - if (ChildNode.Name='') or (ExistingNames.IndexOf(ChildNode.Name)<0) then - DeleteNode(ChildNode); - end else if ChildNode.IsSplitter then begin - // splitter - // delete all children - while ChildNode.Count>0 do - ChildNode[0].Free; - end else if ChildNode.NodeType=adltnCustomSite then begin - // custom dock site - end else if ChildNode.Count=0 then begin - // inner node without child => delete - DeleteNode(ChildNode); - end else if (ChildNode.Count=1) - and (ChildNode.NodeType in [adltnLayout,adltnPages]) then begin - // layouts and pages with only one child - // => move grandchildren up and delete childnode - ReplaceWithChildren(ChildNode); - end; - - i:=Min(i,Count)-1; - end; -end; - -procedure TAnchorDockLayoutTreeNode.DeleteNode( - ChildNode: TAnchorDockLayoutTreeNode); -var - i: Integer; - Sibling: TAnchorDockLayoutTreeNode; - Side: TAnchorKind; - Splitter: TAnchorDockLayoutTreeNode; -begin - WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode BEFORE DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self); - ChildNode.Parent:=nil; - try - if not ChildNode.IsSplitter then begin - // delete node bound splitter (= a splitter only anchored to this node) - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - Splitter:=FindNodeBoundSplitter(ChildNode,Side); - if Splitter<>nil then begin - DeleteNodeBoundSplitter(Splitter,ChildNode,OppositeAnchor[Side]); - exit; - end; - end; - - // delete spiral splitter - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - Splitter:=FindChildNode(ChildNode.Anchors[Side],false); - if (Splitter=nil) or (not Splitter.IsSplitter) then break; - if Side=High(TAnchorKind) then begin - DeleteSpiralSplitter(ChildNode); - exit; - end; - end; - end; - finally - // remove references - for i:=0 to Count-1 do begin - Sibling:=Nodes[i]; - for Side:=low(TAnchorKind) to high(TAnchorKind) do - if Sibling.Anchors[Side]=ChildNode.Name then - Sibling.Anchors[Side]:=''; - end; - WriteDebugLayout('TAnchorDockLayoutTreeNode.DeleteNode AFTER DELETE Self='+Name+' Child='+ChildNode.Name+' ',Self); - // free node - ChildNode.Free; - end; -end; - -function TAnchorDockLayoutTreeNode.FindNodeBoundSplitter( - ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind - ): TAnchorDockLayoutTreeNode; -var - AnchorNode: TAnchorDockLayoutTreeNode; - i: Integer; - AnchorName: string; -begin - Result:=nil; - AnchorName:=ChildNode.Anchors[Side]; - if AnchorName='' then exit; - AnchorNode:=FindChildNode(AnchorName,false); - if (AnchorNode=nil) or (not AnchorNode.IsSplitter) then exit; - for i:=0 to Count-1 do - if (Nodes[i]<>ChildNode) and (Nodes[i].Anchors[Side]=AnchorName) then exit; - Result:=AnchorNode; -end; - -procedure TAnchorDockLayoutTreeNode.DeleteNodeBoundSplitter(Splitter, - ChildNode: TAnchorDockLayoutTreeNode; Side: TAnchorKind); -{ delete node bound splitter (= a splitter only anchored to this node) - - Example: Side=akRight - # # - ##################### ######### - ---+S+--------+# ---+# - ---+S|AControl|# ---> ---+# - ---+S+--------+# ---+# - ##################### ######### -} -var - i: Integer; - Sibling: TAnchorDockLayoutTreeNode; -begin - for i:=0 to Count-1 do begin - Sibling:=Nodes[i]; - if Sibling.Anchors[Side]=Splitter.Name then - Sibling.Anchors[Side]:=ChildNode.Anchors[Side]; - end; - DeleteNode(Splitter); -end; - -procedure TAnchorDockLayoutTreeNode.DeleteSpiralSplitter( - ChildNode: TAnchorDockLayoutTreeNode); -{ Merge two splitters and delete one of them. - Prefer the pair with shortest distance between. - - For example: - 3 3 - 11111111113 3 - 2+----+3 3 - 2|Node|3 ---> 111111111 - 2+----+3 2 - 2444444444 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 TAnchorDockLayoutTreeNode; - Side: TAnchorKind; - i: Integer; - Sibling: TAnchorDockLayoutTreeNode; - Keep: TAnchorKind; - DeleteSplitter: TAnchorDockLayoutTreeNode; - NextSide: TAnchorKind; -begin - // find the four splitters - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - Splitters[Side]:=FindChildNode(ChildNode.Anchors[Side],false); - if (Splitters[Side]=nil) or (not Splitters[Side].IsSplitter) then - RaiseGDBException(''); // missing splitter - end; - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - // spiral splitters are connected to each other - NextSide:=ClockwiseAnchor[Side]; - if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then begin - NextSide:=OppositeAnchor[NextSide]; - if Splitters[Side].Anchors[NextSide]<>Splitters[NextSide].Name then - RaiseGDBException(''); // this is not a spiral splitter - end; - end; - // 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 Count-1 do begin - Sibling:=Nodes[i]; - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - if FindChildNode(Sibling.Anchors[Side],false)=DeleteSplitter then - Sibling.Anchors[Side]:=Splitters[Keep].Name; - end; - end; - // longen kept splitter - NextSide:=ClockwiseAnchor[Keep]; - if Splitters[Keep].Anchors[NextSide]<>Splitters[NextSide].Name then - NextSide:=OppositeAnchor[NextSide]; - Splitters[Keep].Anchors[NextSide]:=DeleteSplitter.Anchors[NextSide]; - // delete the splitter - DeleteNode(DeleteSplitter); -end; - -procedure TAnchorDockLayoutTreeNode.ReplaceWithChildren( - ChildNode: TAnchorDockLayoutTreeNode); -{ move all children of ChildNode up. - All anchored to ChildNode (= their parent) use the anchors of ChildNode. - ChildNode is freed. -} -var - GrandChild: TAnchorDockLayoutTreeNode; - Side: TAnchorKind; -begin - WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren BEFORE REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self); - DebugWriteChildAnchors(Self); - while ChildNode.Count>0 do begin - GrandChild:=ChildNode[0]; - GrandChild.Parent:=Self; - OffsetRect(GrandChild.FBoundsRect,ChildNode.Left,ChildNode.Top); - for Side:=low(TAnchorKind) to high(TAnchorKind) do begin - if GrandChild.Anchors[Side]='' then begin - if ((GrandChild.NodeType=adltnSplitterHorizontal) - and (Side in [akTop,akBottom])) - or ((GrandChild.NodeType=adltnSplitterVertical) - and (Side in [akLeft,akRight])) - then - continue; // a free splitter sides => don't anchor it - GrandChild.Anchors[Side]:=ChildNode.Anchors[Side]; - end; - end; - end; - WriteDebugLayout('TAnchorDockLayoutTreeNode.ReplaceWithChildren AFTER REPLACE Self='+Name+' Child='+ChildNode.Name+' ',Self); - ChildNode.Free; - DebugWriteChildAnchors(Self); -end; - -procedure TAnchorDockLayoutTreeNode.IncreaseChangeStamp; -begin - if Parent<>nil then Parent.IncreaseChangeStamp; -end; - -function TAnchorDockLayoutTreeNode.IsSplitter: boolean; -begin - Result:=NodeType in [adltnSplitterHorizontal,adltnSplitterVertical]; -end; - -function TAnchorDockLayoutTreeNode.IsRootWindow: boolean; -begin - Result:=(NodeType in [adltnLayout,adltnPages,adltnControl,adltnCustomSite]) - and ((Parent=nil) or (Parent.NodeType in [adltnNone])); -end; - -function TAnchorDockLayoutTreeNode.Count: integer; -begin - Result:=FNodes.Count; -end; - -{ TAnchorDockLayoutTreeRootNode } - -procedure TAnchorDockLayoutTreeRootNode.IncreaseChangeStamp; -begin - Tree.IncreaseChangeStamp; -end; - -procedure TAnchorDockLayoutTreeRootNode.CheckConsistency; -var - Names: TStringList; - - procedure RaiseNodePath(const Msg: string; Node: TAnchorDockLayoutTreeNode); - var - s: String; - begin - s:=''; - while Node<>nil do begin - if s<>'' then - s:='/'+s; - s:=Node.Name+s; - Node:=Node.Parent; - end; - s:=Msg+s; - end; - - procedure CheckNames(Node: TAnchorDockLayoutTreeNode); - var - i: Integer; - begin - if (Node.Name='') and (Node<>Self) then - RaiseNodePath(adrsEmptyName, Node); - for i:=0 to Names.Count-1 do - if CompareText(Names[i],Node.Name)=0 then - RaiseNodePath(adrsDuplicateName, Node); - Names.Add(Node.Name); - for i:=0 to Node.Count-1 do - CheckNames(Node[i]); - end; - -begin - // check that all names are unique - Names:=TStringList.Create; - try - CheckNames(Self); - finally - Names.Free; - end; - inherited CheckConsistency; -end; - -{ TAnchorDockLayoutTree } - -procedure TAnchorDockLayoutTree.SetModified(const AValue: boolean); -begin - if AValue then - IncreaseChangeStamp - else - FSavedChangeStamp:=FChangeStamp; -end; - -function TAnchorDockLayoutTree.GetModified: boolean; -begin - Result:=FSavedChangeStamp<>FChangeStamp; -end; - -constructor TAnchorDockLayoutTree.Create; -begin - FSavedChangeStamp:=Low(FChangeStamp); - FRoot:=TAnchorDockLayoutTreeRootNode.Create; - Root.FTree:=Self; -end; - -destructor TAnchorDockLayoutTree.Destroy; -begin - FreeAndNil(FRoot); - inherited Destroy; -end; - -procedure TAnchorDockLayoutTree.Clear; -begin - FRoot.Clear; - Modified:=false; -end; - -procedure TAnchorDockLayoutTree.LoadFromConfig(Config: TConfigStorage); -begin - Config.AppendBasePath('Nodes/'); - FRoot.LoadFromConfig(Config); - Config.UndoAppendBasePath; - Root.CheckConsistency; -end; - -procedure TAnchorDockLayoutTree.LoadFromConfig(Path: string; Config: TRttiXMLConfig); -begin - FRoot.LoadFromConfig(Path+'Nodes/',Config); - Root.CheckConsistency; -end; - -procedure TAnchorDockLayoutTree.SaveToConfig(Config: TConfigStorage); -begin - Config.AppendBasePath('Nodes/'); - FRoot.SaveToConfig(Config); - Config.UndoAppendBasePath; -end; - -procedure TAnchorDockLayoutTree.SaveToConfig(Path: string; Config: TRttiXMLConfig); -begin - FRoot.SaveToConfig(Path+'Nodes/',Config); -end; - -procedure TAnchorDockLayoutTree.IncreaseChangeStamp; -begin - if FChangeStamp=0) and (CompareText(aName,fItems[Result])<>0) do - dec(Result); -end; - -function TADNameToControl.GetControl(const aName: string): TControl; -var - i: LongInt; -begin - i:=IndexOfName(aName); - if i>=0 then - Result:=TControl(fItems.Objects[i]) - else - Result:=nil; -end; - -procedure TADNameToControl.SetControl(const aName: string; - const AValue: TControl); -var - i: LongInt; -begin - i:=IndexOfName(aName); - if i>=0 then begin - fItems[i]:=aName; - fItems.Objects[i]:=AValue; - end else - fItems.AddObject(aName,AValue); -end; - -constructor TADNameToControl.Create; -begin - fItems:=TStringList.Create; -end; - -destructor TADNameToControl.Destroy; -begin - FreeAndNil(fItems); - inherited Destroy; -end; - -function TADNameToControl.ControlToName(AControl: TControl): string; -var - i: Integer; -begin - i:=fItems.Count-1; - while i>=0 do begin - if fItems.Objects[i]=AControl then begin - Result:=fItems[i]; - exit; - end; - dec(i); - end; - Result:=''; -end; - -procedure TADNameToControl.RemoveControl(AControl: TControl); -var - i: Integer; -begin - i:=fItems.Count-1; - while i>=0 do begin - if fItems.Objects[i]=AControl then - fItems.Delete(i); - dec(i); - end; -end; - -procedure TADNameToControl.WriteDebugReport(Msg: string); -var - i: Integer; -begin - debugln(['TADNameToControl.WriteDebugReport ',fItems.Count,' ',Msg]); - for i:=0 to fItems.Count-1 do begin - debugln([' ',i,'/',fItems.Count,' "',dbgstr(fItems[i]),'" Control=',dbgsname(TControl(fItems.Objects[i]))]); - end; -end; - -{ TAnchorDockRestoreLayout } - -procedure TAnchorDockRestoreLayout.SetControlNames(const AValue: TStrings); -begin - if FControlNames=AValue then exit; - FControlNames.Assign(AValue); -end; - -constructor TAnchorDockRestoreLayout.Create; -begin - FControlNames:=TStringList.Create; - FLayout:=TAnchorDockLayoutTree.Create; -end; - -constructor TAnchorDockRestoreLayout.Create(aLayout: TAnchorDockLayoutTree); -begin - FControlNames:=TStringList.Create; - FLayout:=aLayout; - UpdateControlNames; -end; - -destructor TAnchorDockRestoreLayout.Destroy; -begin - FreeAndNil(FLayout); - FreeAndNil(FControlNames); - inherited Destroy; -end; - -procedure TAnchorDockRestoreLayout.Assign(Source: TAnchorDockRestoreLayout); -begin - FControlNames.Assign(Source.FControlNames); - FLayout.Assign(Source.FLayout); -end; - -function TAnchorDockRestoreLayout.IndexOfControlName(AName: string): integer; -begin - Result:=fControlNames.Count-1; - while (Result>=0) and (CompareText(AName,FControlNames[Result])<>0) do - dec(Result); -end; - -function TAnchorDockRestoreLayout.HasControlName(AName: string): boolean; -begin - Result:=IndexOfControlName(AName)>=0; -end; - -procedure TAnchorDockRestoreLayout.RemoveControlName(AName: string); -var - i: Integer; -begin - for i:=FControlNames.Count-1 downto 0 do - if CompareText(AName,FControlNames[i])=0 then - FControlNames.Delete(i); -end; - -procedure TAnchorDockRestoreLayout.UpdateControlNames; - - procedure Check(Node: TAnchorDockLayoutTreeNode); - var - i: Integer; - begin - if (Node.Name<>'') and (Node.NodeType in [adltnControl,adltnCustomSite]) - and (not HasControlName(Node.Name)) then - FControlNames.Add(Node.Name); - for i:=0 to Node.Count-1 do - Check(Node[i]); - end; - -begin - FControlNames.Clear; - Check(Layout.Root); -end; - -procedure TAnchorDockRestoreLayout.LoadFromConfig(Config: TConfigStorage); -var - i: Integer; - AName: string; - Node: TAnchorDockLayoutTreeNode; -begin - FControlNames.Delimiter:=','; - FControlNames.StrictDelimiter:=true; - FControlNames.DelimitedText:=Config.GetValue('Names',''); - Layout.LoadFromConfig(Config); - for i:=FControlNames.Count-1 downto 0 do begin - AName:=FControlNames[i]; - if (AName<>'') and IsValidIdent(AName) - and (Layout.Root<>nil) then begin - Node:=Layout.Root.FindChildNode(AName,true); - if (Node<>nil) and (Node.NodeType in [adltnControl,adltnCustomSite]) then - continue; - end; - FControlNames.Delete(i); - end; -end; - -procedure TAnchorDockRestoreLayout.LoadFromConfig(Path: string; Config: TRttiXMLConfig); -var - i: Integer; - AName: string; - Node: TAnchorDockLayoutTreeNode; -begin - FControlNames.Delimiter:=','; - FControlNames.StrictDelimiter:=true; - FControlNames.DelimitedText:=Config.GetValue(Path+'Names',''); - Layout.LoadFromConfig(Path, Config); - for i:=FControlNames.Count-1 downto 0 do begin - AName:=FControlNames[i]; - if (AName<>'') and IsValidIdent(AName) - and (Layout.Root<>nil) then begin - Node:=Layout.Root.FindChildNode(AName,true); - if (Node<>nil) and (Node.NodeType in [adltnControl,adltnCustomSite]) then - continue; - end; - FControlNames.Delete(i); - end; -end; - -procedure TAnchorDockRestoreLayout.SaveToConfig(Config: TConfigStorage); -begin - FControlNames.Delimiter:=','; - FControlNames.StrictDelimiter:=true; - Config.SetDeleteValue('Names',FControlNames.DelimitedText,''); - Layout.SaveToConfig(Config); -end; - -procedure TAnchorDockRestoreLayout.SaveToConfig(Path: string; Config: TRttiXMLConfig); -begin - FControlNames.Delimiter:=','; - FControlNames.StrictDelimiter:=true; - Config.SetDeleteValue(Path+'Names',FControlNames.DelimitedText,''); - Layout.SaveToConfig(Path, Config); -end; - -{ TAnchorDockRestoreLayouts } - -function TAnchorDockRestoreLayouts.GetItems(Index: integer): TAnchorDockRestoreLayout; -begin - Result:=TAnchorDockRestoreLayout(fItems[Index]); -end; - -constructor TAnchorDockRestoreLayouts.Create; -begin - fItems:=TFPList.Create; -end; - -destructor TAnchorDockRestoreLayouts.Destroy; -begin - Clear; - FreeAndNil(fItems); - inherited Destroy; -end; - -procedure TAnchorDockRestoreLayouts.Clear; -var - i: Integer; -begin - for i:=0 to fItems.Count-1 do - TObject(fItems[i]).Free; - fItems.Clear; -end; - -procedure TAnchorDockRestoreLayouts.Assign(Source: TAnchorDockRestoreLayouts); -var - i: Integer; - xNew: TAnchorDockRestoreLayout; -begin - Clear; - for i := 0 to Source.Count-1 do - begin - xNew := TAnchorDockRestoreLayout.Create; - Add(xNew, False); - xNew.Assign(Source[i]); - end; -end; - -procedure TAnchorDockRestoreLayouts.Delete(Index: integer); -begin - TObject(fItems[Index]).Free; - fItems.Delete(Index); -end; - -function TAnchorDockRestoreLayouts.IndexOfName(AControlName: string): integer; -begin - Result:=Count-1; - while (Result>=0) and not Items[Result].HasControlName(AControlName) do - dec(Result); -end; - -function TAnchorDockRestoreLayouts.FindByName(AControlName: string - ): TAnchorDockRestoreLayout; -var - i: LongInt; -begin - i:=IndexOfName(AControlName); - if i>=0 then - Result:=Items[i] - else - Result:=nil; -end; - -procedure TAnchorDockRestoreLayouts.Add(Layout: TAnchorDockRestoreLayout; - RemoveOther: boolean); -var - i: Integer; -begin - if Layout=nil then exit; - if RemoveOther then begin - for i:=0 to Layout.ControlNames.Count-1 do - RemoveByName(Layout.ControlNames[i]); - end; - fItems.Add(Layout); -end; - -procedure TAnchorDockRestoreLayouts.RemoveByName(AControlName: string); -var - i: Integer; - Layout: TAnchorDockRestoreLayout; -begin - for i:=Count-1 downto 0 do begin - Layout:=Items[i]; - Layout.RemoveControlName(AControlName); - if Layout.ControlNames.Count=0 then - Delete(i); - end; -end; - -procedure TAnchorDockRestoreLayouts.LoadFromConfig(Config: TConfigStorage); -var - NewCount: longint; - NewItem: TAnchorDockRestoreLayout; - i: Integer; -begin - Clear; - NewCount:=Config.GetValue('Count',0); - for i:=1 to NewCount do begin - NewItem:=TAnchorDockRestoreLayout.Create; - Config.AppendBasePath('Item'+IntToStr(i+1)+'/'); - try - NewItem.LoadFromConfig(Config); - finally - Config.UndoAppendBasePath; - end; - if NewItem.ControlNames.Count>0 then - fItems.Add(NewItem) - else - NewItem.Free; - end; -end; - -procedure TAnchorDockRestoreLayouts.SaveToConfig(Config: TConfigStorage); -var - i: Integer; -begin - Config.SetDeleteValue('Count',Count,0); - for i:=0 to Count-1 do begin - Config.AppendBasePath('Item'+IntToStr(i+1)+'/'); - try - Items[i].SaveToConfig(Config); - finally - Config.UndoAppendBasePath; - end; - end; -end; - -procedure TAnchorDockRestoreLayouts.LoadFromConfig(Path: string; Config: TRttiXMLConfig); -var - NewCount: longint; - NewItem: TAnchorDockRestoreLayout; - i: Integer; -begin - Clear; - NewCount:=Config.GetValue(Path+'Count',0); - for i:=1 to NewCount do begin - NewItem:=TAnchorDockRestoreLayout.Create; - NewItem.LoadFromConfig(Path+'Item'+IntToStr(i+1)+'/', Config); - if NewItem.ControlNames.Count>0 then - fItems.Add(NewItem) - else - NewItem.Free; - end; -end; - -procedure TAnchorDockRestoreLayouts.SaveToConfig(Path: string; Config: TRttiXMLConfig); -var - i: Integer; -begin - Config.SetDeleteValue(Path+'Count',Count,0); - for i:=0 to Count-1 do begin - Items[i].SaveToConfig(Path+'Item'+IntToStr(i+1)+'/', Config); - end; -end; - -function TAnchorDockRestoreLayouts.ConfigIsEmpty(Config: TConfigStorage): boolean; -begin - Result:=Config.GetValue('Count',0)<=0; -end; - -function TAnchorDockRestoreLayouts.Count: integer; -begin - Result:=fItems.Count; -end; - -end. - diff --git a/etc/anchordocking/xanchordockstr.pas b/etc/anchordocking/xanchordockstr.pas deleted file mode 100644 index 62df83c8..00000000 --- a/etc/anchordocking/xanchordockstr.pas +++ /dev/null @@ -1,128 +0,0 @@ -{ 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. -} -unit xAnchorDockStr; - -{$mode objfpc}{$H+} - -interface - -resourcestring - adrsClose = 'Close'; - adrsQuit = 'Quit %s'; - adrsTabPosition = 'Tab position'; - adrsMovePageRight = 'Move page right'; - adrsMovePageRightmost = 'Move page rightmost'; - adrsUndock = 'Undock'; - adrsHeaderPosition = 'Header position'; - adrsEnlargeSide = 'Enlarge %s side'; - adrsMerge = 'Merge'; - adrsEnlarge = 'Enlarge'; - adrsAutomatically = 'Automatically'; - adrsLeft = 'left'; - adrsTop = 'top'; - adrsRight = 'right'; - adrsBottom = 'bottom'; - adrsLocked = 'Locked'; - adrsDockingOptions = 'Docking options'; - adrsMovePageLeft = 'Move page left'; - adrsMovePageLeftmost = 'Move page leftmost'; - adrsRequestedButCreated = '%s requested, but %s created'; - adrsDragAndDockC = 'Use the mouse to drag and dock window "%s"'; - adrsMissingControlName = 'missing control name'; - adrsModalFormsCanNotBeMadeDockable = 'modal forms can not be made dockable'; - adrsControlIsAlreadyADocksite = 'control is already a docksite'; - adrsNotSupportedHasParent = 'Not supported: %s has parent %s'; - adrsAnchorNotFoundNodeAnchors = 'Anchor not found: Node="%s" Anchors[%s]="%s"'; - adrsAnchorIsNotSplitterNodeAnchors = 'Anchor is not splitter: Node="%s" Anchors[%s]="%s"'; - adrsAFreeSideOfASplitterMustNotBeAnchoredNodeTypeAncho = 'A free side of a ' - +'splitter must not be anchored: Node="%s" Type=%s Anchors[%s]="%s"'; - adrsAPageMustNotBeAnchoredNodeParentParentTypeAnchors = 'A page must not be ' - +'anchored: Node="%s" Parent=%s ParentType=%s Anchors[%s]="%s"'; - adrsAnchorToWrongSideOfSplitterNodeAnchors = 'Anchor to wrong side of ' - +'splitter: Node="%s" Anchors[%s]="%s"'; - adrsNoChildrenAllowedForNodeType = 'No children allowed for Node="%s" Type=%s'; - adrsCustomDockSiteCanHaveOnlyOneSite = 'Custom dock site "%s" can have only one site.'; - adrsEmptyName = 'Empty name: '; - adrsDuplicateName = 'Duplicate name: '; - adrsDragThreshold = 'Drag threshold'; - adrsGeneralDockingOptions = 'General docking options'; - adrsAmountOfPixelTheMouseHasToDragBeforeDragStarts = 'Amount of pixel the ' - +'mouse has to drag before drag starts'; - adrsHeaderAlignTop = 'Header align top'; - adrsMoveHeaderToTopWhenWidthHeight100HeaderAlignTop = 'Move header to top ' - +'when (Width/Height)*100<=HeaderAlignTop'; - adrsHeaderAlignLeft = 'Header align left'; - adrsMoveHeaderToLeftWhenWidthHeight100HeaderAlignLeft = 'Move header to ' - +'left when (Width/Height)*100>=HeaderAlignLeft'; - adrsSplitterWidth = 'Splitter width'; - adrsSplitterThickness = 'Splitter thickness'; - adrsScaleOnResize = 'Scale on resize'; - adrsScaleSubSitesWhenASiteIsResized = - 'Scale sub sites when a site is resized'; - adrsShowHeaderCaptions = 'Show header captions'; - adrsShowCaptionsOfDockedControlsInTheHeader = 'Show captions of docked ' - +'controls in the header'; - adrsShowHeaders = 'Show headers'; - adrsEachDockedWindowHasAHeaderThatAllowsDraggingHasACo = 'Each docked window' - +' has a header that allows dragging, has a context menu with extra layout' - +' functions and shows the caption of the docked window'; - adrsNoCaptionsForFloatingSites = 'No captions for floating sites'; - adrsHideHeaderCaptionsForSitesWithOnlyOneDockedControl = 'Hide header ' - +'captions for sites with only one docked control, as that is already ' - +'shown in the normal window title'; - adrsErrorWritingWindowLayoutToFile = 'Error writing window layout to file "%s"%s%s'; - adrsToUseAnchordockingYouMustFirstUninstall = 'To use anchordocking you ' - +'must first uninstall %s'; - adrsThereIsAnotherDockMasterInstalledOnlyOneDockingPac = 'There is another ' - +'dock master installed. Only one docking package can be installed at a ' - +'time. Please uninstall the other dock master %s and restart the IDE'; - adrsLoadWindowLayoutFromFileXml = 'Load window layout from file (*.xml)'; - adrsSaveWindowLayoutAsDefault = 'Save window layout as default'; - adrsSaveWindowLayoutToFile = 'Save window layout to file ...'; - adrsLoadWindowLayoutFromFile = 'Load window layout from file ...'; - adrsRestoreDefaultLayout = 'Restore default layout'; - adrsErrorLoadingWindowLayoutFromFile = 'Error loading window layout from ' - +'file "%s"%s%s'; - adrsError = 'Error'; - adrsSaveWindowLayoutToFileXml = 'Save window layout to file (*.xml)'; - adrsAllFiles = 'All files'; - adrsAnchorDockingLayout = 'Anchor Docking Layout'; - adrsDockingAnchordocking = 'Docking / Anchordocking'; - adrsHeaderStyle = 'Header Style:'; - - adrsFlattenHeaders = 'Flatten headers'; - adrsFlattenHeadersHint = 'Flatten headers of docked controls'; - adrsFilledHeaders = 'Fill headers'; - adrsFilledHeadersHint = 'Fill headers of docked controls'; - -implementation - -end. - diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi index 1365588d..f781403b 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -117,22 +117,25 @@ - + - + - + - + - + - + + + + diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr index 383905cb..d8940306 100644 --- a/lazproj/coedit.lpr +++ b/lazproj/coedit.lpr @@ -6,11 +6,12 @@ uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} - Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_sharedres, - ce_observer, ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent, - ce_symstring, ce_staticmacro, ce_inspectors, ce_editoroptions, ce_dockoptions, - ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject, ce_dialogs, - ce_dubprojeditor, ce_controls, ce_dfmt, ce_lcldragdrop; + Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, anchordockpkg, + ce_sharedres, ce_observer, ce_libman, ce_tools, ce_dcd, ce_main, + ce_writableComponent, ce_symstring, ce_staticmacro, ce_inspectors, + ce_editoroptions, ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes, + ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, + ce_lcldragdrop; {$R *.res} diff --git a/src/ce_dockoptions.pas b/src/ce_dockoptions.pas index c735a4a7..54b0c365 100644 --- a/src/ce_dockoptions.pas +++ b/src/ce_dockoptions.pas @@ -5,8 +5,8 @@ unit ce_dockoptions; interface uses - Classes, SysUtils, xAnchorDocking, xAnchorDockOptionsDlg, XMLPropStorage, - xAnchorDockStr, Forms, Controls, ce_observer, ce_interfaces; + Classes, SysUtils, AnchorDocking, AnchorDockOptionsDlg, XMLPropStorage, + AnchorDockStr, Forms, Controls, ce_observer, ce_interfaces; type @@ -39,7 +39,7 @@ constructor TDockOptionsEditor.Create(TheOwner: TComponent); begin inherited; fBackup := TXMLConfigStorage.Create('', False); - Master := xAnchorDocking.DockMaster; + Master := AnchorDocking.DockMaster; // HeaderAlignLeftTrackBar.OnChange := @doChanged; HeaderAlignTopTrackBar.OnChange := @doChanged; diff --git a/src/ce_main.lfm b/src/ce_main.lfm index 51b5afed..805f6294 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -1468,7 +1468,7 @@ object CEMainForm: TCEMainForm OnCloseQuery = FormCloseQuery OnDropFiles = FormDropFiles ShowHint = True - LCLVersion = '1.6.0.2' + LCLVersion = '1.6.0.4' object mainMenu: TMainMenu Images = imgList top = 1 diff --git a/src/ce_main.pas b/src/ce_main.pas index 21d1b2ab..127178f8 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, LazFileUtils, SynEditKeyCmds, SynHighlighterLFM, Forms, StdCtrls, - xAnchorDocking, xAnchorDockStorage, xAnchorDockOptionsDlg, Controls, Graphics, strutils, + AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls, Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process, XMLPropStorage, SynExportHTML, ce_common, ce_dmdwrap, ce_nativeproject, ce_dcd, ce_synmemo, ce_writableComponent, ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf, diff --git a/src/ce_messages.pas b/src/ce_messages.pas index d241a608..f1f152af 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, - lcltype, ce_widget, ActnList, Menus, clipbrd, xAnchorDocking, TreeFilterEdit, + lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, TreeFilterEdit, Buttons, math, process, ce_writableComponent, ce_common, ce_synmemo, GraphType, ce_dlangutils, ce_interfaces, ce_observer, ce_symstring, ce_processes, ce_sharedres, EditBtn; diff --git a/src/ce_widget.lfm b/src/ce_widget.lfm index 15406b97..3c1a9711 100644 --- a/src/ce_widget.lfm +++ b/src/ce_widget.lfm @@ -9,7 +9,7 @@ object CEWidget: TCEWidget ClientWidth = 332 ShowHint = True ShowInTaskBar = stNever - LCLVersion = '1.6.0.2' + LCLVersion = '1.6.0.4' object Back: TPanel Left = 0 Height = 121 diff --git a/src/ce_widget.pas b/src/ce_widget.pas index 2eca6d9b..fc6028f3 100644 --- a/src/ce_widget.pas +++ b/src/ce_widget.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, ActnList, Menus, - xAnchorDocking, ce_interfaces; + AnchorDocking, ce_interfaces; type