diff --git a/etc/anchordocking/README.txt b/etc/anchordocking/README.txt new file mode 100644 index 00000000..ec680535 --- /dev/null +++ b/etc/anchordocking/README.txt @@ -0,0 +1,8 @@ +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 new file mode 100644 index 00000000..41eb4148 --- /dev/null +++ b/etc/anchordocking/xanchordocking.pas @@ -0,0 +1,6444 @@ +{ 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 new file mode 100644 index 00000000..aee621a6 --- /dev/null +++ b/etc/anchordocking/xanchordockoptionsdlg.lfm @@ -0,0 +1,248 @@ +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 new file mode 100644 index 00000000..a6e49341 --- /dev/null +++ b/etc/anchordocking/xanchordockoptionsdlg.pas @@ -0,0 +1,369 @@ +{ 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 new file mode 100644 index 00000000..5975d55c --- /dev/null +++ b/etc/anchordocking/xanchordockstorage.pas @@ -0,0 +1,2178 @@ +{ 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 new file mode 100644 index 00000000..62df83c8 --- /dev/null +++ b/etc/anchordocking/xanchordockstr.pas @@ -0,0 +1,128 @@ +{ 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 986cc121..1365588d 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -31,7 +31,7 @@ - + @@ -73,7 +73,7 @@ - + @@ -117,25 +117,22 @@ - + - + - + - + - + - - - - + @@ -390,7 +387,7 @@ - + diff --git a/src/ce_dockoptions.pas b/src/ce_dockoptions.pas index 54b0c365..c735a4a7 100644 --- a/src/ce_dockoptions.pas +++ b/src/ce_dockoptions.pas @@ -5,8 +5,8 @@ unit ce_dockoptions; interface uses - Classes, SysUtils, AnchorDocking, AnchorDockOptionsDlg, XMLPropStorage, - AnchorDockStr, Forms, Controls, ce_observer, ce_interfaces; + Classes, SysUtils, xAnchorDocking, xAnchorDockOptionsDlg, XMLPropStorage, + xAnchorDockStr, Forms, Controls, ce_observer, ce_interfaces; type @@ -39,7 +39,7 @@ constructor TDockOptionsEditor.Create(TheOwner: TComponent); begin inherited; fBackup := TXMLConfigStorage.Create('', False); - Master := AnchorDocking.DockMaster; + Master := xAnchorDocking.DockMaster; // HeaderAlignLeftTrackBar.OnChange := @doChanged; HeaderAlignTopTrackBar.OnChange := @doChanged; diff --git a/src/ce_main.pas b/src/ce_main.pas index 07f1aedb..61343084 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, LazFileUtils, SynEditKeyCmds, SynHighlighterLFM, Forms, StdCtrls, - AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls, Graphics, strutils, + xAnchorDocking, xAnchorDockStorage, xAnchorDockOptionsDlg, 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, @@ -1172,8 +1172,8 @@ begin LoadLastDocsAndProj; // http://bugs.freepascal.org/view.php?id=29475 - // TODO-cgonnawork: activate this when Laz 1.6 released. - // DockMaster.ResetSplitter; + // TODO-cgonnawork: when Laz 1.6 is rlzd, remove etc/anchordocking and use Laz package + DockMaster.ResetSplitters; fFirstShown := true; end; diff --git a/src/ce_messages.pas b/src/ce_messages.pas index f1f152af..d241a608 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, AnchorDocking, TreeFilterEdit, + lcltype, ce_widget, ActnList, Menus, clipbrd, xAnchorDocking, 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 92ff6da9..15406b97 100644 --- a/src/ce_widget.lfm +++ b/src/ce_widget.lfm @@ -10,7 +10,6 @@ object CEWidget: TCEWidget ShowHint = True ShowInTaskBar = stNever LCLVersion = '1.6.0.2' - Visible = False object Back: TPanel Left = 0 Height = 121 diff --git a/src/ce_widget.pas b/src/ce_widget.pas index fc6028f3..2eca6d9b 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, - AnchorDocking, ce_interfaces; + xAnchorDocking, ce_interfaces; type diff --git a/wiki/wiki.todo.txt b/wiki/wiki.todo.txt index 614a8b49..e69de29b 100644 --- a/wiki/wiki.todo.txt +++ b/wiki/wiki.todo.txt @@ -1,2 +0,0 @@ -- setup: screenshots. -- project config widget, base/overridden. Note about pre/post build proc as their options cant be overridden. \ No newline at end of file diff --git a/wiki/wiki.txt b/wiki/wiki.txt index bd266300..75b25b67 100644 --- a/wiki/wiki.txt +++ b/wiki/wiki.txt @@ -691,6 +691,7 @@ These options are defined per-configuration. They define the options of two processes and a bunch of commands, respectively executed before and after the compilation. These options are defined per-configuration. +These options are not compatible with the system of _base_ & _overridden_ configuration. ![](https://raw.githubusercontent.com/BBasile/CoeditWikiData/master/projconf.preprocess1.png) @@ -717,6 +718,7 @@ The _executable_ field is not present because it relies on the project parameter If the output is piped then the [process input widget][lnk_widg_procinp] can be used to pass the input to the program being executed. These options are defined per-configuration. +These options are not compatible with the system of _base_ & _overridden_ configuration. #### All categories @@ -812,7 +814,7 @@ A few typical examples: - launch a console with its working directory set to the project file directory. - analyze the current document in _Dscanner_. (see the tutorials). - generate the documentation for all the project sources. (see the tutorials). -- launch a custom build tool (_make_, _DUB_). +- launch a custom build tool. - launch a script that will zip and upload the latest project build. ![](https://raw.githubusercontent.com/BBasile/CoeditWikiData/master/toolseditor1.png)