diff --git a/.gitattributes b/.gitattributes index b90a1af962..6281f567ac 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3292,9 +3292,6 @@ docs/xml/lcl/lcltype.xml svneol=LF#text/xml eol=lf docs/xml/lcl/lclunicodedata.xml svneol=native#text/plain docs/xml/lcl/lclversion.xml svneol=native#text/plain docs/xml/lcl/lconvencoding.xml svneol=LF#text/plain eol=lf -docs/xml/lcl/ldockctrl.xml svneol=LF#text/xml eol=lf -docs/xml/lcl/ldockctrledit.xml svneol=LF#text/xml eol=lf -docs/xml/lcl/ldocktree.xml svneol=LF#text/xml eol=lf docs/xml/lcl/lmessages.xml svneol=LF#text/xml eol=lf docs/xml/lcl/lresources.xml svneol=LF#text/xml eol=lf docs/xml/lcl/maps.xml svneol=native#text/plain @@ -5887,10 +5884,6 @@ lcl/lclstrconsts.pas svneol=native#text/pascal lcl/lcltype.pp svneol=native#text/pascal lcl/lclunicodedata.pas svneol=native#text/pascal lcl/lclversion.pas svneol=native#text/pascal -lcl/ldockctrl.pas svneol=native#text/pascal -lcl/ldockctrledit.lfm svneol=native#text/plain -lcl/ldockctrledit.pas svneol=native#text/pascal -lcl/ldocktree.pas svneol=native#text/pascal lcl/lmessages.pp svneol=native#text/pascal lcl/lresources.pp svneol=native#text/pascal lcl/maps.pp svneol=native#text/pascal diff --git a/docs/xml/lcl/ldockctrl.xml b/docs/xml/lcl/ldockctrl.xml deleted file mode 100644 index 927018758a..0000000000 --- a/docs/xml/lcl/ldockctrl.xml +++ /dev/null @@ -1,828 +0,0 @@ - - - - - - This unit contains visual components for docking and streaming - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TCustomLazControlDocker - a component to connect a form to the TLazDockingManager - -

- TCustomLazControlDocker - a component to connect a form to the TLazDockingManager -

-

When the control gets visible TCustomLazControlDocker restores the layout.

-

Before the control gets invisible, TCustomLazControlDocker saves the layout

- - - - - - - - TCustomLazDockingManager - base class for TLazDockingManager, a class for managing docking controls - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Remove - detaches any controls attached to the specified docker, then nullifies the docker - - - - - - - - - - - - Add - provided the specified Docker is of the correct type, sets up the control to use a docking manager and returns an integer pointer - - - - - - - - - - - - - - - - Create - constructor for TCustomLazDockingManager: calls inherited Create then sets up lists, managers and configurations - - - - TComponent.Create - - - - - - - - - - Destroy - destructor for TCustomLazDockingManager: frees dockers, managers and configs, then calls inherited Destroy - - - - - TComponent.Destroy - - - - - - FindDockerByName - returns the identity of a Control Docker given the Docker name - - - - - - - - - - - - - - - - - - - - CreateUniqueName - returns a unique name given a string name - - - - - - - - - - - - - - - - - - - - Manager - the TAnchoredDockManager for the current class - - - - - - - DockerCount - the number of dockers in the list - - - - - - - Dockers - the indexed list of dockers - - - - - - - - - - - TLazDockingManager - class of TCustomLazDockingManager - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - UpdatePopupMenu - alters the popup menu to reflect changes - - - - - - - - Loaded - calls inherited method then calls UpdatePopupMenu - - - - - TComponent.Loaded - - - - - - ShowDockingEditor - makes a popup docking editor dialog appear - - - - - - - - GetLocalizedName - returns a string with the localised name for the docker - - - - - - - - - - - - Create - constructor for TCustomLazControlDocker: calls inherited Create then extends the popup menu - - - - TComponent.Create - - - - - - - - - The Control that is to be docked - - - - - - The docking Manager that is to be used to dock the current control - - - - - - - ExtendPopupMenu - True if the popup menuis to be extended - - - - - - - PopupMenuItem - an item in the popup menu - - - - - - The LocalizedName of the current docker - - - - - - - DockerName - the name of the current docker - - - - - - - TLazControlDocker - a component to connect a form to the TLazDockingManager - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TLazDockConfigNode - a node to be configured in a docking control - - - - Create - constructor for a new node given a parent node and an optional name for the new node - - - - Destroy - destructor for TLazDocConfigNode: frees parents and children, the calls inherited Destroy - - - TPersistent.Destroy - - - - - Clear - performs Free and Clear for all child nodes - - - - Assign - systematically copies sizes, anchors, titles and other details from Source to a new node. - - Assign - systematically copies sizes, anchors, titles and other details from Source to a new node. If Source is of the wrong type, calls inherited Assign, which usually raises an exception - - TPersistent.Assign - - - - - FindByName - searches through a tree of nodes to find one that matches the given name - - - - IndexOf - returns the index value of the given string in the list of child nodes - - - - GetScreenBounds - returns the bounds of the area occupied by the node, as screen coordinates - - - - FindNeighbour - returns the identity of the neighbouring node on the given side; optionally ignores splitters. - - - - IsTheOnlyNeighbour - returns True if the nominated node is the only neighbour on the specified side - - - - SaveToConfig - saves details of the configuration to a config file in the given Path - - - - LoadFromConfig - loads configuration details from a file in the given path - - - - GetPath - returns the path name for the configuration file relevant to the current node - - - - WriteDebugReport - produces a formatted report with details of the node for which debugging is needed - - - - DebugLayoutAsString - returns a string specifying the layout of the required debugging report - - - The Bounds of the current node - - - - ClientBounds - the bounds of the node's clients - - - The Parent of the current node - - - The Sides of the node to which anchoring is to be performed - - - - ChildCount - the number of child nodes - - - - Children - the child nodes in an indexed list - - - - TheType of node (see definition of TLDConfigNodeType) - - TLDConfigNodeType - - - - The Name of the node - - - - WindowState - the state of the window in which the node is placed - - - - TAnchoredDockManager - a manager for anchored docking controls - - - - DisableLayout - disables layout specifically for the given control; calls inherited method - - TCustomAnchoredDockManager.DisableLayout - - - - - EnableLayout - enables layout specifically for the given control; calls inherited method - - TCustomAnchoredDockManager.EnableLayout - - - - - Configs - the configuration settings for the current control - - - - TLazDockerConfig - a class containing a tree of nodes for configuring a named docker - - - - Create - constructor for TLazDockerConfig: sets up local variables to hold the docker name and a root node - - TObject.Create - - - - - Destroy - destructor for TLazDockerConfig: removes the root then calls inherited Destroy - - - TObject.Destroy - - - - - WriteDebugReport - produces a nicely formatted debugging report - - - - DockerName - the name of the Docker to be configured - - - The Root node of the configuration - - - - FindControlByDockerName - returns the identity of a control given its docker name - - - - FindDockerByControl - returns the identity of a Control Docker given its control identity - - - - GetControlConfigName - returns a config name for the nominated control - - - - DisableLayout - finds whether the docker control exists then disables its layout - - - - EnableLayout - finds whether the docker control exists then enables its layout - - - - SaveToConfig - saves details to a config storage file - - - - LoadFromConfig - loads details from a config storage file - - - - AddOrReplaceConfig adds a new docker config, or replace if it already exists - - - - ClearConfigs - free all the docking configurations - - - - GetConfigWithDockerName - returns the configuration detail for the named docker - - - - CreateLayout - returns a layout configuration node for the named docker - - - - ConfigIsCompatible - checks that the nominated root node has a compatible configuration - - - - WriteDebugReport - produces a formatted report of status for debugging - - - - ConfigCount - the number of configuration nodes - - - - Configs - the indexed list of config nodes - - - - TLCDMenuItem - an item in a Control Docker Menu - - - - Menu - a popup menu for this item - - - - Item - the actual contents of this menu item - - - - ControlVisibleChanging - debugging method to indicate if Visible state of the control is changing - - - - CreateFormAndDockWithSplitter - add a splitter to Side and dock to it. Returns True if successful - -

Add a splitter to Side and dock to it. For example:

- 
Side=akLeft
-      --------+      -------------+
-          ---+|      ---+#+------+|
-           A ||       A |#|      ||
-          ---+|      ---+#|      ||
-          ====|  ->  ====#| Self ||
-          ---+|      ---+#|      ||
-           B ||       B |#|      ||
-          ---+|      ---+#+------+|
-      --------+      -------------+
-

If A has no parent, a TLazDockForm is created.

-

To get space for Self, either A,B are shrunk - and/or the parent of A,B is enlarged (including the grand parents of A,B)

- - - - - DockAsPage - dock as a page as specified in Layout. Returns True if successful - -

- DockAsPage - dock as a page as specified in Layout.

-

Requirements: Parent in Layout is a ldcntPage and a parent control exists.

- - - - - FixControlBounds - fix bounds after inserting AddedControl - - - - ShrinkNeighbourhood - shrink neighbour controls according to Layout - - - - FindPageNeighbours - returns a list of the neighbour controls for the docker - - - - Notification - calls inherited method, then performs specified operation depending on type of component, usually involving removal - - TComponent.Notification - - - - - FindLCDMenuItem - returns an item from the specified menu - - - - Destroy - destructor for TCustomLazControlDocker: calls inherited Destroy and removes all associated controls - - TComponent.Destroy - - - - - GetLayoutFromControl - returns a dock config node containing the control's layout - - - - SaveLayout - stores the layout, usually just before hiding a control or closing a form - - - - RestoreLayout from its stored location, when the control is unhidden or the form is re-loaded - - - - DisableLayout and increment the count of locked layouts - - - - EnableLayout and decrement the count of locked layouts - - - - ControlIsDocked - checks that the control and its parent actually exist and at least one of them is a dock form or a dock page - - - - GetControlName - returns the string name of the specified control - - - - AddPopupMenu - if the menu does not yet exist, creates the structure and menu items for a popup menu - - - - RemovePopupMenu - removes menu, usually during the process of removing the docking control - - - - Enabled - true if layout is to be automatically restored on show - - - - LayoutLock - the number of layouts that are locked - - - - - - diff --git a/docs/xml/lcl/ldockctrledit.xml b/docs/xml/lcl/ldockctrledit.xml deleted file mode 100644 index c03cbefcb9..0000000000 --- a/docs/xml/lcl/ldockctrledit.xml +++ /dev/null @@ -1,384 +0,0 @@ - - - - - - This unit contains a dialog to dock or undock a control to another - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TLazDockControlEditorDlg - a dialog to control the docking or undocking of a control with another - - - - - - - - CancelButton - hitting this button cancels the action - - - - - - - DockControlComboBox displays the various actions for selection - - - - - - - DockPageButton - a SpeedButton for moving the whole page - - - - - - - DockBottomButton - a SpeedButton for docking the bottom border - - - - - - - DockTopButton - a SpeedButton for docking the top border - - - - - - - DockRightButton - a SpeedButton for docking the right border - - - - - - - DockLeftButton - a SpeedButton for docking the left border - - - - - - - DockGroupBox - a GroupBox to contain the docking buttons - - - - - - - DockControlLabel - a label for the dock control - - - - - - - UndockButton - a buton for undocking the control - - - - - - - UndockGroupBox - a box to contain the undock button and any associated elements - - - - - - - DockBottomButtonClick - method for responding to a click on the DockBottomButton - - - - - - - - - - - - - DockControlComboBoxEditingDone - method invoked when editing of the ComboBox is done - - - - - - - - - - - - DockLeftButtonClick - method to respond to a click on the DockLeftButton - - - - - - - - - - - - DockPageButtonClick - method to respond to a click on the DockPageButton - - - - - - - - - - - - - DockRightButtonClick - method to respond to a click on the DockRightButton - - - - - - - - - - - - - DockTopButtonClick - method to respond to a click on the DockTopButton - - - - - - - - - - - - - FormCreate - method for creating the dialog form - - - - - - - - - - - - UndockButtonClick - method to respond to a click on the UndockButton - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DlgResult - the result of the dialog: shows whether a moving button, an enlarging button or another control was pressed - - - - - - - CurrentControlName - the name of the current control (the one being docked) - - - - - - EnlargeGroupBox - a GroupBox to contain the Enlarge buttons - - - - EnlargeLeftSpeedButton - a SpeedButton for enlarging the docking control by moving the left border - - - - EnlargeRightSpeedButton - a Speedbutton for enlarging the docking control by moving its right border - - - - EnlargeTopSpeedButton - a SpeedButton for enlarging the docking control by moving its top border - - - - EnlargeBottomSpeedButton - a SpeedButton for enlarging the docking control by moving its bottom border - - - - EnlargeBottomSpeedButtonClick - method to respond to a click on the EnlargeBottomSpeedButton - - - - - EnlargeLeftSpeedButtonClick - method to respond to a click on the EnlargeLeftSpeedButton - - - - - EnlargeRightSpeedButtonClick - method to respond to a click on the EnlargeRightSpeedButton - - - - - EnlargeTopSpeedButtonClick - method to respond to a click on the EnlargeTopSpeedButton - - - - - - diff --git a/docs/xml/lcl/ldocktree.xml b/docs/xml/lcl/ldocktree.xml deleted file mode 100644 index 5ccfa3e4ec..0000000000 --- a/docs/xml/lcl/ldocktree.xml +++ /dev/null @@ -1,1032 +0,0 @@ - - - - - - This unit defines TLazDockTree, the default TDockTree for the LCL - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TLazDockPages a notebook in which each page is a TLazDockPage - - - - - - - - - TLazDockPage - an entity similar to a TLazDockForm, but forming a page in a notebook of TLazDockPages - - - - - - - - - TLazDockSplitter - a splitter used with Lazarus Docking components - - - - - - - - TLazDockZone - a zone for docking in a Lazarus form - - - - - - - - - - - - - - - - - - - - - - - - - - Destroy - destructor for TLazDockZone; frees subcomponents then calls inherited Destroy - - - - - - - - - GetCaption - if there is a child control, returns the caption for that control; else returns the Index of the control as a string value - - - - - - - - - - - - GetParentControl - returns the identity of the Parent control if there is one; otherwise returns the Root zone if this is, in fact, the Root, or the Child control - - - - - - - - - - - The Splitter to be use to control the docking of this Zone - - - - - - The Pages (as in a Notebook) included in the dock zone - - - - - - A Page in the Notebook included in the Dock Zone - - - - - - - TLazDockTree - a tree of TLazDockZones found in a docked window - - - - - - - - - - - - - - UndockControlForDocking - frees anchors from parent and sibling controls - - - - - - - - - - - - BreakAnchors - detach the anchors of all child controls - - - - - - - - - - - - CreateDockLayoutHelperControls - creates any splitters and pages needed for the dock layout, including recursive creation for child controls - - - - - - - - - - - - AnchorDockLayout - sets up anchors between all docked controls and helper controls - - - - - - - - - - - - Create - constructor for TLazDockTree: creates a docking form if required, sets up a dock manager then calls inherited Create - - - - - - - - - - - - - Destroy - destructor for TLazDockTree: frees the dock site, annuls the Docksite manager, destroys any images then calls inherited Destroy - - - - - - - - - InsertControl - undocks AControl and docks it into the tree - -

- InsertControl - undocks AControl and docks it into the tree

- 
It creates a new TDockZone for AControl and inserts it as a new leaf.
-  It automatically changes the tree, so that the parent of the new TDockZone
-  will have the Orientation for InsertAt.
-
-  Example 1:
-
-    A newly created TLazDockTree has only a DockSite (TLazDockForm) and a single
-    TDockZone - the RootZone, which has as ChildControl the DockSite.
-
-    Visual:
-      +-DockSite--+
-      |           |
-      +-----------+
-    Tree of TDockZone:
-      RootZone (DockSite,doNoOrient)
-
-
-  Inserting the first control:  InsertControl(Form1,alLeft,nil);
-    Visual:
-      +-DockSite---+
-      |+--Form1---+|
-      ||          ||
-      |+----------+|
-      +------------+
-    Tree of TDockZone:
-      RootZone (DockSite,doHorizontal)
-       +-Zone2 (Form1,doNoOrient)
-
-
-  Dock Form2 right of Form1:  InsertControl(Form2,alLeft,Form1);
-    Visual:
-      +-DockSite----------+
-      |+-Form1-+|+-Form2-+|
-      ||        ||       ||
-      |+-------+|+-------+|
-      +-------------------+
-    Tree of TDockZone:
-      RootZone (DockSite,doHorizontal)
-       +-Zone2 (Form1,doNoOrient)
-       +-Zone3 (Form2,doNoOrient)
- - - - - - - - - - - - - - - - - - - - BuildDockLayout - breaks the current anchors, forms the appropriate helper controls then re-establishes the anchors - - - - - - - - - - - - FindBorderControls - makes splitters for all bordering controls along the specified Side - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GetAnchorControl - find a control to anchor the Zone's Side - - - - - - - - - - - - - - - - - - - - - - - - AutoFreeDockSite - determines whether the dock site is free - - - - - - - TLazDockForm - the default DockSite for a TLazDockTree and for TCustomAnchoredDockManager - -

- TLazDockForm - the default DockSite for a TLazDockTree and for TCustomAnchoredDockManager

- 
Note: There are two docking managers:
-      TLazDockTree uses TLazDockZone to allow docking in rows and columns.
-      TCustomAnchoredDockManager does not use TLazDockZone and allows arbitrary layouts.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TLazDockPage - an entity similar to a TLazDockForm, but forming a page in a notebook of TLazDockPages - - - - - - - - - - - - - - - - - - - - The DockZone in which this page is located - - - - - - The PageControl or notebook in which this page is located (its parent) - - - - - - - TLazDockPages a notebook in which each page is a TLazDockPage - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create - constructor for TLazDockPages: sets PageClass as TLazDockPage, then calls inherited Create - - - - - TCustomTabControl.Create - - - - - - - - - - Page - an individual TLazDockPage in the notebook, referred by its Index - - - - - - - - - - - - - - - - - - - - - - - - TLazDockSplitter - a splitter used with Lazarus Docking components - - - - - - - - - - - - - FreeSubComponents - frees and nils the local splitter and page/pages components, ready for destroying the control - - - - ResetSizes - splits available size of Zone between children - - - - PaintDockFrame - finds the cursor position and paints the dock frame of the specified size on the nominated canvas - - - - DefaultDockGrabberSize - returns the default size for the dock grabber - - - - AdjustDockRect - offset one of the borders of control rect in order to get space for frame - - - - RemoveControl - destroy child zone and all parents if they does not contain anything else, then removes the dock control - - - - PaintSite - paint bounds for each control and close button (using the supplied handle) - - - - MessageHandler - checks the state of the mouse and takes the appropriate action: checks whether redraw is needed because of mouse move or change in mouse button status, text needs to be added, etc - - - - DumpLayout - writes layout of Zone to a file, for debugging purposes etc - - - - Notification - if the required operation is removal, sets MainControl to nil, then calls inherited Notification - - - TCustomForm.Notification - - - - - UpdateMainControl - sets MainControl to a new value - - - - MouseUp - calls inherited MouseUp then finds position and appropriate header - - TControl.MouseUp - - - - - MouseDown - performs inherited MouseDpwn, then finds position and appropriate header - - TControl.MouseDown - - - - - MouseMove - performs inherited Mousemove, then finds position and appropriate header - - TControl.MouseMove - - - - - MouseLeave - performs inherited MouseLeave, and sets the local store of position to indicate absence of the mouse - - TControl.MouseLeave - - - - - PaintWindow - calls inherited PaintWindow, then creates new canvas and handle at cursor position, inserts header caption, title and images - - TCustomControl.PaintWindow - - - - - TrackMouse - finds position of the mouse, which part of the control it occupies (whether header or main part of control), and state of buttons - - - - Create - constructor for TLazDocForm: calls inherited Create, then fills in the header - - TCustomForm.Create - - - - - Destroy - destructor for TLazDockForm: removes header then calls inherited Destroy - - TCustomForm.Destroy - - - - - CloseQuery - calls inherited method, then asks all top level forms if form can close - - TCustomForm.CloseQuery - - - - - UpdateCaption - brings caption up-to-date if there have been changes - - - - UpdateMainControlInParents - make sure all parents recognise the presence of MainControl - - - - FindMainControlCandidate - finds forms and controls in the docktree heirarchy that could act as the MainControl - - - - FindHeader - identifies the part of the dock form that is the header, and returns a TControl - - - - InsertControl - calls inherited method then updates the main control - - TWinControl.InsertControl - - - - - IsDockedControl - checks if control is a child, not a TLazDockSplitter and properly anchor docked; returns True if OK - - - - ControlHasTitle - returns True if nominated control is visible, is a docked control and has a border spacing greter than zero - - - - GetTitleRect - returns the coordinates of the title retangle for the nominated control - - - - GetTitleOrientation - retrns the orientation (horizozntal or vertical) of the title in the nominated control - - - The identity of the MainControl in the docked form (used for the default caption) - - - - InsertControl - calls inherited method, then ensures that all parents recognise the MainControl - - - TWinControl.InsertControl - - - - - GetFloatingDockSiteClass - returns a default class of TLazDockForm, overriding the inherited value - - TControl.GetFloatingDockSiteClass - - - - - Change - calls inherited method, then ensures that all parents recognise MainControl - - TCustomTabControl.Change - - - - - Create - constructor for TLazDockSplitter: calls inherited Create and initialises minimum size - - TCustomSplitter.Create - - - - - TLazDockOwnerComponent - A TComponent owning all automatically created controls of a TCustomAnchoredDockManager, like TLazDockForm - - - - - Manager - the TCustomAnchoredDockManager for this Owner - - - - TCustomAnchoredDockManager - implements an LCL TDockManager via anchoring - -

- TCustomAnchoredDockManager - implements an LCL TDockManager via anchoring

- 
It implements docking, undocking, enlarging, shrinking.
-
-    The TCustomLazDockingManager component in LDockCtrl uses this
-    docking manager and extends it by layouts that can be stored/restored.
- - - - - FOwnerComponent - local variable to hold the TLazDockOwnerComponent for this manager - - - - DeleteSideSplitter - removes a side splitter to make way for a NewAnchorControl with its anchors - - - - CombineSpiralSplitterPair - cleans up alignment of two adjacent splitters when they don't line up properly - -

- CombineSpiralSplitterPair - cleans up alignment of two adjacent splitters when they don't line up properly

- 
{  - Anchor all controls anchored to Splitter2 to Splitter1
-   - extend Splitter1
-   - delete Splitter2
-
-   Example:
-
-   Four spiral splitters:
-
-     Before:
-              |
-           A  |
-     ---------|
-       | +--+ |  C
-     B | |  | |
-       | +--+ |
-       | ----------
-       |   D
-
-     The left and right splitter will be combined to one.
-
-     After:
-              |
-           A  |
-       -------|
-              |  C
-            B |
-              |
-              |------
-              |   D
-  }
- - - - - DeletePage - removes the specified page from the notebook - - - - DeletePages - removes the specified group of pages (notebook) from the Dock Form - - - - DeleteDockForm - removes the specified dock form - - - - GetAnchorDepth - returns the number of levels of anchoring associated with the given side of the nominated control - - - - GetPreferredTitlePosition - returns the most favourable place (top or left side) to put the title of a dock component, given the width and height - - - - TObject.Create - - - Create - constructor for TCustomAnchoredDockManager: creates the owner component and initialises splitter size, title height and width - - - - Destroy - destructor for TCustomAnchoredDockManager: frees and annuls the owner component the calls inherited Destroy - - - TPersistent.Destroy - - - - - BeginUpdate - starts the update process by incrementing the update count - - TDockManager.BeginUpdate - - - - - EndUpdate - ends update process by decreenting the update count - If Update count is zero or less, raises and exception - - - - GetControlBounds - finds the bounding rectangle of the specified control - - TDockManager.GetControlBounds - - - - - DisableLayout - placeholder for a virtual procedure to disable the layout of the specified control - - - - EnableLayout - placeholder for a virtual procedure to enable the layout of the specified control - - - - DockControl - docks the specified control with the Drop Control, using the alignment rule specified by InsertAt - - - - - UndockControl - removes a control from a docking form. It breaks all anchors and cleans up. - -

- UndockControl - removes a control from a docking form.

- 
It breaks all anchors and cleans up.
-
-  The created gap will be tried to fill up.
-  It removes TLazDockSplitter, TLazDockPage and TLazDockPages if they are no
-  longer needed.                                
-
- Examples:
-
-  Search Order:
-
-  1. A TLazDockSplitter dividing only two controls:
-
-     Before:
-     |-------------
-     | +--+ | +---
-     | |  | | | B
-     | +--+ | +---
-     |-------------
-
-     The splitter will be deleted and the right control will be anchored to the
-     left.
-
-     After:
-     |-------------
-     | +---
-     | | B
-     | +---
-     |-------------
-
-
-  2. Four spiral splitters:
-
-     Before:
-              |
-           A  |
-     ---------|
-       | +--+ |  C
-     B | |  | |
-       | +--+ |
-       | ----------
-       |   D
-
-     The left and right splitter will be combined to one.
-
-     After:
-              |
-           A  |
-       -------|
-              |  C
-            B |
-              |
-              |------
-              |   D
-
-
-  3. No TLazDockSplitter. Control is the only child of a TLazDockPage
-     In this case the page will be deleted.
-     If the TLazDockPages has no children left, it is recursively undocked.
-
-  4. No TLazDockSplitter, Control is the only child of a TLazDockForm.
-     The TLazDockForm is deleted and the Control is floated.
-     This normally means: A form will simply be placed on the desktop, other
-     controls will be docked into their DockSite.
-
-  5. Otherwise: this control was not docked.
- - Raises an exception if the control is already undocked - - - - InsertControl - calls DockControl to perform insertion - - TCustomAnchoredDockManager.DockControl - TDockManager.InsertControl - - - - - EnlargeControl - attempts to increase the size of the given control along the specified border, if necessary at the expense of neighbouring controls. If Simulate=true then it will only test if control can be enlarged. - - - - RemoveControl - calls UndockControl to remove the specified control from the docking heirarchy - - TCustomAnchoredDockManager.UndockControl - TDockManager.RemoveControl - - - - - ReplaceAnchoredControl - takes away OldControl, puts NewControl in its place, re-establishing all the docking, anchors and alignments - - - - GetSplitterWidth - returns the value of the width of the splitter needed to control this docking process - - - - GetSplitterHeight - returns the value of the height of the splitter needed to control this docking processGetSplitterHeight - - - - - SplitterSize - the size of splitter required for this docking process - - - - TitleWidth - the width of the title for this docking control - - - - TitleHeight - the height of the title for this docking cotrol - - - - UpdateTitlePosition - brings title position up to date, reflecting any pending changes - - - - PaintSite - (drawing of titles is is actually done by TLazDockForm) - - TLazDockForm.PaintWindow - TDockManager.PaintSite - - - - - MessageHandler - not implemented - - - - PositionDockRect - not implemented - - - - ResetBounds - not implemented - - - - SetReplacingControl - not implemented - - - - LoadFromStream - not implemented - - - - SaveToStream - not implemented - - - - AutoFreeByControl - always returns False, overriding inherited value - - TDockManager.AutoFreeByControl - - - - - CreateForm - makes a form and sets up the dock manager - - - - - diff --git a/lcl/alllclunits.pp b/lcl/alllclunits.pp index 8ae6ec493d..2744be5dec 100644 --- a/lcl/alllclunits.pp +++ b/lcl/alllclunits.pp @@ -15,18 +15,18 @@ uses IniPropStorage, InterfaceBase, IntfGraphics, LazConfigStorage, LazHelpHTML, LazHelpIntf, LazLinkedList, LCLClasses, LCLIntf, LCLMemManager, LCLMessageGlue, LCLProc, LCLResCache, LCLStrConsts, LCLType, Menus, - LCLUnicodeData, LCLVersion, LDockCtrl, LDockCtrlEdit, LDockTree, LMessages, - LResources, maps, MaskEdit, PairSplitter, PopupNotifier, PostScriptCanvas, - PostScriptPrinter, postscriptunicode, Printers, PropertyStorage, RubberBand, - ShellCtrls, Spin, StdActns, StdCtrls, StringHashList, TextStrings, Themes, - TmSchema, Toolwin, Translations, UTF8Process, UTrace, XMLPropStorage, - Messages, WSArrow, WSButtons, WSCalendar, WSCheckLst, WSComCtrls, - WSControls, WSDesigner, WSDialogs, WSExtCtrls, WSExtDlgs, WSFactory, - WSForms, WSGrids, WSImgList, WSLCLClasses, WSMenus, WSPairSplitter, WSProc, - WSReferences, WSSpin, WSStdCtrls, WSToolwin, ActnList, Arrow, AsyncProcess, - ButtonPanel, Buttons, Calendar, RegisterLCL, ValEdit, lazcanvas, lazdialogs, - lazregions, customdrawn_common, customdrawncontrols, customdrawndrawers, - lazdeviceapis, LazarusPackageIntf; + LCLUnicodeData, LCLVersion, LDockTree, LMessages, LResources, maps, + MaskEdit, PairSplitter, PopupNotifier, PostScriptCanvas, PostScriptPrinter, + postscriptunicode, Printers, PropertyStorage, RubberBand, ShellCtrls, Spin, + StdActns, StdCtrls, StringHashList, TextStrings, Themes, TmSchema, Toolwin, + Translations, UTF8Process, UTrace, XMLPropStorage, Messages, WSArrow, + WSButtons, WSCalendar, WSCheckLst, WSComCtrls, WSControls, WSDesigner, + WSDialogs, WSExtCtrls, WSExtDlgs, WSFactory, WSForms, WSGrids, WSImgList, + WSLCLClasses, WSMenus, WSPairSplitter, WSProc, WSReferences, WSSpin, + WSStdCtrls, WSToolwin, ActnList, Arrow, AsyncProcess, ButtonPanel, Buttons, + Calendar, RegisterLCL, ValEdit, lazcanvas, lazdialogs, lazregions, + customdrawn_common, customdrawncontrols, customdrawndrawers, lazdeviceapis, + LazarusPackageIntf; implementation diff --git a/lcl/lclbase.lpk b/lcl/lclbase.lpk index 436d94dc89..ab4729334a 100644 --- a/lcl/lclbase.lpk +++ b/lcl/lclbase.lpk @@ -31,7 +31,7 @@ - + @@ -269,938 +269,926 @@ - - - - - - - - - - - - - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + + + + + + + + + + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - - - - - - - - - - - - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + diff --git a/lcl/ldockctrl.pas b/lcl/ldockctrl.pas deleted file mode 100644 index 5f33cedae3..0000000000 --- a/lcl/ldockctrl.pas +++ /dev/null @@ -1,3955 +0,0 @@ -{ - /*************************************************************************** - LDockCtrl.pas - ----------------- - - ***************************************************************************/ - - ***************************************************************************** - * * - * This file is part of the Lazarus Component Library (LCL) * - * * - * See the file COPYING.modifiedLGPL.txt, included in this distribution, * - * for details about the copyright. * - * * - * 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. * - * * - ***************************************************************************** - - Author: Mattias Gaertner - - Abstract: - This unit contains visual components for docking and streaming. - - ToDo: - - move the docking code to TCustomAnchoredDockManager - and keep only the resizing code here. - - restoring layout: pages - - restoring layout: move form after inserting a control - - restoring layout: spiral splitter - - save TLazDockConfigNode to stream (atm only xml implemented) - - load TLazDockConfigNode from stream (atm only xml implemented) -} -unit LDockCtrl; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, Math, SysUtils, TypInfo, LCLProc, Controls, Forms, Menus, - LCLStrConsts, AvgLvlTree, StringHashList, ExtCtrls, LazConfigStorage, - LDockCtrlEdit, LDockTree; - -type - TNonDockConfigNames = ( - ndcnControlName, // '-Control ' + AControl.Name - ndcnChildIndex, // '-ID ' + IntToStr(AControl index in Parent) +' '+ AControl.ClassName - ndcnParent // '-Parent' : AControl.Parent - ); - -const - NonDockConfigNamePrefixes: array[TNonDockConfigNames] of string = ( - '-Name ', - '-ID ', - '-Parent'); - -type - TLDConfigNodeType = ( - ldcntControl, - ldcntForm, - ldcntSplitterLeftRight,// vertical splitter, can be moved left/right - ldcntSplitterUpDown, // horizontal splitter, can be moved up/down - ldcntPages, - ldcntPage - ); - -const - LDConfigNodeTypeNames: array[TLDConfigNodeType] of string = ( - 'Control', - 'Form', - 'SplitterLeftRight', - 'SplitterUpDown', - 'Pages', - 'Page' - ); - -type - - { TLazDockConfigNode } - - TLazDockConfigNode = class(TPersistent) - private - FBounds: TRect; - FClientBounds: TRect; - FName: string; - FParent: TLazDockConfigNode; - FSides: array[TAnchorKind] of string; - FTheType: TLDConfigNodeType; - FChilds: TFPList; - FWindowState: TWindowState; - function GetChildCount: Integer; - function GetChilds(Index: integer): TLazDockConfigNode; - function GetSides(Side: TAnchorKind): string; - procedure SetBounds(const AValue: TRect); - procedure SetClientBounds(const AValue: TRect); - procedure SetName(const AValue: string); - procedure SetParent(const AValue: TLazDockConfigNode); - procedure SetSides(Side: TAnchorKind; const AValue: string); - procedure SetTheType(const AValue: TLDConfigNodeType); - procedure DoAdd(ChildNode: TLazDockConfigNode); - procedure DoRemove(ChildNode: TLazDockConfigNode); - public - constructor Create(ParentNode: TLazDockConfigNode); - constructor Create(ParentNode: TLazDockConfigNode; const AName: string); - destructor Destroy; override; - procedure Clear; - procedure Assign(Source: TPersistent); override; - function FindByName(const AName: string; Recursive: boolean = false; - WithRoot: boolean = true): TLazDockConfigNode; - function IndexOf(const AName: string): Integer; - function GetScreenBounds: TRect; - function FindNeighbour(SiblingSide: TAnchorKind; - NilIfAmbiguous: boolean; - IgnoreSplitters: boolean = true): TLazDockConfigNode; - function IsTheOnlyNeighbour(Node: TLazDockConfigNode; - SiblingSide: TAnchorKind): boolean; - procedure SaveToConfig(Config: TConfigStorage; const Path: string = ''); - procedure LoadFromConfig(Config: TConfigStorage; const Path: string = ''); - function GetPath: string; - procedure WriteDebugReport; - function DebugLayoutAsString: string; - public - property Bounds: TRect read FBounds write SetBounds; - property ClientBounds: TRect read FClientBounds write SetClientBounds; - property Parent: TLazDockConfigNode read FParent write SetParent; - property Sides[Side: TAnchorKind]: string read GetSides write SetSides; - property ChildCount: Integer read GetChildCount; - property Children[Index: integer]: TLazDockConfigNode read GetChilds; default; - published - property TheType: TLDConfigNodeType read FTheType write SetTheType - default ldcntControl; - property Name: string read FName write SetName; - property WindowState: TWindowState read FWindowState write FWindowState; - end; - - { TLazDockerConfig } - - TLazDockerConfig = class - private - FDockerName: string; - FRoot: TLazDockConfigNode; - public - constructor Create(const ADockerName: string; ANode: TLazDockConfigNode); - destructor Destroy; override; - procedure WriteDebugReport; - property DockerName: string read FDockerName; - property Root: TLazDockConfigNode read FRoot; - end; - - TCustomLazControlDocker = class; - TCustomLazDockingManager = class; - - { TAnchoredDockManager } - - TAnchoredDockManager = class(TCustomAnchoredDockManager) - private - FConfigs: TCustomLazDockingManager; - public - procedure DisableLayout(Control: TControl); override; - procedure EnableLayout(Control: TControl); override; - property Configs: TCustomLazDockingManager read FConfigs; - end; - - { TCustomLazDockingManager } - - TCustomLazDockingManager = class(TComponent) - private - FDockers: TFPList; - FManager: TAnchoredDockManager; - FConfigs: TFPList;// list of TLazDockerConfig - function GetConfigCount: Integer; - function GetConfigs(Index: Integer): TLazDockerConfig; - function GetDockerCount: Integer; - function GetDockers(Index: Integer): TCustomLazControlDocker; - protected - procedure Remove(Docker: TCustomLazControlDocker); - function Add(Docker: TCustomLazControlDocker): Integer; - public - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - function FindDockerByName(const ADockerName: string; - Ignore: TCustomLazControlDocker = nil): TCustomLazControlDocker; - function FindControlByDockerName(const ADockerName: string; - Ignore: TCustomLazControlDocker = nil): TControl; - function FindDockerByControl(AControl: TControl; - Ignore: TCustomLazControlDocker = nil): TCustomLazControlDocker; - function CreateUniqueName(const AName: string; - Ignore: TCustomLazControlDocker): string; - function GetControlConfigName(AControl: TControl): string; - procedure DisableLayout(Control: TControl); - procedure EnableLayout(Control: TControl); - procedure SaveToConfig(Config: TConfigStorage; const Path: string = ''); - procedure LoadFromConfig(Config: TConfigStorage; const Path: string = ''); - procedure AddOrReplaceConfig(const DockerName: string; - Config: TLazDockConfigNode); - procedure ClearConfigs; - function GetConfigWithDockerName(const DockerName: string - ): TLazDockerConfig; - function CreateLayout(const DockerName: string; VisibleControl: TControl; - ExceptionOnError: boolean = false): TLazDockConfigNode; - function ConfigIsCompatible(RootNode: TLazDockConfigNode; - ExceptionOnError: boolean = false): boolean; - - procedure WriteDebugReport; - public - property Manager: TAnchoredDockManager read FManager; - property DockerCount: Integer read GetDockerCount; - property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers; default; - property ConfigCount: Integer read GetConfigCount; - property Configs[Index: Integer]: TLazDockerConfig read GetConfigs; - end; - - { TLazDockingManager } - - TLazDockingManager = class(TCustomLazDockingManager) - published - end; - - { TLCDMenuItem } - - TLCDMenuItem = class - public - Menu: TPopupMenu; - Item: TMenuItem; - end; - - { TCustomLazControlDocker - A component to connect a form to the TLazDockingManager. - When the control gets visible TCustomLazControlDocker restores the layout. - Before the control gets invisible, TCustomLazControlDocker saves the layout. - } - TCustomLazControlDocker = class(TComponent) - private - FControl: TControl; - FDockerName: string; - FEnabled: boolean; - FExtendPopupMenu: boolean; - FLayoutLock: integer; - FLocalizedName: string; - FManager: TCustomLazDockingManager; - FMenus: TFPList;// list of TLCDMenuItem - FPopupMenuItem: TMenuItem; - procedure SetControl(const AValue: TControl); - procedure SetDockerName(const AValue: string); - procedure SetExtendPopupMenu(const AValue: boolean); - procedure SetLocalizedName(const AValue: string); - procedure SetManager(const AValue: TCustomLazDockingManager); - procedure PopupMenuItemClick(Sender: TObject); - protected - procedure UpdatePopupMenu; virtual; - procedure Loaded; override; - function GetLocalizedName: string; - procedure ControlVisibleChanging(Sender: TObject); - procedure ControlVisibleChanged(Sender: TObject); - function CreateFormAndDockWithSplitter(Layout: TLazDockConfigNode; - Side: TAnchorKind): boolean; - function DockAsPage(Layout: TLazDockConfigNode): boolean; - procedure FixControlBounds(Layout: TLazDockConfigNode; - ResizedControl: TControl); - procedure ShrinkNeighbourhood(Layout: TLazDockConfigNode; - AControl: TControl; Sides: TAnchors); - function FindPageNeighbours(Layout: TLazDockConfigNode; - StartControl: TControl; - out AnchorControls: TAnchorControlsRect - ): TFPList; // list of TControls - procedure Notification(AComponent: TComponent; - Operation: TOperation); override; - function FindLCDMenuItem(AMenu: TMenu): TLCDMenuItem; - function FindLCDMenuItem(AMenuItem: TMenuItem): TLCDMenuItem; - public - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - procedure ShowDockingEditor; virtual; - function GetLayoutFromControl: TLazDockConfigNode; - procedure SaveLayout; - procedure RestoreLayout; - procedure DisableLayout; - procedure EnableLayout; - function ControlIsDocked: boolean; - function GetControlName(AControl: TControl): string; - procedure AddPopupMenu(Menu: TPopupMenu); - procedure RemovePopupMenu(Menu: TPopupMenu); - property Control: TControl read FControl write SetControl; - property Manager: TCustomLazDockingManager read FManager write SetManager; - property ExtendPopupMenu: boolean read FExtendPopupMenu write SetExtendPopupMenu default true; - property PopupMenuItem: TMenuItem read FPopupMenuItem; - property LocalizedName: string read FLocalizedName write SetLocalizedName; - property DockerName: string read FDockerName write SetDockerName; - property Enabled: boolean read FEnabled write FEnabled;// true to auto restore layout on show - property LayoutLock: integer read FLayoutLock; - end; - - { TLazControlDocker } - - TLazControlDocker = class(TCustomLazControlDocker) - published - property Control; - property Manager; - property ExtendPopupMenu; - property DockerName; - property Enabled; - end; - - -function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType; - -function FindExclusiveSplitter(ControlList: TFPList; Side: TAnchorKind - ): TLazDockSplitter; -function FindNextControlAnchoredToBoundary(AControl: TControl; - Boundary, SearchDirection: TAnchorKind): TControl; -function FindSplitterRectangularNeighbourhood(Splitter: TLazDockSplitter; - SplitterSide: TAnchorKind; out Bounds: TAnchorControlsRect): TFPList; - -function dbgs(Node: TLazDockConfigNode): string; overload; - -procedure Register; - - -implementation - - -procedure Register; -begin - RegisterComponents('Misc',[TLazDockingManager,TLazControlDocker]); -end; - -function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType; -begin - for Result:=Low(TLDConfigNodeType) to High(TLDConfigNodeType) do - if CompareText(LDConfigNodeTypeNames[Result],s)=0 then exit; - Result:=ldcntControl; -end; - -function FindExclusiveSplitter(ControlList: TFPList; - Side: TAnchorKind): TLazDockSplitter; -{ find a splitter, that is not part of ControlList and anchored on one side - only to the controls in ControlList - - For example: A,B,C,S1,S2 (S1,S2 are the splitters between) - - |+-----+ - || A | - |+-----+ - |------- - |+-+|+-+ - ||B|||C| - |+-+|+-+ - will return the splitter to the left and Side=akLeft. -} -var - AControl: TControl; - i: Integer; - AParent: TWinControl; - j: Integer; - AnchoredToControlList: Boolean; - AnchoredToOther: Boolean; -begin - Result:=nil; - if (ControlList=nil) or (ControlList.Count=0) then exit; - AControl:=TControl(ControlList[0]); - if AControl.Parent=nil then exit; - AParent:=AControl.Parent; - for i:=0 to AParent.ControlCount-1 do begin - Result:=TLazDockSplitter(AParent.Controls[i]); - if (Result is TLazDockSplitter) - and (ControlList.IndexOf(Result)<0) - then begin - // ASplitter is a splitter which is not in the ControlList - // => check if the splitter is exclusively anchored - AnchoredToControlList:=false; - AnchoredToOther:=false; - for j:=0 to AParent.ControlCount-1 do begin - AControl:=TControl(ControlList[j]); - if (AControl.AnchorSide[Side].Control=Result) then - begin - if ControlList.IndexOf(AControl)>=0 then - AnchoredToControlList:=true - else begin - AnchoredToOther:=true; - break; - end; - end; - if AnchoredToControlList and not AnchoredToOther then - exit; - end; - end; - end; - Result:=nil; -end; - -function FindNextControlAnchoredToBoundary( - AControl: TControl; Boundary, SearchDirection: TAnchorKind): TControl; -{ Finds the next control anchored to the same as AControl - For example: - - ------------------------------------ - +-+|+-+|+-+| - |A|||B|||C|| - - With Boundary=akTop and SearchDirection=akRight the next of A is the splitter - to the right, then the splitter right of B, then C, ... -} -var - AParent: TWinControl; - i: Integer; - BoundaryControl: TControl; -begin - Result:=AControl.AnchorSide[SearchDirection].Control; - if (Result<>nil) then begin - if Result.Parent=AControl.Parent then - exit - else - exit(nil); - end else begin - AParent:=AControl.Parent; - if AParent=nil then exit; - BoundaryControl:=AControl.AnchorSide[Boundary].Control; - if BoundaryControl=nil then exit; - for i:=0 to AParent.ControlCount-1 do begin - Result:=AParent.Controls[i]; - if (Result.AnchorSide[Boundary].Control=BoundaryControl) - and (Result.AnchorSide[OppositeAnchor[SearchDirection]].Control=AControl) - then - exit; - end; - Result:=nil; - end; -end; - -function FindSplitterRectangularNeighbourhood( - Splitter: TLazDockSplitter; SplitterSide: TAnchorKind; - out Bounds: TAnchorControlsRect): TFPList; -{ Find a list of controls, building a rectangular area (without holes) touching - the complete SplitterSide of Splitter. - RectBounds will be the four bounding controls (Parent or Siblings). - - For example: akRight of - - |+-----+ - || A | - |+-----+ - |------- - |+-+|+-+ - ||B|||C| - |+-+|+-+ - - will find A,B,C and the two splitter controls between A,B,C. -} - - function IsBoundary(AControl: TControl): boolean; - var - a: TAnchorKind; - begin - for a:=Low(TAnchorKind) to High(TAnchorKind) do if Bounds[a]=AControl then - exit(true); - Result:=false; - end; - -var - BoundSide1: TAnchorKind; - BoundSide2: TAnchorKind; - AControl: TControl; - a: TAnchorKind; - Candidate: TControl; - j: Integer; - i: Integer; - OppSide: TAnchorKind; -begin - Result:=nil; - BoundSide1:=ClockwiseAnchor[SplitterSide]; - BoundSide2:=OppositeAnchor[BoundSide1]; - OppSide:=OppositeAnchor[SplitterSide]; - Bounds[OppSide]:=Splitter; - Bounds[BoundSide1]:=Splitter.AnchorSide[BoundSide1].Control; - Bounds[BoundSide2]:=Splitter.AnchorSide[BoundSide2].Control; - Bounds[SplitterSide]:=nil; - if (Bounds[BoundSide1]=nil) or (Bounds[BoundSide2]=nil) then exit; - - { search for a splitter, bounded the same as Splitter - -------- - | | - | | - -------- - } - AControl:=Splitter; - repeat - AControl:=FindNextControlAnchoredToBoundary(AControl,BoundSide1,SplitterSide); - if AControl=nil then break; - if (AControl is TLazDockSplitter) - and (AControl.AnchorSide[BoundSide1].Control=Bounds[BoundSide1]) - and (AControl.AnchorSide[BoundSide2].Control=Bounds[BoundSide2]) then begin - // found - Bounds[SplitterSide]:=AControl; - break; - end; - until false; - - if (Bounds[SplitterSide]=nil) - and (Bounds[BoundSide1]<>Splitter.Parent) then begin - { check for example - ------| - | | "Splitter" is the left one - | | - -------- - } - AControl:=Bounds[BoundSide1].AnchorSide[SplitterSide].Control; - if (AControl is TLazDockSplitter) - and (AControl.AnchorSide[BoundSide2].Control=Bounds[BoundSide2]) then - Bounds[SplitterSide]:=AControl; - end; - - if (Bounds[SplitterSide]=nil) - and (Bounds[BoundSide2]<>Splitter.Parent) then begin - { check for example - -------- - | | "Splitter" is the left one - | | - ------| - } - AControl:=Bounds[BoundSide2].AnchorSide[SplitterSide].Control; - if (AControl is TLazDockSplitter) - and (AControl.AnchorSide[BoundSide1].Control=Bounds[BoundSide1]) then - Bounds[SplitterSide]:=AControl; - end; - - if (Bounds[SplitterSide]=nil) - and (Bounds[BoundSide1]<>Splitter.Parent) then begin - { check for example - ------| - | | "Splitter" is the left one - | | - ------| - } - AControl:=Bounds[BoundSide1].AnchorSide[SplitterSide].Control; - if (Acontrol<>nil) - and (Bounds[BoundSide2]<>nil) - and (AControl=Bounds[BoundSide2].AnchorSide[SplitterSide].Control) then - Bounds[SplitterSide]:=AControl; - end; - - if Bounds[SplitterSide]=nil then exit; - - // find all controls between the Bounds - - // find a first control in the area - AControl:=FindNextControlAnchoredToBoundary(Splitter,BoundSide1,SplitterSide); - if (AControl=nil) or (AControl=Bounds[SplitterSide]) then exit; - Result:=TFPlist.Create; - Result.Add(AControl); - - // add the others with flood fill - i:=0; - while i=0 then continue; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - if Candidate.AnchorSide[a].Control=AControl then begin - Result.Add(Candidate); - break; - end; - end; - end; - inc(i); - end; -end; - -function dbgs(Node: TLazDockConfigNode): string; -begin - if Node=nil then begin - Result:='nil'; - end else begin - Result:=Node.Name+'{Type='+LDConfigNodeTypeNames[Node.TheType] - +',ChildCnt='+IntToStr(Node.ChildCount)+'}'; - end; -end; - -{ TCustomLazControlDocker } - -procedure TCustomLazControlDocker.SetManager( - const AValue: TCustomLazDockingManager); -begin - if FManager=AValue then exit; - //DebugLn('TCustomLazControlDocker.SetManager Old=',DbgSName(Manager),' New=',DbgSName(AValue)); - if FManager<>nil then FManager.Remove(Self); - FManager:=AValue; - if FManager<>nil then FManager.Add(Self); - UpdatePopupMenu; -end; - -procedure TCustomLazControlDocker.UpdatePopupMenu; -// creates or deletes the PopupMenuItem to the PopupMenu of Control -begin - if [csDesigning, csLoading, csDestroying] * ComponentState <> [] then Exit; - - //DebugLn('TCustomLazControlDocker.UpdatePopupMenu ',DbgSName(Control),' Manager=',DbgSName(Manager),' PopupMenu=',dbgs((Control<>nil) and (Control.PopupMenu<>nil)),' ExtendPopupMenu=',dbgs(ExtendPopupMenu)); - - if ExtendPopupMenu and (Control<>nil) and (Control.PopupMenu<>nil) - and (Manager<>nil) then begin - //DebugLn('TCustomLazControlDocker.UpdatePopupMenu ADDING'); - AddPopupMenu(Control.PopupMenu); - end else begin - // delete PopupMenuItem - if (Control<>nil) and (Control.PopupMenu<>nil) then - RemovePopupMenu(Control.PopupMenu); - end; -end; - -procedure TCustomLazControlDocker.Loaded; -begin - inherited Loaded; - UpdatePopupMenu; -end; - -procedure TCustomLazControlDocker.ShowDockingEditor; -var - Dlg: TLazDockControlEditorDlg; - i: Integer; - TargetDocker: TCustomLazControlDocker; - Side: TAlign; - CurDocker: TCustomLazControlDocker; - Anchor: TAnchorKind; -begin - if (Manager=nil) or (Control=nil) then - raise Exception.Create('TCustomLazControlDocker.ShowDockingEditor no docking available'); - Dlg:=TLazDockControlEditorDlg.Create(nil); - try - // fill the list of controls this control can dock to - Dlg.DockControlComboBox.Text:=''; - Dlg.DockControlComboBox.Items.BeginUpdate; - //DebugLn('TCustomLazControlDocker.ShowDockingEditor Self=',DockerName,' Manager.DockerCount=',dbgs(Manager.DockerCount)); - try - Dlg.DockControlComboBox.Items.Clear; - for i:=0 to Manager.DockerCount-1 do begin - CurDocker:=Manager.Dockers[i]; - //DebugLn('TCustomLazControlDocker.ShowDockingEditor Self=',DockerName,' CurDocker=',CurDocker.DockerName); - if CurDocker=Self then continue; - if CurDocker.Control=nil then continue; - Dlg.DockControlComboBox.Items.Add(CurDocker.GetLocalizedName); - end; - Dlg.DockControlComboBox.Enabled:=Dlg.DockControlComboBox.Items.Count>0; - finally - Dlg.DockControlComboBox.Items.EndUpdate; - end; - - // enable Undock button, if Control is docked - Dlg.UndockGroupBox.Enabled:=ControlIsDocked; - - // enable enlarge buttons - Dlg.EnlargeLeftSpeedButton.Visible:= - Manager.Manager.EnlargeControl(Control,akLeft,true); - Dlg.EnlargeTopSpeedButton.Visible:= - Manager.Manager.EnlargeControl(Control,akTop,true); - Dlg.EnlargeRightSpeedButton.Visible:= - Manager.Manager.EnlargeControl(Control,akRight,true); - Dlg.EnlargeBottomSpeedButton.Visible:= - Manager.Manager.EnlargeControl(Control,akBottom,true); - - Dlg.EnlargeGroupBox.Visible := Dlg.EnlargeLeftSpeedButton.Visible or - Dlg.EnlargeTopSpeedButton.Visible or - Dlg.EnlargeRightSpeedButton.Visible or - Dlg.EnlargeBottomSpeedButton.Visible; - - if Dlg.ShowModal=mrOk then begin - // dock or undock - case Dlg.DlgResult of - ldcedrUndock: - // undock - Manager.Manager.UndockControl(Control,true); - ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop, - ldcedrDockBottom,ldcedrDockPage: - // dock - begin - TargetDocker:=nil; - for i:=0 to Manager.DockerCount-1 do begin - CurDocker:=Manager.Dockers[i]; - if CurDocker=Self then continue; - if Dlg.DockControlComboBox.Text=CurDocker.GetLocalizedName then - TargetDocker:=CurDocker; - end; - if TargetDocker=nil then begin - RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor TargetDocker=nil'); - end; - case Dlg.DlgResult of - ldcedrDockLeft: Side:=alLeft; - ldcedrDockRight: Side:=alRight; - ldcedrDockTop: Side:=alTop; - ldcedrDockBottom: Side:=alBottom; - ldcedrDockPage: Side:=alClient; - else RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor ?'); - end; - Manager.Manager.DockControl(Control,Side,TargetDocker.Control); - end; - ldcedrEnlargeLeft,ldcedrEnlargeTop,ldcedrEnlargeRight,ldcedrEnlargeBottom: - begin - // enlarge - case Dlg.DlgResult of - ldcedrEnlargeLeft: Anchor:=akLeft; - ldcedrEnlargeRight: Anchor:=akRight; - ldcedrEnlargeTop: Anchor:=akTop; - ldcedrEnlargeBottom: Anchor:=akBottom; - else RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor ?'); - end; - Manager.Manager.EnlargeControl(Control,Anchor); - end; - end; - end; - finally - Dlg.Free; - end; -end; - -function TCustomLazControlDocker.GetLocalizedName: string; -begin - Result:=LocalizedName; - if LocalizedName='' then begin - Result:=DockerName; - if (Result='') and (Control<>nil) then - Result:=Control.Name; - if Result='' then - Result:=Name; - end; -end; - -procedure TCustomLazControlDocker.ControlVisibleChanging(Sender: TObject); -begin - if Manager=nil then exit; - if Control<>Sender then begin - DebugLn('TCustomLazControlDocker.ControlVisibleChanging WARNING: ', - DbgSName(Control),'<>',DbgSName(Sender)); - exit; - end; - {$IFDEF VerboseAnchorDocking} - DebugLn(['TCustomLazControlDocker.ControlVisibleChanging Sender=',DbgSName(Sender),' Control.Visible=',Control.Visible]); - DumpStack; - {$ENDIF} - if FLayoutLock>0 then begin - DebugLn(['TCustomLazControlDocker.ControlVisibleChanging ',DbgSName(Control),' ignore because FLayoutLock=',FLayoutLock]); - exit; - end; - - if Control.Visible then begin - // control will be hidden -> the layout will change - // save the layout for later restore - SaveLayout; - {$IFDEF VerboseAnchorDocking} - DebugLn(['TCustomLazControlDocker.ControlVisibleChanging Parent=',DbgSName(Control.Parent)]); - {$ENDIF} - end else if ([csDestroying,csDesigning,csLoading]*ComponentState=[]) then begin - // the control will become visible -> dock it to restore the last layout - RestoreLayout; - end; -end; - -procedure TCustomLazControlDocker.ControlVisibleChanged(Sender: TObject); -begin - if Manager=nil then exit; - {$IFDEF VerboseAnchorDocking} - DebugLn(['TCustomLazControlDocker.ControlVisibleChanged Sender=',DbgSName(Sender),' Control.Visible=',Control.Visible]); - //DumpStack; - {$ENDIF} - if FLayoutLock>0 then begin - //DebugLn(['TCustomLazControlDocker.ControlVisibleChanged ',DbgSName(Control),' ignore because FLayoutLock=',FLayoutLock]); - exit; - end; - - if Control.Visible then begin - // the control has become visible - end else if ([csDesigning,csLoading]*ComponentState=[]) then begin - // control was hidden (or destroyed) - if ControlIsDocked - and (Manager<>nil) - and (Manager.Manager<>nil) then begin - // auto undock - DebugLn(['TCustomLazControlDocker.ControlVisibleChanged auto undock ',DbgSName(Control)]); - Manager.Manager.UndockControl(Control,false); - end; - end; -end; - -function TCustomLazControlDocker.CreateFormAndDockWithSplitter( - Layout: TLazDockConfigNode; Side: TAnchorKind): boolean; -{ Add a splitter to Side and dock to it. For example: - - Side=akLeft - --------+ -------------+ - ---+| ---+#+------+| - A || A |#| || - ---+| ---+#| || - ====| -> ====#| Self || - ---+| ---+#| || - B || B |#| || - ---+| ---+#+------+| - --------+ -------------+ - If A has no parent, a TLazDockForm is created. - - To get space for Self, either A,B are shrinked - and/or the parent of A,B is enlarged (including the grand parents of A,B). -} - - function FindNextNeighbour(SplitterNode: TLazDockConfigNode; - Neighbours: TFPList; Append: boolean): boolean; - var - Neighbour: TControl; - i: Integer; - Sibling: TControl; - Search: TAnchorKind; - Splitter, CurSplitter: TLazDockSplitter; - OldAnchor, CurAnchor: TControl; - NewNeighbour: TControl; - NodeName: String; - Node: TLazDockConfigNode; - begin - Result:=false; - if Neighbours=nil then exit; - if Append then - Neighbour:=TControl(Neighbours[Neighbours.Count-1]) - else - Neighbour:=TControl(Neighbours[0]); - if Neighbour.Parent=nil then exit; - if not GetLazDockSplitterOrParent(Neighbour,OppositeAnchor[Side],OldAnchor) - then exit; - // search direction - if (Side in [akLeft,akRight]) then begin - if Append then Search:=akBottom else Search:=akTop; - end else begin - if Append then Search:=akRight else Search:=akLeft; - end; - // find splitter - if not GetLazDockSplitter(Neighbour,Search,Splitter) then exit; - if (not GetLazDockSplitterOrParent(Splitter,OppositeAnchor[Side],CurAnchor)) - or (CurAnchor<>OldAnchor) then exit; - // find neighbour (anchored to Splitter and OldAnchor) - NewNeighbour:=nil; - for i:=0 to Neighbour.Parent.ControlCount-1 do begin - Sibling:=Neighbour.Parent.Controls[i]; - if Sibling=Neighbour then continue; - if (not GetLazDockSplitter(Sibling,OppositeAnchor[Search],CurSplitter)) - or (CurSplitter<>Splitter) then continue; - if (not GetLazDockSplitterOrParent(Splitter,OppositeAnchor[Side],CurAnchor)) - or (CurAnchor<>OldAnchor) then continue; - // Neighbour control found - NewNeighbour:=Sibling; - break; - end; - if NewNeighbour=nil then exit; - // check if this control is mentioned in Layout as Neighbour - NodeName:=Manager.GetControlConfigName(NewNeighbour); - if NodeName='' then exit; - Node:=Layout.FindByName(NodeName,true); - if Node=nil then exit; - if CompareText(Node.Sides[OppositeAnchor[Side]],SplitterNode.Name)<>0 then - exit; - // success: NewNeighbour is a neighbour on the current form and in the Layout - if Append then begin - Neighbours.Add(Splitter); - Neighbours.Add(NewNeighbour); - end else begin - Neighbours.Insert(0,Neighbour); - Neighbours.Insert(0,Splitter); - end; - Result:=true; - end; - -var - SelfNode: TLazDockConfigNode; - SplitterNode: TLazDockConfigNode; - NeighbourNode: TLazDockConfigNode; - NeighbourControl: TControl; - NewParent: TWinControl; - Splitter: TLazDockSplitter; - a: TAnchorKind; - NewParentCreated: Boolean; - SplitterSize: LongInt; - i: Integer; - Side2: TAnchorKind; - Side3: TAnchorKind; - Neighbours: TFPList; - LeftTopNeighbour: TControl; - RightBottomNeighbour: TControl; -begin - Result:=false; - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter DockerName="',DockerName,'"']); - SelfNode:=Layout.FindByName(DockerName,true); - if SelfNode=nil then begin - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter SelfNode not found DockerName="',DockerName,'"']); - exit; - end; - SplitterNode:=Layout.FindByName(SelfNode.Sides[Side]); - if SplitterNode=nil then begin - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter SplitterNode not found "',SelfNode.Sides[Side],'"']); - exit; - end; - - // search one Neighbour - NeighbourNode:=SplitterNode.FindNeighbour(OppositeAnchor[Side],false); - if NeighbourNode=nil then begin - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourNode not found']); - exit; - end; - NeighbourControl:=Manager.FindControlByDockerName(NeighbourNode.Name); - if NeighbourControl=nil then begin - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourControl not found "',NeighbourNode.Name,'"']); - exit; - end; - - Neighbours:=nil; - NewParent:=nil; - try - if NeighbourControl.Parent=nil then begin - // NeighbourControl is a standalone control (e.g. an undocked form) - // => create a new TLazDockForm and put both controls into it - NewParent:=Manager.Manager.CreateForm; - NewParentCreated:=true; - end else begin - // NeighbourControl is docked - NewParent:=NeighbourControl.Parent; - NewParentCreated:=false; - end; - - NewParent.DisableAlign; - - // create a splitter - Splitter:=TLazDockSplitter.Create(nil); - Splitter.Align:=alNone; - Splitter.Beveled:=true; - Splitter.ResizeAnchor:=Side; - Splitter.Parent:=NewParent; - if Side in [akLeft,akRight] then - SplitterSize:=Manager.Manager.GetSplitterWidth(Splitter) - else - SplitterSize:=Manager.Manager.GetSplitterHeight(Splitter); - if Side in [akLeft,akRight] then - Splitter.Width:=SplitterSize - else - Splitter.Height:=SplitterSize; - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter Splitter=',DbgSName(Splitter),' ',dbgs(Splitter.BoundsRect)]); - - if NewParentCreated then begin - // resize NewParent to bounds of NeighbourControl - if (NewParent is TCustomForm) - and (NeighbourControl is TCustomForm) then; - TCustomForm(NewParent).WindowState:= - TCustomForm(NeighbourControl).WindowState; - NewParent.BoundsRect:=NeighbourControl.BoundsRect; - NeighbourControl.Parent:=NewParent; - NeighbourControl.Align:=alNone; - end; - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NewParent=',DbgSName(NewParent),' ',dbgs(NewParent.BoundsRect)]); - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourControl=',DbgSName(NeighbourControl),' ',dbgs(NeighbourControl.BoundsRect)]); - - // move Control to the new parent - Control.Parent:=NewParent; - Control.Align:=alNone; - Control.BoundsRect:=SelfNode.Bounds; - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter Control=',DbgSName(Control),' ',dbgs(Control.BoundsRect)]); - - if NewParentCreated then begin - // one Neighbour, one splitter and the Control - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - // anchor Control - if a=Side then - Control.AnchorToNeighbour(a,0,Splitter) - else - Control.AnchorParallel(a,0,NewParent); - // anchor Splitter - if (Side in [akLeft,akRight]) <> (a in [akLeft,akRight]) then - Splitter.AnchorParallel(a,0,NewParent); - // anchor Neighbour - if a=OppositeAnchor[Side] then - NeighbourControl.AnchorToNeighbour(a,0,Splitter) - else - NeighbourControl.AnchorParallel(a,0,NewParent); - end; - end else begin - // several Neighbours - - // find all Neighbours - Neighbours:=TFPList.Create; - Neighbours.Add(NeighbourControl); - while FindNextNeighbour(SplitterNode,Neighbours,false) do ; - while FindNextNeighbour(SplitterNode,Neighbours,true) do ; - // Neighbours now contains all controls, that need to be reanchored - // to the new Splitter - - if Side in [akLeft,akRight] then - Side2:=akTop - else - Side2:=akLeft; - Side3:=OppositeAnchor[Side2]; - LeftTopNeighbour:=TControl(Neighbours[0]); - RightBottomNeighbour:=TControl(Neighbours[Neighbours.Count-1]); - - // anchor Control - Control.AnchorToNeighbour(Side,0,Splitter); - Control.AnchorSame(OppositeAnchor[Side],NeighbourControl); - Control.AnchorSame(Side2,LeftTopNeighbour); - Control.AnchorSame(Side3,RightBottomNeighbour); - - // anchor Splitter - Splitter.AnchorSame(Side2,LeftTopNeighbour); - Splitter.AnchorSame(Side3,RightBottomNeighbour); - - // anchor Neighbours - for i:=0 to Neighbours.Count-1 do begin - NeighbourControl:=TControl(Neighbours[i]); - DebugLn(['TCustomLazControlDocker.CreateFormAndDockWithSplitter NeighbourControl=',DbgSName(NeighbourControl),' i=',i]); - NeighbourControl.AnchorToNeighbour(OppositeAnchor[Side],0,Splitter); - end; - end; - - if Side in [akLeft,akRight] then - ShrinkNeighbourhood(Layout,Control,[akLeft,akRight]) - else - ShrinkNeighbourhood(Layout,Control,[akTop,akBottom]); - FixControlBounds(Layout,Control); - Manager.Manager.UpdateTitlePosition(Control); - - finally - Neighbours.Free; - if NewParent<>nil then begin - NewParent.EnableAlign; - NewParent.Visible:=true; - end; - end; - - Result:=true; -end; - -function TCustomLazControlDocker.DockAsPage(Layout: TLazDockConfigNode - ): boolean; -// dock as page like in Layout -// Requirements: Parent in Layout is a ldcntPage and a parent control exists. -var - SelfNode: TLazDockConfigNode; - PageNode: TLazDockConfigNode; - PageNodeIndex: LongInt; - PagesNode: TLazDockConfigNode; - NeighbourNode: TLazDockConfigNode; - NeighbourControl: TControl; - TopForm: TLazDockForm; - Pages: TLazDockPages; - NeighbourPage: TLazDockPage; - NeighbourControlPageIndex: LongInt; - Page: TLazDockPage; - PageIndex: LongInt; - NeighbourList: TFPList; - AnchorControls: TAnchorControlsRect; - TopFormBounds: TRect; - i: Integer; - a: TAnchorKind; -begin - Result:=false; - DebugLn(['TCustomLazControlDocker.DockAsPage DockerName="',DockerName,'"']); - SelfNode:=Layout.FindByName(DockerName,true); - if SelfNode=nil then begin - DebugLn(['TCustomLazControlDocker.DockAsPage SelfNode not found DockerName="',DockerName,'"']); - exit; - end; - PageNode:=SelfNode.Parent; - if PageNode=nil then begin - DebugLn(['TCustomLazControlDocker.DockAsPage SelfNode.Parent=nil DockerName="',DockerName,'"']); - exit; - end; - if PageNode.TheType<>ldcntPage then begin - DebugLn(['TCustomLazControlDocker.DockAsPage PageNode.TheType<>ldcntPage DockerName="',DockerName,'"']); - exit; - end; - if PageNode.ChildCount<>1 then begin - DebugLn(['TCustomLazControlDocker.DockAsPage PageNode.ChildCount<>1 DockerName="',DockerName,'"']); - exit; - end; - - PagesNode:=PageNode.Parent; - PageNodeIndex:=PagesNode.IndexOf(PageNode.Name); - if PageNodeIndex>0 then - NeighbourNode:=PagesNode.Children[PageNodeIndex-1].Children[0] - else - NeighbourNode:=PagesNode.Children[PageNodeIndex+1].Children[0]; - NeighbourControl:=Manager.FindControlByDockerName(NeighbourNode.Name); - if NeighbourControl=nil then begin - DebugLn(['TCustomLazControlDocker.DockAsPage NeighbourControl not found "',NeighbourNode.Name,'"']); - exit; - end; - - if NeighbourControl.Parent=nil then begin - // NeighbourControl is a top level control (no parents, no neighbours) - // => create a TLazDockForm with a TLazDockPages and two TLazDockPage - TopForm:=Manager.Manager.CreateForm; - TopFormBounds:=PagesNode.Bounds; - // TODO: shrink TopFormBounds - TopForm.BoundsRect:=TopFormBounds; - - Pages:=TLazDockPages.Create(nil); - Pages.DisableAlign; - try - Pages.Parent:=TopForm; - Pages.AnchorClient(0); - if PageNodeIndex>0 then begin - Pages.Pages.Add(NeighbourControl.Caption); - Pages.Pages.Add(Control.Caption); - NeighbourPage:=Pages.Page[0]; - Page:=Pages.Page[1]; - end else begin - Pages.Pages.Add(Control.Caption); - Pages.Pages.Add(NeighbourControl.Caption); - Page:=Pages.Page[0]; - NeighbourPage:=Pages.Page[1]; - end; - NeighbourControl.Parent:=NeighbourPage; - NeighbourControl.AnchorClient(0); - Control.Parent:=Page; - Control.AnchorClient(0); - finally - Pages.EnableAlign; - end; - end else if NeighbourControl.Parent is TLazDockPage then begin - // NeighbourControl is on a page - // => insert a new page - NeighbourPage:=TLazDockPage(NeighbourControl.Parent); - NeighbourControlPageIndex:=NeighbourPage.PageIndex; - if PageNodeIndex>0 then begin - // insert left - PageIndex:=NeighbourControlPageIndex; - end else begin - // insert right - PageIndex:=NeighbourControlPageIndex+1; - end; - Pages.Pages.Insert(PageIndex,Control.Caption); - Page:=Pages.Page[PageIndex]; - Control.Parent:=Page; - Control.AnchorClient(0); - // TODO enlarge parents - end else begin - // NeighbourControl is a child control, but the parent is not yet a page - // => collect a rectangular area of neighbour controls to build a page - NeighbourList:=FindPageNeighbours(Layout,NeighbourControl,AnchorControls); - try - NeighbourControl.Parent.DisableAlign; - // TODO: create a PageControl and two pages. And move the neighbours onto - // one page and Control to the other page. - - // create a TLazDockPages - Pages:=TLazDockPages.Create(nil); - // add it to the place where the neighbours are - Pages.Parent:=NeighbourControl.Parent; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - Pages.AnchorSide[a].Control:=AnchorControls[a]; - if (AnchorControls[a]=Pages.Parent)=(a in [akLeft,akTop]) then - Pages.AnchorSide[a].Side:=asrLeft - else - Pages.AnchorSide[a].Side:=asrRight; - end; - Pages.Anchors:=[akLeft,akTop,akRight,akBottom]; - - // create the two pages - Pages.Pages.Insert(0,NeighbourControl.Caption); - NeighbourPage:=Pages.Page[0]; - - // move the neighbours - for i:=0 to NeighbourList.Count-1 do begin - NeighbourControl:=TControl(NeighbourList[i]); - NeighbourControl.Parent:=NeighbourPage; - // fix anchors - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - if NeighbourControl.AnchorSide[a].Control=AnchorControls[a] then begin - NeighbourControl.AnchorSide[a].Control:=NeighbourPage; - if a in [akLeft,akTop] then - NeighbourControl.AnchorSide[a].Side:=asrLeft; - end; - end; - end; - - // add a second page - PageIndex:=1; - Pages.Pages.Insert(PageIndex,Control.Caption); - Page:=Pages.Page[PageIndex]; - - // add the control into the second page - Control.Parent:=Page; - Control.AnchorClient(0); - - finally - NeighbourList.Free; - NeighbourControl.Parent.EnableAlign; - end; - end; - - Result:=true; -end; - -procedure TCustomLazControlDocker.FixControlBounds(Layout: TLazDockConfigNode; - ResizedControl: TControl); -{ Fix bounds after inserting AddedControl } -type - TControlInfo = record - Control: TControl; - Docker: TLazDockerConfig; - Node: TLazDockConfigNode; - MinLeft: integer; - MinLeftValid: boolean; - MinLeftCalculating: boolean; - MinTop: integer; - MinTopValid: boolean; - MinTopCalculating: boolean; - MinClientSize: TPoint; - MinClientSizeValid: boolean; - end; - PControlInfo = ^TControlInfo; -var - ControlToInfo: TPointerToPointerTree; - NodeToInfo: TPointerToPointerTree; - - procedure InitInfos; - begin - ControlToInfo:=TPointerToPointerTree.Create; - NodeToInfo:=TPointerToPointerTree.Create; - end; - - procedure FreeInfos; - var - AControlPtr: Pointer; - AnInfo: Pointer; - Info: PControlInfo; - begin - if ControlToInfo.GetFirst(AControlPtr,AnInfo) then begin - repeat - Info:=PControlInfo(AnInfo); - Dispose(Info); - until not ControlToInfo.GetNext(AControlPtr,AControlPtr,AnInfo); - end; - ControlToInfo.Free; - NodeToInfo.Free; - end; - - function GetInfo(AControl: TControl): PControlInfo; - begin - Result:=ControlToInfo[AControl]; - if Result=nil then begin - New(Result); - FillChar(Result^,SizeOf(TControlInfo),0); - Result^.Control:=AControl; - Result^.Node:= - Layout.FindByName(Manager.GetControlConfigName(AControl),true); - ControlToInfo[AControl]:=Result; - if ControlToInfo[AControl]<>Result then - RaiseGDBException(''); - end; - end; - - function CalculateMinimumLeft(AControl: TControl): integer; - var - Info: PControlInfo; - - procedure Improve(Neighbour: TControl); - begin - if Neighbour=nil then exit; - if Neighbour.Parent<>AControl.Parent then exit; - //DebugLn(['Left Improve AControl=',DbgSName(AControl),' Neighbour=',DbgSName(Neighbour)]); - Info^.MinLeft:=Max(Info^.MinLeft, - CalculateMinimumLeft(Neighbour)+Neighbour.Width); - end; - - var - i: Integer; - Sibling: TControl; - begin - Info:=GetInfo(AControl); - if not Info^.MinLeftValid then begin - //DebugLn(['CalculateMinimumLeft ',DbgSName(AControl)]); - if Info^.MinLeftCalculating then - raise Exception.Create('anchor circle (left)'); - Info^.MinLeftCalculating:=true; - - Info^.MinLeft:=0; - if (akLeft in AControl.Anchors) then - Improve(AControl.AnchorSide[akLeft].Control); - if AControl.Parent<>nil then begin - for i:=0 to AControl.Parent.ControlCount-1 do begin - Sibling:=AControl.Parent.Controls[i]; - if Sibling=AControl then continue; - if (akRight in Sibling.Anchors) - and (Sibling.AnchorSide[akRight].Control=AControl) then - Improve(Sibling); - end; - end; - - Info^.MinLeftCalculating:=false; - Info^.MinLeftValid:=true; - //DebugLn(['CalculateMinimumLeft END ',DbgSName(AControl),' ',GetInfo(AControl)^.MinLeftValid]); - end; - Result:=Info^.MinLeft; - end; - - function CalculateMinimumTop(AControl: TControl): integer; - var - Info: PControlInfo; - - procedure Improve(Neighbour: TControl); - begin - if Neighbour=nil then exit; - if Neighbour.Parent<>AControl.Parent then exit; - Info^.MinTop:=Max(Info^.MinTop, - CalculateMinimumTop(Neighbour)+Neighbour.Height); - end; - - var - i: Integer; - Sibling: TControl; - begin - Info:=GetInfo(AControl); - if not Info^.MinTopValid then begin - if Info^.MinTopCalculating then - raise Exception.Create('anchor circle (top)'); - Info^.MinTopCalculating:=true; - - Info^.MinTop:=0; - if (akTop in AControl.Anchors) then - Improve(AControl.AnchorSide[akTop].Control); - if AControl.Parent<>nil then begin - for i:=0 to AControl.Parent.ControlCount-1 do begin - Sibling:=AControl.Parent.Controls[i]; - if Sibling=AControl then continue; - if (akBottom in Sibling.Anchors) - and (Sibling.AnchorSide[akBottom].Control=AControl) then - Improve(Sibling); - end; - end; - - Info^.MinTopCalculating:=false; - Info^.MinTopValid:=true; - end; - Result:=Info^.MinTop; - end; - - function CalculateClientSize(AControl: TControl): TPoint; - var - AWinControl: TWinControl; - i: Integer; - ChildControl: TControl; - begin - Result:=Point(0,0); - if AControl is TWinControl then begin - AWinControl:=TWinControl(AControl); - for i:=0 to AWinControl.ControlCount-1 do begin - ChildControl:=AWinControl.Controls[i]; - Result.X:=Max(Result.X,CalculateMinimumLeft(ChildControl) - +ChildControl.Width); - Result.Y:=Max(Result.Y,CalculateMinimumTop(ChildControl) - +ChildControl.Height); - end; - end; - end; - - procedure ApplyBounds(ParentClientWidth, ParentClientHeight: Integer); - var - i: Integer; - Sibling: TControl; - Info: PControlInfo; - NewRect: TRect; - OldRect: TRect; - SideControl: TControl; - begin - for i:=0 to ResizedControl.Parent.ControlCount-1 do begin - Sibling:=ResizedControl.Parent.Controls[i]; - Info:=GetInfo(Sibling); - NewRect.Left:=Info^.MinLeft; - NewRect.Right:=NewRect.Left+Sibling.Width; - SideControl:=Sibling.AnchorSide[akRight].Control; - if (akRight in Sibling.Anchors) and (SideControl<>nil) then begin - if SideControl=ResizedControl.Parent then - NewRect.Right:=ParentClientWidth - else if SideControl.Parent=ResizedControl.Parent then - NewRect.Right:=CalculateMinimumLeft(SideControl); - end; - NewRect.Top:=Info^.MinTop; - NewRect.Bottom:=NewRect.Top+Sibling.Height; - SideControl:=Sibling.AnchorSide[akBottom].Control; - if (akBottom in Sibling.Anchors) and (SideControl<>nil) then begin - if SideControl=ResizedControl.Parent then - NewRect.Bottom:=ParentClientHeight - else if SideControl.Parent=ResizedControl.Parent then - NewRect.Bottom:=CalculateMinimumTop(SideControl); - end; - OldRect:=Sibling.BoundsRect; - if not CompareRect(@OldRect,@NewRect) then begin - DebugLn(['ApplyBounds Sibling=',DbgSName(Sibling),' NewRect=',dbgs(NewRect)]); - Sibling.BoundsRect:=NewRect; - end; - end; - end; - -var - ParentSize: TPoint; - CurParent: TWinControl; - DiffWidth: Integer; - DiffHeight: Integer; - AlignDisabledControl: TWinControl; -begin - DebugLn(['TCustomLazControlDocker.FixControlBounds ',DbgSName(ResizedControl)]); - CurParent:=ResizedControl.Parent; - if CurParent=nil then begin - DebugLn(['TCustomLazControlDocker.FixControlBounds WARNING: no parent']); - exit; - end; - CurParent.DisableAlign; - try - InitInfos; - // calculate minimum left, top, right, bottom of all siblings - ParentSize:=CalculateClientSize(CurParent); - DiffWidth:=ParentSize.X-CurParent.ClientWidth; - DiffHeight:=ParentSize.Y-CurParent.ClientHeight; - if (DiffWidth<>0) or (DiffHeight<>0) then begin - // parent needs resizing - DebugLn(['TCustomLazControlDocker.FixControlBounds Parent=',DbgSName(ResizedControl.Parent),' needs resizing to ',dbgs(ParentSize)]); - AlignDisabledControl:=CurParent.Parent; - if AlignDisabledControl<>nil then - AlignDisabledControl.DisableAlign; - try - CurParent.ClientWidth:=ParentSize.X; - CurParent.ClientHeight:=ParentSize.Y; - if CurParent.Parent<>nil then begin - // parent is a child - // => resize parent and fix the position recursively - FixControlBounds(Layout,CurParent); - end else begin - // parent is a free form - // => decide where to move the form on the screen using the Layout - - // TODO - DebugLn(['TCustomLazControlDocker.FixControlBounds TODO move parent ',DbgSName(CurParent)]); - end; - finally - if AlignDisabledControl<>nil then - AlignDisabledControl.EnableAlign; - end; - end; - ApplyBounds(ParentSize.X,ParentSize.Y); - finally - FreeInfos; - CurParent.EnableAlign; - end; -end; - -procedure TCustomLazControlDocker.ShrinkNeighbourhood( - Layout: TLazDockConfigNode; AControl: TControl; Sides: TAnchors); -{ shrink neighbour controls according to Layout - A neighbour is the first control left or top of AControl, that can be shrinked - and is only anchored to AControl. -} - procedure ShrinkControl(CurControl: TControl; Side: TAnchorKind); forward; - - procedure ShrinkNeighboursOnSide(CurControl: TControl; Side: TAnchorKind); - // shrink all controls, that are anchored on Side of CurControl - var - Neighbour: TControl; - i: Integer; - begin - DebugLn(['ShrinkNeighboursOnSide START ',DbgSName(CurControl),' ',DbgS(Side)]); - if Side in CurControl.Anchors then begin - Neighbour:=CurControl.AnchorSide[Side].Control; - DebugLn(['ShrinkNeighboursOnSide Neighbour=',DbgSName(Neighbour)]); - ShrinkControl(Neighbour,Side); - end; - for i:=0 to CurControl.Parent.ControlCount-1 do begin - Neighbour:=CurControl.Parent.Controls[i]; - if (OppositeAnchor[Side] in Neighbour.Anchors) - and (Neighbour.AnchorSide[OppositeAnchor[Side]].Control=CurControl) - then - ShrinkControl(Neighbour,Side); - end; - end; - - procedure ShrinkControl(CurControl: TControl; Side: TAnchorKind); - var - NodeName: String; - Node: TLazDockConfigNode; - CurBounds: TRect; - begin - DebugLn(['ShrinkControl START ',DbgSName(CurControl),' Side=',DbgS(Side)]); - if (CurControl=nil) or (CurControl=AControl) - or (CurControl.Parent<>AControl.Parent) then - exit; - if CurControl is TCustomSplitter then begin - // a splitter can not be shrinked - // => try to shrink the controls on the other side of the splitter - ShrinkNeighboursOnSide(CurControl,Side); - exit; - end; - // shrink according to Layout - NodeName:=Manager.GetControlConfigName(CurControl); - if NodeName='' then exit; - Node:=Layout.FindByName(NodeName,true); - if Node=nil then exit; - CurBounds:=Node.Bounds; - DebugLn(['ShrinkControl ',DbgSName(CurControl),' Side=',DbgS(Side),' LayoutBounds=',dbgs(CurBounds)]); - if Side in [akLeft,akRight] then - CurControl.Width:=Min(CurControl.Width,CurBounds.Right-CurBounds.Left) - else - CurControl.Height:=Min(CurControl.Height,CurBounds.Bottom-CurBounds.Top); - end; - -var - a: TAnchorKind; -begin - DebugLn(['TCustomLazControlDocker.ShrinkNeighbourhood AControl=',DbgSName(AControl)]); - AControl.Parent.DisableAlign; - try - for a:=Low(TAnchorKind) to High(TAnchorKind) do - if a in Sides then - ShrinkNeighboursOnSide(AControl,a); - finally - AControl.Parent.EnableAlign; - end; -end; - -function TCustomLazControlDocker.FindPageNeighbours(Layout: TLazDockConfigNode; - StartControl: TControl; out AnchorControls: TAnchorControlsRect): TFPList; -{ Creates a list of TControl, containing StartControl and neighbours, - which are on the same page according to Layout and are a rectangular area. - AnchorControls are the four boundaries of the rectangular area and the list - contains all controls within these boundaries (and with the same Parent as - StartControl). -} -type - TPageCompatibility = (pcUnknown, pcNotOnSamePage, pcSamePage); -var - ControlList: TFPList; - PageNode: TLazDockConfigNode; - Parent: TWinControl; - Compatibility: array of TPageCompatibility; - - procedure InitCompatibility; - var - i: Integer; - AControl: TControl; - NodeName: String; - Node: TLazDockConfigNode; - begin - // check all siblings if the Layout knows them - SetLength(Compatibility,Parent.ControlCount); - for i:=0 to Parent.ControlCount-1 do begin - Compatibility[i]:=pcUnknown; - AControl:=Parent.Controls[i]; - if AControl is TLazDockSplitter then continue; - NodeName:=Manager.GetControlConfigName(AControl); - if NodeName='' then continue; - Node:=Layout.FindByName(NodeName,true); - if Node<>nil then begin - if Node.Parent=PageNode then - Compatibility[i]:=pcSamePage - else - Compatibility[i]:=pcNotOnSamePage; - end; - end; - end; - - function CheckSolution(Candidates: TFPList): boolean; - var - ARect: TAnchorControlsRect; - AllList: TFPList; - i: Integer; - Index: LongInt; - begin - Result:=false; - // find the minimum rectangle around the current selection - if not GetEnclosingControlRect(Candidates,ARect) then exit; - // get the controls in the rectangle - AllList:=GetEnclosedControls(ARect); - try - for i:=0 to AllList.Count-1 do begin - Index:=Parent.GetControlIndex(TControl(AllList[i])); - if Index<0 then exit(false); - if Compatibility[Index]=pcNotOnSamePage then exit(false); - end; - // AllList fits => use it as solution - ControlList.Assign(AllList); - AnchorControls:=ARect; - Result:=true; - finally - AllList.Free; - end; - end; - - function TryLayoutSolution: boolean; - // check if a 1:1 of the layout is possible - var - i: Integer; - begin - ControlList.Clear; - for i:=0 to Parent.ControlCount-1 do begin - if Compatibility[i]=pcSamePage then - ControlList.Add(Parent.Controls[i]); - end; - Result:=CheckSolution(ControlList); - end; - - procedure TrySubsets; - // add controls to the selection - var - List: TFPList; - i: Integer; - begin - List:=TFPList.Create; - List.Add(StartControl); - CheckSolution(List); - i:=0; - repeat - // add on more control to the selection - if Compatibility[i]=pcSamePage then begin - List.Add(Parent.Controls[i]); - if not CheckSolution(List) then - List.Remove(Parent.Controls[i]); - end; - inc(i); - until false; - List.Free; - end; - -var - StartNodeName: String; - StartNode: TLazDockConfigNode; - a: TAnchorKind; -begin - // set defaults - ControlList:=TFPList.Create; - ControlList.Add(StartControl); - for a:=Low(TAnchorKind) to High(TAnchorKind) do - AnchorControls[a]:=StartControl.AnchorSide[a].Control; - - // check input - StartNodeName:=Manager.GetControlConfigName(StartControl); - if StartNodeName='' then exit; - StartNode:=Layout.FindByName(StartNodeName,true); - if StartNode=nil then exit; - PageNode:=StartNode.Parent; - if PageNode=nil then exit; - - // init - Parent:=StartControl.Parent; - InitCompatibility; - - // try some possibilities - if (not TryLayoutSolution) then - TrySubsets; - - Result:=ControlList; -end; - -procedure TCustomLazControlDocker.Notification(AComponent: TComponent; - Operation: TOperation); -var - Item: TLCDMenuItem; -begin - inherited Notification(AComponent, Operation); - if Operation=opRemove then - begin - Item := nil; - if AComponent=FControl then - begin - if FControl.PopupMenu <> nil then - Item := FindLCDMenuItem(FControl.PopupMenu); - FControl.RemoveAllHandlersOfObject(Self); - FControl:=nil; - end; - - if (AComponent is TMenu) then - Item := FindLCDMenuItem(TMenu(AComponent)); - - if (AComponent is TMenuItem) then - Item := FindLCDMenuItem(TMenu(AComponent)); - - if Item <> nil then - begin - FMenus.Remove(Item); - Item.Menu := nil; - if Item.Item <> AComponent then - FreeAndNil(Item.Item); - Item.Free; - end; - end; -end; - -function TCustomLazControlDocker.FindLCDMenuItem(AMenu: TMenu): TLCDMenuItem; -var - i: Integer; -begin - if (FMenus<>nil) and (AMenu<>nil) then - for i:=0 to FMenus.Count-1 do begin - Result:=TLCDMenuItem(FMenus[i]); - if Result.Menu=AMenu then exit; - end; - Result:=nil; -end; - -function TCustomLazControlDocker.FindLCDMenuItem(AMenuItem: TMenuItem - ): TLCDMenuItem; -var - i: Integer; -begin - if (FMenus<>nil) and (AMenuItem<>nil) then - for i:=0 to FMenus.Count-1 do begin - Result:=TLCDMenuItem(FMenus[i]); - if Result.Item=AMenuItem then exit; - end; - Result:=nil; -end; - -function TCustomLazControlDocker.GetControlName(AControl: TControl): string; -var - i: Integer; -begin - Result:=Manager.GetControlConfigName(AControl); - if Result='' then begin - if AControl=Control.Parent then - Result:=NonDockConfigNamePrefixes[ndcnParent] - else if AControl.Name<>'' then - Result:=NonDockConfigNamePrefixes[ndcnControlName]+AControl.Name - else if AControl.Parent<>nil then begin - i:=AControl.Parent.ControlCount-1; - while (i>=0) and (AControl.Parent.Controls[i]<>AControl) do dec(i); - Result:=NonDockConfigNamePrefixes[ndcnChildIndex]+IntToStr(i)+' ' - +AControl.ClassName; - end; - end; -end; - -procedure TCustomLazControlDocker.AddPopupMenu(Menu: TPopupMenu); -var - LCDItem: TLCDMenuItem; -begin - if FindLCDMenuItem(Menu)<>nil then exit; - if FMenus=nil then FMenus:=TFPList.Create; - LCDItem:=TLCDMenuItem.Create; - LCDItem.Menu:=Menu; - FMenus.Add(LCDItem); - Menu.FreeNotification(Self); - LCDItem.Item:=TMenuItem.Create(Self); - LCDItem.Item.Caption:=rsDocking; - LCDItem.Item.OnClick:=@PopupMenuItemClick; - Menu.Items.Add(LCDItem.Item); -end; - -procedure TCustomLazControlDocker.RemovePopupMenu(Menu: TPopupMenu); -var - Item: TLCDMenuItem; -begin - Item:=FindLCDMenuItem(Menu); - if Item=nil then exit; - FMenus.Remove(Item); - FreeAndNil(Item.Item); - Item.Menu:=nil; - Item.Free; -end; - -function TCustomLazControlDocker.GetLayoutFromControl: TLazDockConfigNode; - - procedure CopyChildsLayout(ParentNode: TLazDockConfigNode; - ParentNodeControl: TWinControl); - // saves for each child node the names of the anchor side controls - var - i: Integer; - ChildNode: TLazDockConfigNode; - ChildControl: TControl; - a: TAnchorKind; - ChildNames: TStringHashList;// name to control mapping - ChildName: String; - CurAnchorControl: TControl; - CurAnchorCtrlName: String; - CurAnchorNode: TLazDockConfigNode; - begin - ChildNames:=TStringHashList.Create(false); - try - // build mapping of name to control - ChildNames.Data[ParentNode.Name]:=ParentNodeControl; - for i:=0 to ParentNodeControl.ControlCount-1 do begin - ChildControl:=ParentNodeControl.Controls[i]; - ChildName:=GetControlName(ChildControl); - if ChildName<>'' then - ChildNames.Data[ChildName]:=ChildControl; - end; - // build mapping control to node - - // set 'Sides' - for i:=0 to ParentNode.ChildCount-1 do begin - ChildNode:=ParentNode[i]; - ChildControl:=TControl(ChildNames.Data[ChildNode.Name]); - if ChildControl=nil then continue; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - CurAnchorControl:=ChildControl.AnchorSide[a].Control; - if CurAnchorControl=nil then continue; - if CurAnchorControl=ParentNodeControl then - CurAnchorNode:=ParentNode - else begin - CurAnchorCtrlName:=GetControlName(CurAnchorControl); - CurAnchorNode:=ParentNode.FindByName(CurAnchorCtrlName); - if CurAnchorNode=nil then - RaiseGDBException('inconsistency'); - end; - //DebugLn('CopyChildsLayout ',DbgSName(CurAnchorControl),' CurAnchorCtrlName="',CurAnchorCtrlName,'"'); - ChildNode.Sides[a]:=CurAnchorNode.Name; - end; - end; - finally - ChildNames.Free; - end; - end; - - function AddNode(ParentNode: TLazDockConfigNode; - AControl: TControl): TLazDockConfigNode; - var - i: Integer; - CurChildControl: TControl; - NeedChildNodes: boolean; - begin - Result:=TLazDockConfigNode.Create(ParentNode,GetControlName(AControl)); - - // The Type - if AControl is TLazDockSplitter then begin - if TLazDockSplitter(AControl).ResizeAnchor in [akLeft,akRight] then - Result.FTheType:=ldcntSplitterLeftRight - else - Result.FTheType:=ldcntSplitterUpDown; - end else if AControl is TLazDockForm then - Result.FTheType:=ldcntForm - else if AControl is TLazDockPages then - Result.FTheType:=ldcntPages - else if AControl is TLazDockPage then - Result.FTheType:=ldcntPage - else - Result.FTheType:=ldcntControl; - - // Bounds - Result.FBounds:=AControl.BoundsRect; - if AControl is TWinControl then - Result.FClientBounds:=TWinControl(AControl).GetChildsRect(false) - else - Result.FClientBounds:=Rect(0,0,Result.FBounds.Right-Result.FBounds.Left, - Result.FBounds.Bottom-Result.FBounds.Top); - - // windowstate - if AControl is TCustomForm then - Result.WindowState:=TCustomForm(AControl).WindowState; - - // Children - if (AControl is TWinControl) then begin - // check if children need nodes - NeedChildNodes:=(AControl is TLazDockPages) - or (AControl is TLazDockPage); - if not NeedChildNodes then begin - for i:=0 to TWinControl(AControl).ControlCount-1 do begin - CurChildControl:=TWinControl(AControl).Controls[i]; - if Manager.FindDockerByControl(CurChildControl,nil)<>nil then begin - NeedChildNodes:=true; - break; - end; - end; - end; - // add child nodes - if NeedChildNodes then begin - for i:=0 to TWinControl(AControl).ControlCount-1 do begin - CurChildControl:=TWinControl(AControl).Controls[i]; - AddNode(Result,CurChildControl); - end; - for i:=0 to Result.ChildCount-1 do begin - end; - end; - CopyChildsLayout(Result,TWinControl(AControl)); - end; - end; - -var - RootControl: TControl; -begin - if (Control=nil) or (Manager=nil) then exit(nil); - - RootControl:=Control; - while RootControl.Parent<>nil do - RootControl:=RootControl.Parent; - Result:=AddNode(nil,RootControl); -end; - -procedure TCustomLazControlDocker.SaveLayout; -var - Layout: TLazDockConfigNode; -begin - if Manager=nil then exit; - Layout:=GetLayoutFromControl; - if (Layout=nil) then exit; - Manager.AddOrReplaceConfig(DockerName,Layout); -end; - -procedure TCustomLazControlDocker.RestoreLayout; -{ Goals of this algorithm: - - If a form is hidden and immediately shown again, the layout should be - restored 1:1. - That's why a TCustomLazControlDocker stores the complete layout on every - hide. And restores it on every show. - - If an application is closed and all dock forms are closed (in any order) - the layout should be restored on startup, when the forms - are created (in any order). - This is done by saving the layout before all forms are closed. - - - Example 1: Docking to a side. - - Current: - +---+ - | A | - +---+ - - Formerly: - +------------+ - |+---+|+----+| - || A |||Self|| - |+---+|+----+| - +------------+ - - Then put A into a new TLazDockForm, add a splitter and Self. - - - Example 2: Docking in between - - Current: - +-----------+ - |+---+|+---+| - || A ||| C || - |+---+|+---+| - +-----------+ - - Formerly: - +------------------+ - |+---+|+----+|+---+| - || A |||Self||| C || - |+---+|+----+|+---+| - +------------------+ - - Then enlarge the parent of A and C, add a splitter and Self. - - Example: - - Formerly: - +-------------------------+ - |+-----------------------+| - || A || - |+-----------------------+| - |=========================| - |+---+#+-----------+#+---+| - || D |#| |#| || - |+---+#| |#| || - |=====#| B |#| E || - |+---+#| |#| || - || |#| |#| || - || |#+-----------+#+---+| - || F |#===================| - || |#+-----------------+| - || |#| C || - |+---+#+-----------------+| - +-------------------------+ - - - 1. Showing A: - There is no other form yet, so just show it at the old position. - +-----------------------+ - | A | - +-----------------------+ - - - 2. Showing B: - B is the bottom sibling of A. Put A into a new TLazDockForm, add a splitter, - enlarge B horizontally. - - +-------------------------+ - |+-----------------------+| - || A || - |+-----------------------+| - |=========================| - |+-----------------------+| - || || - || || - || B || - || || - || || - |+-----------------------+| - +-------------------------+ - - - 3. Showing C: - C is the bottom sibling of B. Enlarge the parent vertically, add a splitter - and enlarge C horizontally. - - +-------------------------+ - |+-----------------------+| - || A || - |+-----------------------+| - |=========================| - |+-----------------------+| - || || - || || - || B || - || || - || || - |+-----------------------+| - |=========================| - |+-----------------------+| - || C || - |+-----------------------+| - +-------------------------+ - - - 4. Showing D: - D is below of A, and left of B and C. Shrink B and C, add a splitter. - - +-------------------------+ - |+-----------------------+| - || A || - |+-----------------------+| - |=========================| - |+---+#+-----------------+| - || |#| || - || |#| || - || |#| B || - || |#| || - || D |#| || - || |#+-----------------+| - || |#===================| - || |#+-----------------+| - || |#| C || - |+---+#+-----------------+| - +-------------------------+ - - - 5. Showing E: - Shrink B, add a splitter. - - +-------------------------+ - |+-----------------------+| - || A || - |+-----------------------+| - |=========================| - |+---+#+-----------+#+---+| - || |#| |#| || - || |#| |#| || - || |#| B |#| E || - || |#| |#| || - || D |#| |#| || - || |#+-----------+#+---+| - || |#===================| - || |#+-----------------+| - || |#| C || - |+---+#+-----------------+| - +-------------------------+ - - - 6. Showing F: - Shrink D and add a splitter. - - +-------------------------+ - |+-----------------------+| - || A || - |+-----------------------+| - |=========================| - |+---+#+-----------+#+---+| - || D |#| |#| || - |+---+#| |#| || - |=====#| B |#| E || - |+---+#| |#| || - || |#| |#| || - || |#+-----------+#+---+| - || F |#===================| - || |#+-----------------+| - || |#| C || - |+---+#+-----------------+| - +-------------------------+ - } -var - Layout: TLazDockConfigNode; - SelfNode: TLazDockConfigNode; - - function FindNode(const ANodeName: string): TLazDockConfigNode; - begin - if ANodeName='' then - Result:=nil - else - Result:=Layout.FindByName(ANodeName,true,true); - end; - - function FindControl(const ADockerName: string): TControl; - begin - Result:=Manager.FindControlByDockerName(ADockerName); - end; - - function DockWithSpiralSplitter: boolean; - begin - // TODO - Result:=false; - end; - - function SplitterDocking: boolean; - var - a: TAnchorKind; - SplitterCount: Integer; - SideNode: TLazDockConfigNode; - begin - Result:=false; - SplitterCount:=0; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - SideNode:=FindNode(SelfNode.Sides[a]); - if (SideNode<>nil) - and (SideNode.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown]) - then begin - if SideNode.IsTheOnlyNeighbour(SelfNode,a) - and CreateFormAndDockWithSplitter(Layout,a) then - exit(true); - inc(SplitterCount); - if (SplitterCount=4) and DockWithSpiralSplitter then - exit(true); - end; - end; - end; - - function PageDocking: boolean; - begin - Result:=false; - if (SelfNode.TheType<>ldcntPage) then exit; - if (SelfNode.Parent.ChildCount<>1) then exit; - Result:=DockAsPage(Layout); - end; - -var - NewBounds: TRect; -begin - {$IFDEF VerboseAnchorDocking} - DebugLn(['TCustomLazControlDocker.RestoreLayout A ',DockerName,' Control=',DbgSName(Control)]); - {$ENDIF} - if (Manager=nil) or (Control=nil) then exit; - Layout:=nil; - try - Layout:=Manager.CreateLayout(DockerName,Control,false); - if (Layout=nil) then exit; - SelfNode:=Layout.FindByName(DockerName,true); - DebugLn(['TCustomLazControlDocker.RestoreLayout ',SelfNode<>nil,' DockerName=',DockerName]); - if (SelfNode=nil) or (SelfNode.TheType<>ldcntControl) then exit; - - if SelfNode.Parent<>nil then begin - // this control was docked - if SplitterDocking then exit; - if PageDocking then exit; - end; - - // default: do not dock, just move - DebugLn(['TCustomLazControlDocker.RestoreLayout ',DockerName,' not docking, just moving ...']); - NewBounds:=SelfNode.GetScreenBounds; - Control.SetBoundsKeepBase(NewBounds.Left,NewBounds.Top, - NewBounds.Right-NewBounds.Left, - NewBounds.Bottom-NewBounds.Top); - DebugLn(['TCustomLazControlDocker.RestoreLayout ',WindowStateToStr(Layout.WindowState),' Layout.Name=',Layout.Name]); - if (Control is TCustomForm) and (Control.Parent=nil) then - TCustomForm(Control).WindowState:=Layout.WindowState; - finally - DebugLn(['TCustomLazControlDocker.RestoreLayout END Control=',DbgSName(Control),' Control.BoundsRect=',dbgs(Control.BoundsRect)]); - Layout.Free; - end; -end; - -procedure TCustomLazControlDocker.DisableLayout; -begin - inc(fLayoutLock); -end; - -procedure TCustomLazControlDocker.EnableLayout; -begin - dec(fLayoutLock); -end; - -function TCustomLazControlDocker.ControlIsDocked: boolean; -begin - Result:=(Control<>nil) - and (Control.Parent<>nil) - and ((Control.Parent is TLazDockForm) or (Control.Parent is TLazDockPage)); -end; - -constructor TCustomLazControlDocker.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - if (not (csLoading in ComponentState)) - and (TheOwner is TControl) then - // use as default - Control:=TControl(TheOwner); - ExtendPopupMenu:=true; -end; - -destructor TCustomLazControlDocker.Destroy; -var - i: integer; - Item: TLCDMenuItem; - OldMenus: TFPList; -begin - Control:=nil; - Manager:=nil; - inherited Destroy; - if FMenus <> nil then begin - OldMenus:=FMenus; - FMenus:=nil; - for i := OldMenus.Count - 1 downto 0 do - begin - Item:=TLCDMenuItem(OldMenus[i]); - FreeAndNil(Item.Item); - Item.Free; - end; - OldMenus.Free; - end; -end; - -procedure TCustomLazControlDocker.PopupMenuItemClick(Sender: TObject); -begin - ShowDockingEditor; -end; - -procedure TCustomLazControlDocker.SetControl(const AValue: TControl); -var - WinControl: TWinControl; -begin - if FControl=AValue then exit; - if FControl<>nil then begin - FControl.RemoveAllHandlersOfObject(Self); - FControl.RemoveFreeNotification(Self); - if (Manager<>nil) and (FControl is TWinControl) then - begin - WinControl:=TWinControl(FControl); - WinControl.UseDockManager:=false; - WinControl.DockManager:=nil; - end; - end; - FControl:=AValue; - if Control<>nil then begin - Control.AddHandlerOnVisibleChanging(@ControlVisibleChanging); - Control.AddHandlerOnVisibleChanged(@ControlVisibleChanged); - Control.FreeNotification(Self); - if (Manager<>nil) and (FControl is TWinControl) then - begin - WinControl:=TWinControl(FControl); - WinControl.DockManager:=Manager.Manager; - WinControl.UseDockManager:=true; - end; - end; - if (DockerName='') and (FControl<>nil) then - DockerName:=FControl.Name; - UpdatePopupMenu; -end; - -procedure TCustomLazControlDocker.SetDockerName(const AValue: string); -var - NewDockerName: String; -begin - if FDockerName=AValue then exit; - NewDockerName:=AValue; - if Manager<>nil then - NewDockerName:=Manager.CreateUniqueName(NewDockerName,Self); - FDockerName:=NewDockerName; -end; - -procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean); -begin - if FExtendPopupMenu=AValue then exit; - FExtendPopupMenu:=AValue; - UpdatePopupMenu; -end; - -procedure TCustomLazControlDocker.SetLocalizedName(const AValue: string); -begin - if FLocalizedName=AValue then exit; - FLocalizedName:=AValue; -end; - -{ TCustomLazDockingManager } - -procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker); -var - WinControl: TWinControl; -begin - if Docker.Control is TWinControl then - begin - WinControl:=TWinControl(Docker.Control); - WinControl.UseDockManager:=false; - WinControl.DockManager:=nil; - end; - FDockers.Remove(Docker); -end; - -function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer; -var - WinControl: TWinControl; -begin - Docker.DockerName:=CreateUniqueName(Docker.DockerName,nil); - Result:=FDockers.Add(Docker); - if Docker.Control is TWinControl then - begin - WinControl:=TWinControl(Docker.Control); - WinControl.DockManager:=Manager; - WinControl.UseDockManager:=true; - end; -end; - -function TCustomLazDockingManager.GetDockers(Index: Integer - ): TCustomLazControlDocker; -begin - Result:=TCustomLazControlDocker(FDockers[Index]); -end; - -function TCustomLazDockingManager.GetDockerCount: Integer; -begin - Result:=FDockers.Count; -end; - -function TCustomLazDockingManager.GetConfigCount: Integer; -begin - if FConfigs<>nil then - Result:=FConfigs.Count - else - Result:=0; -end; - -function TCustomLazDockingManager.GetConfigs(Index: Integer - ): TLazDockerConfig; -begin - Result:=TLazDockerConfig(FConfigs[Index]); -end; - -constructor TCustomLazDockingManager.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - FDockers:=TFPList.Create; - FManager:=TAnchoredDockManager.Create(nil); - FManager.FConfigs:=Self; -end; - -destructor TCustomLazDockingManager.Destroy; -var - i: Integer; -begin - for i:=FDockers.Count-1 downto 0 do - Dockers[i].Manager:=nil; - FreeAndNil(FDockers); - FreeAndNil(FManager); - ClearConfigs; - FreeAndNil(FConfigs); - inherited Destroy; -end; - -function TCustomLazDockingManager.FindDockerByName(const ADockerName: string; - Ignore: TCustomLazControlDocker): TCustomLazControlDocker; -var - i: Integer; -begin - i:=DockerCount-1; - while (i>=0) do begin - Result:=Dockers[i]; - if (CompareText(Result.DockerName,ADockerName)=0) and (Ignore<>Result) then - exit; - dec(i); - end; - Result:=nil; -end; - -function TCustomLazDockingManager.FindControlByDockerName( - const ADockerName: string; Ignore: TCustomLazControlDocker): TControl; -var - Docker: TCustomLazControlDocker; -begin - Docker:=FindDockerByName(ADockerName); - if Docker=nil then - Result:=nil - else - Result:=Docker.Control; -end; - -function TCustomLazDockingManager.FindDockerByControl(AControl: TControl; - Ignore: TCustomLazControlDocker): TCustomLazControlDocker; -var - i: Integer; -begin - i:=DockerCount-1; - while (i>=0) do begin - Result:=Dockers[i]; - if (Result.Control=AControl) and (Ignore<>Result) then - exit; - dec(i); - end; - Result:=nil; -end; - -function TCustomLazDockingManager.CreateUniqueName(const AName: string; - Ignore: TCustomLazControlDocker): string; -begin - Result:=AName; - if FindDockerByName(Result,Ignore)=nil then exit; - Result:=CreateFirstIdentifier(Result); - while FindDockerByName(Result,Ignore)<>nil do - Result:=CreateNextIdentifier(Result); -end; - -function TCustomLazDockingManager.GetControlConfigName(AControl: TControl - ): string; -var - Docker: TCustomLazControlDocker; -begin - Docker:=FindDockerByControl(AControl,nil); - if Docker<>nil then - Result:=Docker.DockerName - else - Result:=''; -end; - -procedure TCustomLazDockingManager.DisableLayout(Control: TControl); -var - Docker: TCustomLazControlDocker; -begin - Docker:=FindDockerByControl(Control); - if Docker<>nil then - Docker.DisableLayout; -end; - -procedure TCustomLazDockingManager.EnableLayout(Control: TControl); -var - Docker: TCustomLazControlDocker; -begin - Docker:=FindDockerByControl(Control); - if Docker<>nil then - Docker.EnableLayout; -end; - -procedure TCustomLazDockingManager.SaveToConfig(Config: TConfigStorage; - const Path: string); -var - i: Integer; - ADocker: TCustomLazControlDocker; - CurDockConfig: TLazDockerConfig; - SubPath: String; -begin - // collect configs - for i:=0 to DockerCount-1 do begin - ADocker:=Dockers[i]; - if ((ADocker.Control<>nil) and ADocker.Control.Visible) then begin - ADocker.SaveLayout; - end; - end; - - // save configs - Config.SetDeleteValue(Path+'Configs/Count',ConfigCount,0); - for i:=0 to ConfigCount-1 do begin - SubPath:=Path+'Config'+IntToStr(i)+'/'; - CurDockConfig:=Configs[i]; - Config.SetDeleteValue(SubPath+'DockerName/Value',CurDockConfig.DockerName,''); - CurDockConfig.Root.SaveToConfig(Config,SubPath); - end; -end; - -procedure TCustomLazDockingManager.LoadFromConfig(Config: TConfigStorage; - const Path: string); -var - i: Integer; - NewConfigCount: LongInt; - SubPath: String; - NewRoot: TLazDockConfigNode; - NewDockerName: String; - NewRootName: String; -begin - // merge the configs - NewConfigCount:=Config.GetValue(Path+'Configs/Count',0); - //DebugLn(['TCustomLazDockingManager.LoadFromConfig NewConfigCount=',NewConfigCount]); - for i:=0 to NewConfigCount-1 do begin - SubPath:=Path+'Config'+IntToStr(i)+'/'; - NewDockerName:=Config.GetValue(SubPath+'DockerName/Value',''); - if NewDockerName='' then continue; - NewRootName:=Config.GetValue(SubPath+'Name/Value',''); - if NewRootName='' then continue; - //DebugLn(['TCustomLazDockingManager.LoadFromConfig NewDockerName=',NewDockerName,' NewRootName=',NewRootName]); - NewRoot:=TLazDockConfigNode.Create(nil,NewRootName); - NewRoot.LoadFromConfig(Config,SubPath); - AddOrReplaceConfig(NewDockerName,NewRoot); - //NewRoot.WriteDebugReport; - end; -end; - -procedure TCustomLazDockingManager.AddOrReplaceConfig( - const DockerName: string; Config: TLazDockConfigNode); -var - i: Integer; - CurConfig: TLazDockerConfig; -begin - if FConfigs=nil then - FConfigs:=TFPList.Create; - for i:=FConfigs.Count-1 downto 0 do begin - CurConfig:=Configs[i]; - if CompareText(CurConfig.DockerName,DockerName)=0 then begin - CurConfig.FRoot.Free; - CurConfig.FRoot:=Config; - exit; - end; - end; - FConfigs.Add(TLazDockerConfig.Create(DockerName,Config)); -end; - -procedure TCustomLazDockingManager.WriteDebugReport; -var - i: Integer; - ADocker: TCustomLazControlDocker; -begin - DebugLn('TCustomLazDockingManager.WriteDebugReport DockerCount=',dbgs(DockerCount)); - for i:=0 to DockerCount-1 do begin - ADocker:=Dockers[i]; - DebugLn(' ',dbgs(i),' Name="',ADocker.Name,'" DockerName="',ADocker.DockerName,'"'); - end; -end; - -procedure TCustomLazDockingManager.ClearConfigs; -var - i: Integer; -begin - if FConfigs=nil then exit; - for i:=0 to FConfigs.Count-1 do TObject(FConfigs[i]).Free; - FConfigs.Clear; -end; - -function TCustomLazDockingManager.GetConfigWithDockerName( - const DockerName: string): TLazDockerConfig; -var - i: Integer; -begin - i:=ConfigCount-1; - while (i>=0) do begin - Result:=Configs[i]; - if CompareText(Result.DockerName,DockerName)=0 then exit; - dec(i); - end; - Result:=nil; -end; - -function TCustomLazDockingManager.CreateLayout(const DockerName: string; - VisibleControl: TControl; ExceptionOnError: boolean): TLazDockConfigNode; -// create a usable config -// This means: search a config, create a copy -// and remove all nodes without visible controls. -{$DEFINE VerboseAnchorDockCreateLayout} -var - Root: TLazDockConfigNode; - CurDockControl: TControl; - - function ControlIsVisible(AControl: TControl): boolean; - begin - Result:=false; - if (AControl=nil) then exit; - if (not AControl.IsVisible) and (AControl<>VisibleControl) then exit; - if (CurDockControl<>nil) and (CurDockControl<>AControl.GetTopParent) then - exit; - Result:=true; - end; - - function FindNode(const AName: string): TLazDockConfigNode; - begin - if AName='' then - Result:=nil - else - Result:=Root.FindByName(AName,true,true); - end; - - procedure DeleteNode(var DeletingNode: TLazDockConfigNode); - - function DeleteOwnSideSplitter(Side: TAnchorKind; - var SplitterNode: TLazDockConfigNode): boolean; - { check if DeletingNode has a splitter to Side, and this node is the only - node anchored to the splitter at this side. - If yes, it removes the splitter and the DeletingNode and reconnects the - nodes using the splitter with the opposite side - For example: - ---------+ --------+ - --+#+---+| ---+| - B |#| || B || - --+#| || ---+| - ====| A || -> ====| - --+#| || ---+| - C |#| || C || - --+#+---+| ---+| - ---------+ --------+ - } - var - i: Integer; - Sibling: TLazDockConfigNode; - OppositeSide: TAnchorKind; - begin - Result:=false; - // check if this is the only node using this Side of the splitter - if not SplitterNode.IsTheOnlyNeighbour(DeletingNode,Side) then - exit; - - // All nodes, that uses the splitter from the other side will now be - // anchored to the other side of DeletingNode - OppositeSide:=OppositeAnchor[Side]; - for i:=0 to DeletingNode.Parent.ChildCount-1 do begin - Sibling:=DeletingNode.Parent.Children[i]; - if CompareText(Sibling.Sides[OppositeSide],SplitterNode.Name)=0 then - Sibling.Sides[OppositeSide]:=DeletingNode.Sides[OppositeSide]; - end; - - // delete splitter - FreeAndNil(SplitterNode); - - Result:=true; - end; - - function UnbindSpiralNode: boolean; - { DeletingNode has 4 splitters like a spiral. - In this case merge the two vertical splitters. - For example: - | | - -------| -----| - |+---+| | - || A || -> | - |+---+| | - |-------- |------ - | | - } - var - LeftSplitter: TLazDockConfigNode; - RightSplitter: TLazDockConfigNode; - i: Integer; - Sibling: TLazDockConfigNode; - begin - LeftSplitter:=FindNode(DeletingNode.Sides[akLeft]); - RightSplitter:=FindNode(DeletingNode.Sides[akRight]); - // remove LeftSplitter - - // 1. enlarge RightSplitter - if CompareText(RightSplitter.Sides[akTop],DeletingNode.Sides[akTop])=0 then - RightSplitter.Sides[akTop]:=LeftSplitter.Sides[akTop]; - if CompareText(RightSplitter.Sides[akBottom],DeletingNode.Sides[akBottom])=0 then - RightSplitter.Sides[akBottom]:=LeftSplitter.Sides[akBottom]; - - // 2. anchor all siblings using LeftSplitter to now use RightSplitter - for i:=0 to DeletingNode.Parent.ChildCount-1 do begin - Sibling:=DeletingNode.Parent.Children[i]; - if Sibling=DeletingNode then continue; - if CompareText(Sibling.Sides[akLeft],LeftSplitter.Name)=0 then - Sibling.Sides[akLeft]:=RightSplitter.Name; - if CompareText(Sibling.Sides[akRight],LeftSplitter.Name)=0 then - Sibling.Sides[akRight]:=RightSplitter.Name; - end; - - // 3. delete LeftSplitter - FreeAndNil(LeftSplitter); - - Result:=true; - end; - - var - a: TAnchorKind; - SiblingNode: TLazDockConfigNode; - SplitterCount: Integer;// number of shared splitters - begin - DebugLn(['DeleteNode ',DeletingNode.Name]); - SplitterCount:=0; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - SiblingNode:=FindNode(DeletingNode.Sides[a]); - if (SiblingNode<>nil) - and (SiblingNode.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown]) - then begin - // there is a splitter - if DeleteOwnSideSplitter(a,SiblingNode) then begin - // splitter deleted - break; - end else begin - inc(SplitterCount);// not own => shared - if SplitterCount=4 then begin - // this is a spiral splitter node -> merge two splitters - UnbindSpiralNode; - break; - end; - end; - end; - end; - FreeAndNil(DeletingNode); - end; - - procedure SimplifyOnePageNode(var PagesNode: TLazDockConfigNode); - { PagesNode has only one page left. - Remove Page and Pages node and move the content to the parent - } - var - ParentNode: TLazDockConfigNode; - PageNode: TLazDockConfigNode; - i: Integer; - Child: TLazDockConfigNode; - ChildBounds: TRect; - PagesBounds: TRect; - OffsetX: Integer; - OffsetY: Integer; - a: TAnchorKind; - begin - DebugLn(['SimplifyOnePageNode ',dbgs(PagesNode)]); - ParentNode:=PagesNode.Parent; - if ParentNode=nil then RaiseGDBException(''); - if (PagesNode.TheType<>ldcntPages) then RaiseGDBException(''); - if PagesNode.ChildCount<>1 then RaiseGDBException(''); - PageNode:=PagesNode.Children[0]; - PagesBounds:=PagesNode.Bounds; - OffsetX:=PagesBounds.Left; - OffsetY:=PagesBounds.Top; - for i:=0 to PageNode.ChildCount-1 do begin - Child:=PageNode.Children[i]; - // changes parent of child - Child.Parent:=ParentNode; - // move children to place where PagesNode was - ChildBounds:=Child.Bounds; - OffsetRect(ChildBounds,OffsetX,OffsetY); - Child.Bounds:=ChildBounds; - // change anchors of child - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - if CompareText(Child.Sides[a],PageNode.Name)=0 then - Child.Sides[a]:=PagesNode.Sides[a]; - end; - end; - FreeAndNil(PagesNode); - //debugln(Root.DebugLayoutAsString); - end; - - procedure SimplifyOneChildForm(var FormNode: TLazDockConfigNode); - { FormNode has only one child left. - Remove Form node and replace root with child - } - var - FormBounds: TRect; - OffsetX: LongInt; - OffsetY: LongInt; - Child: TLazDockConfigNode; - ChildBounds: TRect; - a: TAnchorKind; - OldFormNode: TLazDockConfigNode; - begin - //DebugLn(['SimplifyOneChildForm ',dbgs(FormNode)]); - if FormNode<>Root then RaiseGDBException(''); - if FormNode.ChildCount<>1 then RaiseGDBException(''); - FormBounds:=FormNode.Bounds; - OffsetX:=FormBounds.Left; - OffsetY:=FormBounds.Top; - Child:=FormNode.Children[0]; - // changes parent of child - Child.Parent:=FormNode.Parent; - Child.WindowState:=FormNode.WindowState; - // move child to place where FormNode was - ChildBounds:=Child.Bounds; - OffsetRect(ChildBounds,OffsetX,OffsetY); - Child.Bounds:=ChildBounds; - // change anchors of child - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - if CompareText(Child.Sides[a],FormNode.Name)=0 then - Child.Sides[a]:=FormNode.Sides[a]; - end; - OldFormNode:=FormNode; - FormNode:=Child; - OldFormNode.Free; - //Root.WriteDebugReport; - end; - - procedure RemoveEmptyNodes(var Node: TLazDockConfigNode); - // remove unneeded child nodes - // if no children left and Node itself is unneeded, it s freed and set to nil - var - i: Integer; - Docker: TCustomLazControlDocker; - Child: TLazDockConfigNode; - begin - if Node=nil then exit; - {$IFDEF VerboseAnchorDockCreateLayout} - DebugLn(['RemoveEmptyNodes ',Node.Name,' Node.ChildCount=',Node.ChildCount]); - {$ENDIF} - - // remove unneeded children - i:=Node.ChildCount-1; - while i>=0 do begin - Child:=Node.Children[i]; - RemoveEmptyNodes(Child);// beware: this can delete more than one child - dec(i); - if i>=Node.ChildCount then i:=Node.ChildCount-1; - end; - - case Node.TheType of - ldcntControl: - begin - Docker:=FindDockerByName(Node.Name); - // if the associated control does not exist or is not visible, - // then delete the node - if (Docker=nil) then begin - {$IFDEF VerboseAnchorDockCreateLayout} - DebugLn(['RemoveEmptyNodes delete unknown node: ',dbgs(Node)]); - {$ENDIF} - DeleteNode(Node); - end - else if not ControlIsVisible(Docker.Control) then begin - {$IFDEF VerboseAnchorDockCreateLayout} - DebugLn(['RemoveEmptyNodes delete invisible node: ',dbgs(Node)]); - {$ENDIF} - DeleteNode(Node); - end; - end; - ldcntPage: - // these are auto created parent node. If they have no children: delete - if Node.ChildCount=0 then begin - {$IFDEF VerboseAnchorDockCreateLayout} - DebugLn(['RemoveEmptyNodes delete node without children: ',dbgs(Node)]); - {$ENDIF} - DeleteNode(Node); - end; - ldcntForm: - // these are auto created parent node. If they have no children: delete - // if they have only one child: delete node and move children up - if Node.ChildCount=0 then begin - {$IFDEF VerboseAnchorDockCreateLayout} - DebugLn(['RemoveEmptyNodes delete node without children: ',dbgs(Node)]); - {$ENDIF} - DeleteNode(Node); - end else if Node.ChildCount=1 then begin - // Only one child left - SimplifyOneChildForm(Node); - end; - ldcntPages: - // these are auto created parent node. If they have no children: delete - // if they have only one child: delete node and move child up - if Node.ChildCount=0 then begin - {$IFDEF VerboseAnchorDockCreateLayout} - DebugLn(['RemoveEmptyNodes delete node without children: ',dbgs(Node)]); - {$ENDIF} - DeleteNode(Node); - end else if Node.ChildCount=1 then begin - // Only one child left - SimplifyOnePageNode(Node); - end; - end; - end; - - function AllControlsAreOnSameForm: boolean; - var - RootForm: TControl; - - function Check(Node: TLazDockConfigNode): boolean; - var - i: Integer; - CurForm: TControl; - begin - if Node.TheType=ldcntControl then begin - CurForm:=FindControlByDockerName(Node.Name); - if (CurForm<>nil) then begin - while CurForm.Parent<>nil do - CurForm:=CurForm.Parent; - if CurForm<>VisibleControl then begin - if RootForm=nil then - RootForm:=CurForm - else if RootForm<>CurForm then - exit(false); - end; - end; - end; - // check children - for i:=0 to Node.ChildCount-1 do - if not Check(Node.Children[i]) then exit(false); - Result:=true; - end; - - begin - RootForm:=nil; - Result:=Check(Root); - end; - - // FPC bug: when this function is internal of FindNearestControlNode then get win32 linker error - function FindOwnSplitterSiblingWithControl(Node: TLazDockConfigNode - ): TLazDockConfigNode; - { find a sibling, that is a direct neighbour behind a splitter, and the - splitter is only used by the node and the sibling - For example: - ---------+ - --+#+---+| - B |#| A || - --+#+---+| - ---------+ - } - var - a: TAnchorKind; - SplitterNode: TLazDockConfigNode; - begin - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - if Node.Sides[a]='' then continue; - SplitterNode:=FindNode(Node.Sides[a]); - if (SplitterNode.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown]) - and SplitterNode.IsTheOnlyNeighbour(Node,a) then begin - Result:=SplitterNode.FindNeighbour(OppositeAnchor[a],true); - if Result<>nil then exit; - end; - end; - Result:=nil; - end; - - function FindNearestControlNode: TLazDockConfigNode; - - function FindSiblingWithControl(Node: TLazDockConfigNode - ): TLazDockConfigNode; - var - ParentNode: TLazDockConfigNode; - i: Integer; - begin - ParentNode:=Node.Parent; - for i:=0 to ParentNode.ChildCount-1 do begin - Result:=ParentNode.Children[i]; - if CompareText(Result.Name,DockerName)=0 then continue; - if Result.TheType=ldcntControl then - exit; - end; - Result:=nil; - end; - - function FindPageSiblingWithControl(Node: TLazDockConfigNode - ): TLazDockConfigNode; - { find direct page sibling - This means: - Node is the only child of a page - A sibling page has a single child with a control - } - var - PagesNode: TLazDockConfigNode; - PageNode: TLazDockConfigNode; - PageIndex: LongInt; - begin - // check if node is on a page without siblings - PageNode:=Node.Parent; - if (PageNode=nil) or (PageNode.TheType<>ldcntPage) - or (PageNode.ChildCount>1) then exit; - // check if left page has only one control - PagesNode:=PageNode.Parent; - PageIndex:=PagesNode.IndexOf(PageNode.Name); - if (PageIndex>0) - and (PagesNode[PageIndex-1].ChildCount=1) then begin - Result:=PagesNode[PageIndex-1].Children[0]; - if Result.TheType=ldcntControl then exit; - end; - // check if right page has only one control - if (PageIndex0) then - exit(Node); - for i:=0 to Node.ChildCount-1 do begin - Result:=FindOtherNodeWithControl(Node.Children[i]); - if Result<>nil then exit; - end; - end; - - var - Node: TLazDockConfigNode; - begin - Node:=FindNode(DockerName); - Result:=FindOwnSplitterSiblingWithControl(Node); - if Result<>nil then exit; - Result:=FindSiblingWithControl(Node); - Node:=Root.FindByName(DockerName); - Result:=FindPageSiblingWithControl(Node); - if Result<>nil then exit; - Result:=FindOtherNodeWithControl(Root); - end; - -var - Config: TLazDockerConfig; - CurControl: TControl; - NearestControlNode: TLazDockConfigNode; -begin - Result:=nil; - CurDockControl:=nil; - Root:=nil; - - Config:=GetConfigWithDockerName(DockerName); - - DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'"']); - if Config<>nil then - Config.WriteDebugReport; - - if (Config=nil) or (Config.Root=nil) then begin - DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'" No control']); - exit; - end; - CurControl:=FindControlByDockerName(DockerName); - if not ControlIsVisible(CurControl) then begin - DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'" CurControl=',DbgSName(CurControl),' control not visible']); - exit; - end; - if (not ConfigIsCompatible(Config.Root,ExceptionOnError)) then begin - DebugLn(['TCustomLazDockingManager.CreateLayout DockerName="',DockerName,'" CurControl=',DbgSName(CurControl),' config is not compatible']); - exit; - end; - - // create a copy of the config - Root:=TLazDockConfigNode.Create(nil); - try - Root.Assign(Config.Root); - - // clean up by removing all invisible, unknown and empty nodes - RemoveEmptyNodes(Root); - - // check if all used controls are on the same dock form - if not AllControlsAreOnSameForm then begin - DebugLn(['TCustomLazDockingManager.CreateLayout Not all Controls are on the same Form. Using only one form...']); - // the used controls are distributed on different dock forms - // => choose one dock form and remove the nodes of the others - NearestControlNode:=FindNearestControlNode; - if NearestControlNode=nil then RaiseGDBException(''); - CurDockControl:=FindControlByDockerName(NearestControlNode.Name); - if CurDockControl=nil then RaiseGDBException(''); - CurDockControl:=CurDockControl.GetTopParent; - // remove nodes of other dock forms - RemoveEmptyNodes(Root); - //DebugLn(['TCustomLazDockingManager.CreateLayout After removing nodes of other dock forms:']); - end; - - DebugLn(['TCustomLazDockingManager.CreateLayout After removing unneeded nodes:']); - Root.WriteDebugReport; - - Result:=Root; - Root:=nil; - finally - Root.Free; - end; -end; - -function TCustomLazDockingManager.ConfigIsCompatible( - RootNode: TLazDockConfigNode; ExceptionOnError: boolean): boolean; - - function CheckNode(Node: TLazDockConfigNode): boolean; - - procedure Error(const Msg: string); - var - s: String; - begin - s:='Error: Node="'+Node.GetPath+'"'; - s:=s+' NodeType='+LDConfigNodeTypeNames[Node.TheType]; - s:=s+Msg; - DebugLn(s); - if ExceptionOnError then raise Exception.Create(s); - end; - - function CheckSideAnchored(a: TAnchorKind): boolean; - var - SiblingName: string; - Sibling: TLazDockConfigNode; - - procedure ErrorWrongSplitter; - begin - Error('invalid Node.Sides[a] Node="'+Node.Name+'"' - +' Node.Sides['+DbgS(a)+']="'+Node.Sides[a]+'"'); - end; - - begin - SiblingName:=Node.Sides[a]; - if SiblingName='' then begin - Error('Node.Sides[a]='''''); - exit(false); - end; - Sibling:=RootNode.FindByName(SiblingName,true); - if Sibling=nil then begin - Error('Node.Sides[a] not found'); - exit(false); - end; - if Sibling=Node.Parent then - exit(true); // anchored to parent: ok - if (a in [akLeft,akRight]) and (Sibling.TheType=ldcntSplitterLeftRight) - then - exit(true); // left/right side anchored to a left/right splitter: ok - if (a in [akTop,akBottom]) and (Sibling.TheType=ldcntSplitterUpDown) - then - exit(true); // top/bottom side anchored to a up/down splitter: ok - // otherwise: not ok - ErrorWrongSplitter; - Result:=false; - end; - - function CheckAllSidesAnchored: boolean; - var - a: TAnchorKind; - begin - for a:=Low(TAnchorKind) to High(TAnchorKind) do - if not CheckSideAnchored(a) then exit(false); - Result:=true; - end; - - function CheckSideNotAnchored(a: TAnchorKind): boolean; - begin - if Node.Sides[a]<>'' then begin - Error('Sides[a]<>'''''); - Result:=false; - end else - Result:=true; - end; - - function CheckNoSideAnchored: boolean; - var - a: TAnchorKind; - begin - for a:=Low(TAnchorKind) to High(TAnchorKind) do - if not CheckSideNotAnchored(a) then exit(false); - Result:=true; - end; - - function CheckHasChilds: boolean; - begin - if Node.ChildCount=0 then begin - Error('ChildCount=0'); - Result:=false; - end else - Result:=true; - end; - - function CheckHasNoChilds: boolean; - begin - if Node.ChildCount>0 then begin - Error('ChildCount>0'); - Result:=false; - end else - Result:=true; - end; - - function CheckHasParent: boolean; - begin - if Node.Parent=nil then begin - Error('Parent=nil'); - Result:=false; - end else - Result:=true; - end; - - function CheckUniqueCorner(Side1, Side2: TAnchorKind): boolean; - var - i: Integer; - Child: TLazDockConfigNode; - begin - Result:=true; - if Node.Parent=nil then exit; - if Node.Sides[Side1]='' then exit; - if Node.Sides[Side2]='' then exit; - for i:=0 to Node.Parent.ChildCount-1 do begin - Child:=Node.Parent.Children[i]; - if Child=Node then continue; - if (CompareText(Node.Sides[Side1],Child.Sides[Side1])=0) - and (CompareText(Node.Sides[Side2],Child.Sides[Side2])=0) then begin - Error('overlapping nodes'); - exit(false); - end; - end; - end; - - var - a: TAnchorKind; - i: Integer; - begin - Result:=false; - - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - if Node.Sides[a]<>'' then begin - if CompareText(Node.Sides[a],Node.Name)=0 then begin - Error('Node.Sides[a]=Node'); - exit; - end; - if RootNode.FindByName(Node.Sides[a],true)=nil then begin - Error('unknown Node.Sides[a]'); - exit; - end; - end; - end; - - case Node.TheType of - ldcntControl: - begin - // a control node contains a TControl - if not CheckAllSidesAnchored then exit; - end; - ldcntForm: - begin - // a dock form is a dummy control, used as top level container - if Node.Parent<>nil then begin - Error('Parent<>nil'); - exit; - end; - if not CheckHasChilds then exit; - if not CheckNoSideAnchored then exit; - end; - ldcntPages: - begin - // a pages node has only page nodes as children - if not CheckHasParent then exit; - if not CheckHasChilds then exit; - for i:=0 to Node.ChildCount-1 do - if Node.Children[i].TheType<>ldcntPage then begin - Error('Children[i].TheType<>ldcntPage'); - exit; - end; - if not CheckAllSidesAnchored then exit; - end; - ldcntPage: - begin - // a page is the child of a pages node, and a container - if not CheckHasParent then exit; - if not CheckHasChilds then exit; - if Node.Parent.TheType<>ldcntPages then begin - Error('Parent.TheType<>ldcntPages'); - exit; - end; - if not CheckNoSideAnchored then exit; - end; - ldcntSplitterLeftRight: - begin - // a vertical splitter can be moved left/right - if not CheckHasParent then exit; - if not CheckHasNoChilds then exit; - if not CheckSideNotAnchored(akLeft) then exit; - if not CheckSideNotAnchored(akRight) then exit; - if not CheckSideAnchored(akTop) then exit; - if not CheckSideAnchored(akBottom) then exit; - end; - ldcntSplitterUpDown: - begin - // a horizontal splitter can be moved up/down - // it is anchored left and right, and not top/bottom - // it is not a root node - // it has no children - if not CheckHasParent then exit; - if not CheckHasNoChilds then exit; - if not CheckSideNotAnchored(akTop) then exit; - if not CheckSideNotAnchored(akBottom) then exit; - if not CheckSideAnchored(akLeft) then exit; - if not CheckSideAnchored(akRight) then exit; - end; - else - Error('unknown type'); - exit; - end; - - if not CheckUniqueCorner(akLeft,akTop) then exit; - if not CheckUniqueCorner(akLeft,akBottom) then exit; - if not CheckUniqueCorner(akRight,akTop) then exit; - if not CheckUniqueCorner(akRight,akBottom) then exit; - - // check children - for i:=0 to Node.ChildCount-1 do - if not CheckNode(Node.Children[i]) then exit; - - Result:=true; - end; - -begin - if RootNode=nil then exit(false); - Result:=CheckNode(RootNode); -end; - -{ TLazDockConfigNode } - -function TLazDockConfigNode.GetSides(Side: TAnchorKind): string; -begin - Result:=FSides[Side]; -end; - -function TLazDockConfigNode.GetChildCount: Integer; -begin - if FChilds<>nil then - Result:=FChilds.Count - else - Result:=0; -end; - -function TLazDockConfigNode.GetChilds(Index: integer): TLazDockConfigNode; -begin - Result:=TLazDockConfigNode(FChilds[Index]); -end; - -procedure TLazDockConfigNode.SetBounds(const AValue: TRect); -begin - if CompareRect(@FBounds,@AValue) then exit; - FBounds:=AValue; -end; - -procedure TLazDockConfigNode.SetClientBounds(const AValue: TRect); -begin - if CompareRect(@FClientBounds,@AValue) then exit; - FClientBounds:=AValue; -end; - -procedure TLazDockConfigNode.SetName(const AValue: string); -begin - if FName=AValue then exit; - FName:=AValue; -end; - -procedure TLazDockConfigNode.SetParent(const AValue: TLazDockConfigNode); -begin - if FParent=AValue then exit; - if FParent<>nil then - FParent.DoRemove(Self); - FParent:=AValue; - if FParent<>nil then - FParent.DoAdd(Self); -end; - -procedure TLazDockConfigNode.SetSides(Side: TAnchorKind; - const AValue: string); -begin - FSides[Side]:=AValue; -end; - -procedure TLazDockConfigNode.SetTheType(const AValue: TLDConfigNodeType); -begin - if FTheType=AValue then exit; - FTheType:=AValue; -end; - -procedure TLazDockConfigNode.DoAdd(ChildNode: TLazDockConfigNode); -begin - if FChilds=nil then FChilds:=TFPList.Create; - FChilds.Add(ChildNode); -end; - -procedure TLazDockConfigNode.DoRemove(ChildNode: TLazDockConfigNode); -begin - if TObject(FChilds[FChilds.Count-1])=ChildNode then - FChilds.Delete(FChilds.Count-1) - else - FChilds.Remove(ChildNode); -end; - -constructor TLazDockConfigNode.Create(ParentNode: TLazDockConfigNode); -begin - FTheType:=ldcntControl; - Parent:=ParentNode; -end; - -constructor TLazDockConfigNode.Create(ParentNode: TLazDockConfigNode; - const AName: string); -begin - FName:=AName; - Create(ParentNode); -end; - -destructor TLazDockConfigNode.Destroy; -begin - Clear; - Parent:=nil; - FChilds.Free; - FChilds:=nil; - inherited Destroy; -end; - -procedure TLazDockConfigNode.Clear; -var - i: Integer; -begin - if FChilds=nil then exit; - for i:=ChildCount-1 downto 0 do Children[i].Free; - FChilds.Clear; -end; - -procedure TLazDockConfigNode.Assign(Source: TPersistent); -var - Src: TLazDockConfigNode; - i: Integer; - SrcChild: TLazDockConfigNode; - NewChild: TLazDockConfigNode; - a: TAnchorKind; -begin - if Source is TLazDockConfigNode then begin - Clear; - Src:=TLazDockConfigNode(Source); - FBounds:=Src.FBounds; - FClientBounds:=Src.FClientBounds; - FName:=Src.FName; - FWindowState:=Src.FWindowState; - for a:=Low(TAnchorKind) to High(TAnchorKind) do - FSides[a]:=Src.FSides[a]; - FTheType:=Src.FTheType; - for i:=0 to Src.ChildCount-1 do begin - SrcChild:=Src.Children[i]; - NewChild:=TLazDockConfigNode.Create(Self); - NewChild.Assign(SrcChild); - end; - end else - inherited Assign(Source); -end; - -function TLazDockConfigNode.FindByName(const AName: string; - Recursive: boolean; WithRoot: boolean): TLazDockConfigNode; -var - i: Integer; -begin - if WithRoot and (CompareText(Name,AName)=0) then exit(Self); - if FChilds<>nil then - for i:=0 to FChilds.Count-1 do begin - Result:=Children[i]; - if CompareText(Result.Name,AName)=0 then exit; - if Recursive then begin - Result:=Result.FindByName(AName,true,false); - if Result<>nil then exit; - end; - end; - Result:=nil; -end; - -function TLazDockConfigNode.IndexOf(const AName: string): Integer; -begin - if FChilds<>nil then begin - Result:=FChilds.Count-1; - while (Result>=0) and (CompareText(Children[Result].Name,AName)<>0) do - dec(Result); - end else begin - Result:=-1; - end; -end; - -function TLazDockConfigNode.GetScreenBounds: TRect; -var - NewWidth: Integer; - NewHeight: Integer; - NewLeft: LongInt; - NewTop: LongInt; - Node: TLazDockConfigNode; -begin - NewWidth:=FBounds.Right-FBounds.Left; - NewHeight:=FBounds.Bottom-FBounds.Top; - NewLeft:=FBounds.Left; - NewTop:=FBounds.Top; - Node:=Parent; - while Node<>nil do begin - inc(NewLeft,Node.FBounds.Left+Node.FClientBounds.Left); - inc(NewTop,Node.FBounds.Top+Node.FClientBounds.Top); - Node:=Node.Parent; - end; - Result:=Classes.Bounds(NewLeft,NewTop,NewWidth,NewHeight); -end; - -function TLazDockConfigNode.FindNeighbour(SiblingSide: TAnchorKind; - NilIfAmbiguous: boolean; IgnoreSplitters: boolean): TLazDockConfigNode; -var - i: Integer; - ParentNode: TLazDockConfigNode; - Child: TLazDockConfigNode; -begin - Result:=nil; - ParentNode:=Parent; - for i:=0 to ParentNode.ChildCount-1 do begin - Child:=ParentNode.Children[i]; - if Child=Self then continue; - if IgnoreSplitters - and (Child.TheType in [ldcntSplitterLeftRight,ldcntSplitterUpDown]) then - continue; - if CompareText(Child.Sides[SiblingSide],Name)=0 then begin - if Result=nil then - Result:=Child - else if NilIfAmbiguous then - exit(nil); - end; - end; -end; - -function TLazDockConfigNode.IsTheOnlyNeighbour(Node: TLazDockConfigNode; - SiblingSide: TAnchorKind): boolean; -{ check if one side is only used by Node. - For example: If only Node.Sides[SiblingSide]=Name - ---------+ - --+#+---+| - B |#| A || - --+#+---+| - ---------+} -begin - Result:=FindNeighbour(SiblingSide,true)<>nil; -end; - -procedure TLazDockConfigNode.SaveToConfig(Config: TConfigStorage; - const Path: string); -var - a: TAnchorKind; - i: Integer; - Child: TLazDockConfigNode; - SubPath: String; -begin - Config.SetDeleteValue(Path+'Name/Value',Name,''); - Config.SetDeleteValue(Path+'Type/Value',LDConfigNodeTypeNames[TheType], - LDConfigNodeTypeNames[ldcntControl]); - Config.SetDeleteValue(Path+'Bounds/',FBounds,Rect(0,0,0,0)); - Config.SetDeleteValue(Path+'ClientBounds/',FClientBounds, - Rect(0,0,FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top)); - Config.SetDeleteValue(Path+'WindowState/Value',WindowStateToStr(WindowState), - WindowStateToStr(wsNormal)); - - // Sides - for a:=Low(TAnchorKind) to High(TAnchorKind) do - Config.SetDeleteValue(Path+'Sides/'+DbgS(a)+'/Name',Sides[a],''); - - // children - Config.SetDeleteValue(Path+'Children/Count',ChildCount,0); - for i:=0 to ChildCount-1 do begin - Child:=Children[i]; - SubPath:=Path+'Child'+IntToStr(i+1)+'/'; - Child.SaveToConfig(Config,SubPath); - end; -end; - -procedure TLazDockConfigNode.LoadFromConfig(Config: TConfigStorage; - const Path: string); -var - a: TAnchorKind; - i: Integer; - NewChildCount: LongInt; - NewChildName: String; - NewChild: TLazDockConfigNode; - SubPath: String; -begin - Clear; - // Note: 'Name' is stored only for information, but not restored on load - TheType:=LDConfigNodeTypeNameToType(Config.GetValue(Path+'Type/Value', - LDConfigNodeTypeNames[ldcntControl])); - Config.GetValue(Path+'Bounds/',FBounds,Rect(0,0,0,0)); - Config.GetValue(Path+'ClientBounds/',FClientBounds, - Rect(0,0,FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top)); - WindowState:=StrToWindowState(config.GetValue(Path+'WindowState/Value','')); - - // Sides - for a:=Low(TAnchorKind) to High(TAnchorKind) do - Sides[a]:=Config.GetValue(Path+'Sides/'+DbgS(a)+'/Name',''); - - // children - NewChildCount:=Config.GetValue(Path+'Children/Count',0); - for i:=0 to NewChildCount-1 do begin - SubPath:=Path+'Child'+IntToStr(i+1)+'/'; - NewChildName:=Config.GetValue(SubPath+'Name/Value',''); - NewChild:=TLazDockConfigNode.Create(Self,NewChildName); - NewChild.Parent:=Self; - NewChild.LoadFromConfig(Config,SubPath); - end; -end; - -procedure TLazDockConfigNode.WriteDebugReport; - - procedure WriteNode(const Prefix: string; ANode: TLazDockConfigNode); - var - a: TAnchorKind; - i: Integer; - s: string; - begin - if ANode=nil then exit; - DbgOut(Prefix,'Name="'+ANode.Name+'"'); - DbgOut(' Type=',GetEnumName(TypeInfo(TLDConfigNodeType),ord(ANode.TheType))); - DbgOut(' Bounds='+dbgs(ANode.Bounds)); - DbgOut(' ClientBounds='+dbgs(ANode.ClientBounds)); - DbgOut(' Children='+dbgs(ANode.ChildCount)); - DbgOut(' WindowState='+WindowStateToStr(ANode.WindowState)); - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - s:=ANode.Sides[a]; - if s='' then - s:='?'; - DbgOut(' '+DbgS(a)+'="'+s+'"'); - end; - debugln; - for i:=0 to ANode.ChildCount-1 do begin - WriteNode(Prefix+' ',ANode[i]); - end; - end; - -begin - DebugLn('TLazDockConfigNode.WriteDebugReport Root=',dbgs(Self)); - WriteNode(' ',Self); - DebugLn(DebugLayoutAsString); - DumpStack; -end; - -function TLazDockConfigNode.DebugLayoutAsString: string; -type - TArrayOfRect = array of TRect; - 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;// TLazDockConfigNode 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: TLazDockConfigNode): 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.LeftNode.Parent 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: TLazDockConfigNode; - i: Integer; - begin - if MinPosCalculating then begin - DebugLn(['DebugLayoutAsString.GetMinPos.Compute WARNING: anchor circle detected']); - DumpStack; - exit(1); - end; - if (not MinPosValid) then begin - MinPosValid:=true; - MinPosCalculating:=true; - if Node.Sides[Side]<>'' then begin - Sibling:=FindByName(Node.Sides[Side],true,true); - Improve(Sibling); - end; - if Node.Parent<>nil then begin - for i:=0 to Node.Parent.ChildCount-1 do begin - Sibling:=Node.Parent.Children[i]; - if CompareText(Sibling.Sides[OppositeAnchor[Side]],Node.Name)=0 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: TLazDockConfigNode): TPoint; - // calculate the minimum size needed to draw the content of the node - var - i: Integer; - ChildMinSize: TPoint; - Child: TLazDockConfigNode; - ChildSize: TPoint; - begin - //DebugLn(['GetChildsMinSize ',Node.name]); - Result:=Point(0,0); - if Node.TheType=ldcntPages then begin - // maximum size of all pages - for i:=0 to Node.ChildCount-1 do begin - ChildMinSize:=GetMinSize(Node.Children[i]); - Result.X:=Max(Result.X,ChildMinSize.X); - Result.Y:=Max(Result.Y,ChildMinSize.Y); - end; - end else begin - for i:=0 to Node.ChildCount-1 do begin - Child:=Node.Children[i]; - ChildSize:=GetMinSize(Child); - Result.X:=Max(Result.X,GetMinPos(Child,akLeft)+ChildSize.X); - Result.Y:=Max(Result.Y,GetMinPos(Child,akTop)+ChildSize.Y); - end; - end; - end; - - function GetMinSize(Node: TLazDockConfigNode): 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(Node.Name);// border plus caption - Result.Y:=2; // border - if (Node.ChildCount=0) then begin - case Node.TheType of - ldcntSplitterLeftRight,ldcntSplitterUpDown: - Result:=Point(1,1); // splitters don't need captions - end; - end else begin - ChildMinSize:=GetChildsMinSize(Node); - Result.X:=Max(Result.X,ChildMinSize.X+2); - Result.Y:=Max(Result.Y,ChildMinSize.Y+2); - end; - Info^.MinSize:=Result; - Info^.MinSizeValid:=true; - Info^.MinSizeCalculating:=false; - end; - - procedure DrawNode(Node: TLazDockConfigNode; ARect: TRect); - var - i: Integer; - Child: TLazDockConfigNode; - ChildSize: TPoint; - ChildRect: TRect; - AnchorNode: TLazDockConfigNode; - begin - //DebugLn(['DrawNode Node=',Node.Name,' ARect=',dbgs(ARect)]); - wrectangle(ARect); - w(ARect.Left+1,ARect.Top,Node.Name,ARect.Right); - - for i := 0 to Node.ChildCount-1 do begin - Child:=Node.Children[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; - if Child.Sides[akRight]<>'' then begin - AnchorNode:=FindByName(Child.Sides[akRight]); - if AnchorNode=Node then - ChildRect.Right:=ARect.Right-1 - else if AnchorNode.Parent=Node then - ChildRect.Right:=ARect.Left+1+GetMinPos(AnchorNode,akLeft)-1; - end; - if Child.Sides[akBottom]<>'' then begin - AnchorNode:=FindByName(Child.Sides[akBottom]); - if AnchorNode=Node then - ChildRect.Bottom:=ARect.Bottom-1 - else if AnchorNode.Parent=Node then - ChildRect.Bottom:=ARect.Top+1+GetMinPos(AnchorNode,akTop)-1; - end; - DrawNode(Child,ChildRect); - if Node.TheType=ldcntPages 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(Self,Rect(1,1,Cols,Rows)); - finally - FreeNodeInfos; - end; -end; - -function TLazDockConfigNode.GetPath: string; -var - Node: TLazDockConfigNode; -begin - Result:=''; - Node:=Self; - while Node<>nil do begin - if Result<>'' then - Result:=Node.Name+'/'+Result - else - Result:=Node.Name; - Node:=Node.Parent; - end; -end; - -{ TLazDockerConfig } - -constructor TLazDockerConfig.Create(const ADockerName: string; - ANode: TLazDockConfigNode); -begin - FDockerName:=ADockerName; - FRoot:=ANode; -end; - -destructor TLazDockerConfig.Destroy; -begin - FRoot.Free; // who will clear it else? - inherited Destroy; -end; - -procedure TLazDockerConfig.WriteDebugReport; -begin - DebugLn(['TLazDockerConfig.WriteDebugReport DockerName="',DockerName,'"']); - if Root<>nil then begin - Root.WriteDebugReport; - end else begin - DebugLn([' Root=nil']); - end; -end; - -{ TAnchoredDockManager } - -procedure TAnchoredDockManager.DisableLayout(Control: TControl); -begin - FConfigs.DisableLayout(Control); - inherited DisableLayout(Control); -end; - -procedure TAnchoredDockManager.EnableLayout(Control: TControl); -begin - inherited EnableLayout(Control); - FConfigs.EnableLayout(Control); -end; - -end. diff --git a/lcl/ldockctrledit.lfm b/lcl/ldockctrledit.lfm deleted file mode 100644 index 972698a236..0000000000 --- a/lcl/ldockctrledit.lfm +++ /dev/null @@ -1,514 +0,0 @@ -object LazDockControlEditorDlg: TLazDockControlEditorDlg - Left = 292 - Height = 318 - Top = 196 - Width = 200 - HorzScrollBar.Page = 199 - VertScrollBar.Page = 317 - ActiveControl = UndockButton - AutoSize = True - Caption = 'LazDockControlEditorDlg' - ClientHeight = 318 - ClientWidth = 200 - Constraints.MinHeight = 200 - Constraints.MinWidth = 200 - OnCreate = FormCreate - LCLVersion = '0.9.25' - object UndockGroupBox: TGroupBox - Height = 51 - Width = 193 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - Caption = 'UndockGroupBox' - ChildSizing.LeftRightSpacing = 5 - ChildSizing.TopBottomSpacing = 5 - ClientHeight = 33 - ClientWidth = 189 - TabOrder = 0 - object UndockButton: TButton - Left = 5 - Height = 23 - Top = 5 - Width = 95 - AutoSize = True - Caption = 'UndockButton' - OnClick = UndockButtonClick - TabOrder = 0 - end - end - object DockGroupBox: TGroupBox - AnchorSideTop.Control = UndockGroupBox - AnchorSideTop.Side = asrBottom - Height = 167 - Top = 57 - Width = 193 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 6 - Caption = 'DockGroupBox' - ChildSizing.LeftRightSpacing = 5 - ChildSizing.TopBottomSpacing = 5 - ClientHeight = 149 - ClientWidth = 189 - TabOrder = 1 - object DockControlLabel: TLabel - AnchorSideTop.Control = DockControlComboBox - AnchorSideTop.Side = asrCenter - Left = 9 - Height = 14 - Top = 8 - Width = 84 - BorderSpacing.Around = 2 - Caption = 'DockControlLabel' - ParentColor = False - end - object DockLeftButton: TSpeedButton - AnchorSideLeft.Control = DockGroupBox - AnchorSideTop.Control = DockGroupBox - AnchorSideTop.Side = asrCenter - AnchorSideRight.Control = DockPageButton - AnchorSideBottom.Control = DockBottomButton - Left = 39 - Height = 30 - Top = 74 - Width = 30 - Anchors = [akRight, akBottom] - BorderSpacing.Right = 10 - BorderSpacing.Bottom = 10 - Caption = 'To Left' - Color = clBtnFace - NumGlyphs = 0 - OnClick = DockLeftButtonClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object DockRightButton: TSpeedButton - AnchorSideLeft.Control = DockPageButton - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = DockLeftButton - AnchorSideRight.Control = DockGroupBox - Left = 119 - Height = 30 - Top = 74 - Width = 30 - BorderSpacing.Left = 10 - Caption = 'To Right' - Color = clBtnFace - NumGlyphs = 0 - OnClick = DockRightButtonClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object DockTopButton: TSpeedButton - AnchorSideLeft.Control = DockGroupBox - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = DockLeftButton - AnchorSideTop.Side = asrBottom - AnchorSideBottom.Control = DockPageButton - Left = 79 - Height = 30 - Top = 34 - Width = 30 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 10 - Caption = 'To Top' - Color = clBtnFace - NumGlyphs = 0 - OnClick = DockTopButtonClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object DockBottomButton: TSpeedButton - AnchorSideLeft.Control = DockGroupBox - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = DockLeftButton - AnchorSideTop.Side = asrBottom - AnchorSideBottom.Control = DockGroupBox - AnchorSideBottom.Side = asrBottom - Left = 79 - Height = 30 - Top = 114 - Width = 30 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 5 - Caption = 'To Bottom' - Color = clBtnFace - NumGlyphs = 0 - OnClick = DockBottomButtonClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object DockPageButton: TSpeedButton - AnchorSideLeft.Control = DockGroupBox - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = DockLeftButton - Left = 79 - Height = 30 - Top = 74 - Width = 30 - Caption = 'As Page' - Color = clBtnFace - NumGlyphs = 0 - OnClick = DockPageButtonClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object DockControlComboBox: TComboBox - AnchorSideLeft.Control = DockControlLabel - AnchorSideLeft.Side = asrBottom - Left = 97 - Height = 21 - Top = 5 - Width = 71 - Anchors = [akTop, akLeft, akRight] - AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] - BorderSpacing.Left = 4 - ItemHeight = 13 - MaxLength = 0 - OnEditingDone = DockControlComboBoxEditingDone - TabOrder = 0 - Text = 'DockControlComboBox' - end - end - object CancelButton: TButton - AnchorSideTop.Control = EnlargeGroupBox - AnchorSideTop.Side = asrBottom - Left = 55 - Height = 23 - Top = 287 - Width = 90 - Anchors = [akTop] - AutoSize = True - BorderSpacing.Top = 10 - BorderSpacing.Bottom = 6 - Caption = 'CancelButton' - ModalResult = 2 - TabOrder = 2 - end - object EnlargeGroupBox: TGroupBox - AnchorSideTop.Control = DockGroupBox - AnchorSideTop.Side = asrBottom - Height = 53 - Top = 224 - Width = 193 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - Caption = 'EnlargeGroupBox' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.HorizontalSpacing = 6 - ChildSizing.VerticalSpacing = 6 - ChildSizing.Layout = cclTopToBottomThenLeftToRight - ClientHeight = 35 - ClientWidth = 189 - TabOrder = 3 - object EnlargeLeftSpeedButton: TSpeedButton - Left = 6 - Height = 23 - Top = 6 - Width = 23 - Color = clBtnFace - Glyph.Data = { - C6070000424DC607000000000000360000002800000016000000160000000100 - 2000000000009007000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000037337FF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000036733FF19844AFF04733BFF00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000056F - 37FF258C56FF77CEA5FF047339FF000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000004733BFF359D67FF77D6A7FF84D6 - ADFF04733BFF0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000004773DFF46AF7BFF73D7A7FF1EB76BFF84D6ADFF05773BFF0473 - 3BFF04733BFF04733BFF04733BFF04733BFF037339FF00000000000000000000 - 000000000000000000000000000000000000000000000000000008773DFF5AC6 - 8FFF6BD79FFF17BF6BFF0CB55EFF84D7ADFF7FCFA5FF7FCEA7FF7FCEA7FF7FCE - A7FF7FCEA7FF7BCFA5FF047339FF000000000000000000000000000000000000 - 00000000000000000000000000000E7B43FF67CF97FF5FD697FF12BD67FF0DB5 - 63FF0BAF5BFF09A756FF079F53FF069E4EFF069E4EFF069E4EFF099F52FF7BCF - A5FF047339FF0000000000000000000000000000000000000000000000000477 - 3BFF14864BFF73CF9EFF4ECF8CFF0FBF63FF0EB763FF0CB55FFF0AAF5BFF08A5 - 56FF069D52FF069E4EFF069E4EFF069E4EFF099F52FF7BCFA5FF047339FF0000 - 00000000000000000000000000000000000003773DFF218C57FF7BD7A5FF4ECE - 8DFF2BBF73FF31BF77FF29BF73FF1FB767FF13AF5FFF07A552FF069E4EFF069E - 4EFF069E4EFF069E4EFF0C9C52FF87CEA7FF04773BFF00000000000000000000 - 0000000000000000000003773DFF278E5AFF85D6AFFF5ECE95FF39BF7BFF3DBF - 7FFF43BF7FFF46BD7FFF47BD7FFF43B57BFF39AF73FF2FAF6BFF31AF6FFF37AF - 73FF42B77BFF9CD7B7FF04773BFF000000000000000000000000000000000000 - 00000000000004773BFF17864AFF86CEA7FF77CF9FFF46BD7FFF4ABD85FF4BBF - 86FF4FBD86FF4FB786FF53BD87FF53BD87FF4FB786FF4FB784FF4EB784FF9DD6 - BDFF04773BFF0000000000000000000000000000000000000000000000000000 - 0000000000000D7B43FF7BC79DFF8CD7AFFF52BD87FF53BF85FF57BF87FF5BBD - 8DFF5ABD8EFF5ABD8EFF5BBD8DFF57BF87FF57BD86FFA5DEBDFF04773BFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000006773BFF6BBD8FFF9CD7B7FF63BF94FF63BF8FFFAFDFC7FFAFDEC7FFAFDE - C7FFAFDFC7FFADDFC6FFAFDEC6FFA5DEBFFF04773BFF00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000377 - 3BFF56AF7FFFA5DEBFFF7BCE9FFFAFDEC6FF05773DFF04733BFF04733BFF0473 - 3BFF04733BFF04733BFF03773BFF000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000004773BFF3F9F - 6FFFADDFC6FFB7E7CFFF04733BFF000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000003773BFF298C5AFFA7D7 - BDFF04733BFF0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000157F4AFF04733BFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000004773BFF00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000 - } - NumGlyphs = 0 - OnClick = EnlargeLeftSpeedButtonClick - ShowHint = True - ParentShowHint = False - end - object EnlargeRightSpeedButton: TSpeedButton - Left = 35 - Height = 23 - Top = 6 - Width = 23 - Color = clBtnFace - Glyph.Data = { - C6070000424DC607000000000000360000002800000016000000160000000100 - 2000000000009007000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000037339FF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000004733BFF19854BFF036733FF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000473 - 3BFF77C69CFF298E5AFF036F35FF000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000047339FF7FCEA7FF77CF - A5FF399D6BFF047339FF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000003773BFF04733BFF0473 - 3BFF04733BFF04733BFF04733BFF04773BFF7FCEA7FF1EB567FF73D79FFF4BB5 - 7BFF04773BFF0000000000000000000000000000000000000000000000000000 - 000000000000000000000000000004733BFF77C69DFF7FCEA7FF7FCEA7FF7FCE - A7FF7FCEA7FF7FCEA7FF7FCFA5FF0DAD5BFF14B763FF67D69FFF5BC68FFF0977 - 3FFF000000000000000000000000000000000000000000000000000000000000 - 00000000000004773BFF77C69DFF0D9D53FF069E4EFF069E4EFF069E4EFF069E - 4EFF079F53FF09A756FF0BAF5BFF0FB563FF5AD694FF6BCF9DFF0F7B43FF0000 - 0000000000000000000000000000000000000000000000000000000000000477 - 3BFF77C69DFF0D9D53FF069E4EFF069E4EFF069E4EFF069E4EFF069C4FFF08A5 - 56FF0AAF5BFF0CB55FFF0EB763FF4ACF8DFF73D6A5FF17874EFF03773BFF0000 - 0000000000000000000000000000000000000000000004773BFF7FCFA7FF109E - 57FF069E4EFF069E4EFF069E4EFF069E4EFF069E4EFF11A55BFF1EAF67FF2BB7 - 6FFF33BD77FF2DBF77FF4FCE8DFF7FD7A7FF238F5AFF03773DFF000000000000 - 000000000000000000000000000004773BFF96D7B5FF43B77BFF35AD73FF2FAF - 6BFF2FAF6BFF37AF73FF46B77BFF47B57BFF47BD7FFF43BD7FFF43BF7FFF3DBF - 7FFF5ECE97FF8DD6AFFF2B955FFF03773DFF0000000000000000000000000000 - 00000000000004733BFF97D6B5FF4BB77FFF4AB57FFF4FB784FF4FB786FF53BD - 87FF53BD87FF4FB786FF4FBD86FF4BBF86FF4ABD85FF77CFA5FF87D7AFFF1B85 - 4FFF04773BFF0000000000000000000000000000000000000000000000000477 - 3BFF9ED7B7FF53BD84FF53BD84FF57BF87FF5BBD8DFF5ABD8EFF5ABD8EFF5BBD - 8DFF57BF87FF57BF87FF8CD7AFFF7FCEA5FF0F7F46FF00000000000000000000 - 0000000000000000000000000000000000000000000004733BFF9DD7BDFFA7DF - C6FFAFDEC6FFADDFC6FFAFDFC7FFAFDEC7FFAFDEC7FF6BC797FF67C797FF9ED6 - B7FF6FBF97FF07773DFF00000000000000000000000000000000000000000000 - 000000000000000000000000000003773BFF04733BFF04733BFF04733BFF0473 - 3BFF04733BFF04773DFFADDFC6FF7FCEA7FFA7DFC6FF5BAF86FF03773BFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000477 - 3BFFB7DFCEFFAFDEC7FF469E73FF04773BFF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000004773BFFA5DEBFFF2D8F - 5FFF03773BFF0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000004773BFF157F4AFF00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000004773BFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000 - } - NumGlyphs = 0 - OnClick = EnlargeRightSpeedButtonClick - ShowHint = True - ParentShowHint = False - end - object EnlargeTopSpeedButton: TSpeedButton - Left = 64 - Height = 23 - Top = 6 - Width = 23 - Color = clBtnFace - Glyph.Data = { - C6070000424DC607000000000000360000002800000016000000160000000100 - 2000000000009007000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000004733BFF04733BFF04733BFF04733BFF04733BFF04733BFF04733BFF0473 - 3BFF04733BFF04733BFF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000004733BFF86DE - ADFF86DEAFFF87DEAFFF87DEB5FF84DFB5FF87DEB5FF87DEAFFF86DEAFFF0877 - 3DFF000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000004733BFF86DFADFF0FBD67FF11C6 - 6BFF12C76BFF13CF6FFF12C76BFF11C66BFF84DEADFF08773DFF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000004733BFF86DEADFF10BF67FF12C76BFF14CF6FFF15D7 - 73FF14CF6FFF12C76BFF84DFAFFF08773DFF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000004733BFF86DEADFF10BD67FF11C76BFF13CE6FFF13CE6FFF13CE6FFF11C7 - 6BFF84DEADFF08773DFF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000004733BFF8DDE - B5FF0EBD63FF10BD67FF11C767FF11C66BFF11C767FF10BD67FF7FDEADFF0877 - 3DFF000000000000000000000000000000000000000000000000000000000000 - 000004773BFF05773BFF05773BFF05773BFF057B3DFF96DEBDFF19B767FF0EB7 - 63FF0EBD63FF0FBF63FF0EBD63FF0EB763FF7FD7AFFF0C7F42FF05773BFF0477 - 39FF04733BFF04773BFF00000000000000000000000000000000000000001885 - 4AFF94D6AFFF9DDFBFFF9FDEBFFF9DDFBDFF33BF77FF1CB567FF0EB75EFF0CB7 - 5EFF0CB55FFF0CAF5EFF7BD6A5FF7FD6A7FF84D6A7FF77C79CFF167F4BFF0000 - 00000000000000000000000000000000000000000000000000002B8E5AFF9CD6 - BDFF5EC68EFF47BD7FFF39B777FF2FB573FF23B76BFF12AD5FFF0BAD5BFF0AAD - 57FF09A557FF1DAF63FF77CE9DFF218D53FF04773BFF00000000000000000000 - 00000000000000000000000000000000000003773DFF439D6FFF9FD7BDFF53BD - 84FF3DB777FF33B573FF27AD6BFF1BAD63FF0FA55AFF07A552FF13A75AFF6FC7 - 9EFF2F9663FF04773BFF00000000000000000000000000000000000000000000 - 000000000000000000000000000004773BFF5FAF84FF96D7B5FF47B57BFF37AD - 73FF29AD67FF1CA75EFF109E57FF0B9C53FF67C797FF3FA76FFF04773BFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000003773BFF77BD97FF85CEA7FF3BAF73FF2DAD6BFF1FA5 - 63FF139F57FF5ABD8EFF4EAF7FFF04773BFF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000B7B42FF86C7A7FF6FC796FF2FAF6BFF21A563FF57BF86FF5EBD - 8DFF06773DFF0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000157F47FF8ECEAFFF53BD87FF53BD86FF6FC797FF0A7B43FF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000002386 - 56FF8ECEAFFF7FCEA5FF16864AFF000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000339663FF258F - 5AFF03773BFF0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000003773DFF04773BFF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000 - } - NumGlyphs = 0 - OnClick = EnlargeTopSpeedButtonClick - ShowHint = True - ParentShowHint = False - end - object EnlargeBottomSpeedButton: TSpeedButton - Left = 93 - Height = 23 - Top = 6 - Width = 23 - Color = clBtnFace - Glyph.Data = { - C6070000424DC607000000000000360000002800000016000000160000000100 - 2000000000009007000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000036F37FF037339FF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00001C8C53FF2D9663FF03773DFF000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000127F46FF73D7A7FF7BD7 - ADFF1E8E52FF0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000B7B43FF6BCE9EFF46CE8CFF3BCE86FF77D7A7FF127F - 46FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000577 - 3DFF5EC78EFF57CF95FF11C76BFF12C76BFF4EDE96FF6BD69EFF097B3FFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000005773DFF5AB787FF63CF97FF11BD - 67FF11C66BFF13CE6FFF14CE73FF63DF9DFF5AC78FFF05773DFF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000004773BFF52AD7FFF8DDEB5FF1BB767FF0FBD63FF10BF67FF12C6 - 6BFF12C76BFF16C76FFF6FDEA7FF47B57BFF05773DFF00000000000000000000 - 000000000000000000000000000000000000000000000000000003773DFF429F - 6FFF9DDFBDFF53C78DFF3BBF7BFF13B763FF0FBD63FF10BD67FF10BF67FF10BF - 67FF1ABF6BFF77D6A5FF319C67FF04773BFF0000000000000000000000000000 - 000000000000000000000000000000000000319563FFA5DEBFFF63C795FF4EBD - 87FF47BF85FF3BBF7BFF1FBD6BFF0EB563FF0EB763FF0EB763FF11B763FF27BF - 6FFF7BD7A5FF1F8E52FF04773BFF000000000000000000000000000000000000 - 0000000000001F8552FFA5DEBDFFAFDFC6FFA7DFC7FFA5DEBFFF4ABD84FF42BF - 7FFF39BF7BFF29BD6FFF0FB55FFF0BAF5BFF85D7AFFF7FD6A7FF7FD6A7FF73C7 - 9EFF117F46FF000000000000000000000000000000000000000004773BFF0473 - 3BFF04733BFF04733BFF05773DFFA5DEBFFF4BBD7FFF43B77BFF37B577FF31B5 - 73FF21B567FF0BA757FF84D6A7FF05773DFF04773BFF04773BFF04773BFF0477 - 3BFF000000000000000000000000000000000000000000000000000000000000 - 000004733BFFA7DFC6FF4BB77FFF42B77BFF39B573FF31AF6FFF27AF67FF16A5 - 5BFF7FCFA5FF04733BFF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000004733BFFA7DF - C6FF4EB784FF46B77BFF3BAF73FF31AF6FFF27A767FF1BA75FFF7FCFA7FF0473 - 3BFF000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000004733BFFA7DEC6FF4FB785FF46B7 - 7BFF3BAF73FF31AF6FFF27A767FF1CA75EFF84CEA5FF04733BFF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000004733BFFA7DEC6FF4FB785FF46B77BFF3BAF73FF31AF - 6FFF27A767FF1CA75EFF85CEA5FF04733BFF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000004733BFFA7DFC6FFA7DFBDFF9DDEBDFF9CD6B7FF97D6B7FF8ED6AFFF8DCF - AFFF86CEA7FF04733BFF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000004773BFF0473 - 3BFF04733BFF04733BFF04733BFF04733BFF04733BFF04733BFF04733BFF0477 - 3BFF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000 - } - NumGlyphs = 0 - OnClick = EnlargeBottomSpeedButtonClick - ShowHint = True - ParentShowHint = False - end - end -end diff --git a/lcl/ldockctrledit.pas b/lcl/ldockctrledit.pas deleted file mode 100644 index 5c3ce5b918..0000000000 --- a/lcl/ldockctrledit.pas +++ /dev/null @@ -1,230 +0,0 @@ -{ $Id: ldocktree.pas 8153 2005-11-14 21:53:06Z mattias $ } -{ - /*************************************************************************** - LDockCtrlEdit.pas - ----------------- - - ***************************************************************************/ - - ***************************************************************************** - * * - * This file is part of the Lazarus Component Library (LCL) * - * * - * See the file COPYING.modifiedLGPL.txt, included in this distribution, * - * for details about the copyright. * - * * - * 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. * - * * - ***************************************************************************** - - Author: Mattias Gaertner - - Abstract: - This unit contains a dialog to dock or undock a control to another. -} -unit LDockCtrlEdit; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, - StdCtrls; - -type - TLazDockControlEditorDlgResult = ( - ldcedrNone, - ldcedrUndock, - ldcedrDockLeft, - ldcedrDockRight, - ldcedrDockTop, - ldcedrDockBottom, - ldcedrDockPage, - ldcedrEnlargeLeft, - ldcedrEnlargeTop, - ldcedrEnlargeRight, - ldcedrEnlargeBottom - ); - - { TLazDockControlEditorDlg } - - TLazDockControlEditorDlg = class(TForm) - CancelButton: TButton; - DockControlComboBox: TComboBox; - DockPageButton: TSpeedButton; - DockBottomButton: TSpeedButton; - DockTopButton: TSpeedButton; - DockRightButton: TSpeedButton; - DockLeftButton: TSpeedButton; - DockGroupBox: TGroupBox; - DockControlLabel: TLabel; - EnlargeGroupBox: TGroupBox; - EnlargeLeftSpeedButton: TSpeedButton; - EnlargeRightSpeedButton: TSpeedButton; - EnlargeTopSpeedButton: TSpeedButton; - EnlargeBottomSpeedButton: TSpeedButton; - UndockButton: TButton; - UndockGroupBox: TGroupBox; - procedure DockBottomButtonClick(Sender: TObject); - procedure DockControlComboBoxEditingDone(Sender: TObject); - procedure DockLeftButtonClick(Sender: TObject); - procedure DockPageButtonClick(Sender: TObject); - procedure DockRightButtonClick(Sender: TObject); - procedure DockTopButtonClick(Sender: TObject); - procedure EnlargeBottomSpeedButtonClick(Sender: TObject); - procedure EnlargeLeftSpeedButtonClick(Sender: TObject); - procedure EnlargeRightSpeedButtonClick(Sender: TObject); - procedure EnlargeTopSpeedButtonClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure UndockButtonClick(Sender: TObject); - private - FCurrentControlName: string; - FDlgResult: TLazDockControlEditorDlgResult; - procedure CheckSetDlgResult(NewDlgResult: TLazDockControlEditorDlgResult); - procedure SetCurrentControlName(const AValue: string); - procedure UpdateButtonEnabled; - public - property DlgResult: TLazDockControlEditorDlgResult read FDlgResult write FDlgResult; - property CurrentControlName: string read FCurrentControlName write SetCurrentControlName; - end; - -implementation - -{$ifndef ver2_2} -{$R *.lfm} -{$ENDIF} - -{ TLazDockControlEditorDlg } - -procedure TLazDockControlEditorDlg.FormCreate(Sender: TObject); -begin - Caption := 'Docking'; - - UndockGroupBox.Caption := 'Undock'; - UndockButton.Caption := 'Undock (make it a single, normal window)'; - - DockPageButton.Hint := 'Dock as page'; - DockBottomButton.Hint := 'Dock to bottom'; - DockTopButton.Hint := 'Dock to top'; - DockRightButton.Hint := 'Dock to right'; - DockLeftButton.Hint := 'Dock to left'; - - DockPageButton.LoadGlyphFromLazarusResource('lcl_dock_to_page'); - DockBottomButton.LoadGlyphFromLazarusResource('lcl_dock_to_bottom'); - DockTopButton.LoadGlyphFromLazarusResource('lcl_dock_to_top'); - DockRightButton.LoadGlyphFromLazarusResource('lcl_dock_to_right'); - DockLeftButton.LoadGlyphFromLazarusResource('lcl_dock_to_left'); - - DockGroupBox.Caption := 'Dock to control'; - DockControlLabel.Caption := 'To control'; - - EnlargeGroupBox.Caption := 'Enlarge one side'; - EnlargeLeftSpeedButton.Hint := 'Left'; - EnlargeTopSpeedButton.Hint := 'Top'; - EnlargeRightSpeedButton.Hint := 'Right'; - EnlargeBottomSpeedButton.Hint := 'Bottom'; - - CancelButton.Caption := 'Cancel'; - - UpdateButtonEnabled; -end; - -procedure TLazDockControlEditorDlg.DockLeftButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrDockLeft); -end; - -procedure TLazDockControlEditorDlg.DockPageButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrDockPage); -end; - -procedure TLazDockControlEditorDlg.DockBottomButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrDockBottom); -end; - -procedure TLazDockControlEditorDlg.DockControlComboBoxEditingDone( - Sender: TObject); -begin - UpdateButtonEnabled; -end; - -procedure TLazDockControlEditorDlg.DockRightButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrDockRight); -end; - -procedure TLazDockControlEditorDlg.DockTopButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrDockTop); -end; - -procedure TLazDockControlEditorDlg.EnlargeBottomSpeedButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrEnlargeBottom); -end; - -procedure TLazDockControlEditorDlg.EnlargeLeftSpeedButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrEnlargeLeft); -end; - -procedure TLazDockControlEditorDlg.EnlargeRightSpeedButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrEnlargeRight); -end; - -procedure TLazDockControlEditorDlg.EnlargeTopSpeedButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrEnlargeTop); -end; - -procedure TLazDockControlEditorDlg.UndockButtonClick(Sender: TObject); -begin - CheckSetDlgResult(ldcedrUndock); -end; - -procedure TLazDockControlEditorDlg.CheckSetDlgResult( - NewDlgResult: TLazDockControlEditorDlgResult); -begin - if NewDlgResult in [ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop, - ldcedrDockBottom,ldcedrDockPage] then - begin - if DockControlComboBox.Items.IndexOf(DockControlComboBox.Text)<0 then - begin - MessageDlg('Incomplete','Please select first a control,' - +' to which '+CurrentControlName+' should be docked.',mtError, - [mbCancel],0); - exit; - end; - end; - DlgResult:=NewDlgResult; - ModalResult:=mrOk; -end; - -procedure TLazDockControlEditorDlg.SetCurrentControlName(const AValue: string); -begin - if FCurrentControlName=AValue then exit; - FCurrentControlName:=AValue; -end; - -procedure TLazDockControlEditorDlg.UpdateButtonEnabled; -var - SelectionValid: Boolean; -begin - SelectionValid:=DockControlComboBox.Items.IndexOf(DockControlComboBox.Text)>=0; - DockPageButton.Enabled:=SelectionValid; - DockBottomButton.Enabled:=SelectionValid; - DockTopButton.Enabled:=SelectionValid; - DockRightButton.Enabled:=SelectionValid; - DockLeftButton.Enabled:=SelectionValid; -end; - -initialization - {$I lcl_dock_to_images.lrs} - -end. diff --git a/lcl/ldocktree.pas b/lcl/ldocktree.pas deleted file mode 100644 index ed543348a8..0000000000 --- a/lcl/ldocktree.pas +++ /dev/null @@ -1,3339 +0,0 @@ -{ - /*************************************************************************** - LDockTree.pas - ----------------- - - ***************************************************************************/ - - ***************************************************************************** - * * - * This file is part of the Lazarus Component Library (LCL) * - * * - * See the file COPYING.modifiedLGPL.txt, included in this distribution, * - * for details about the copyright. * - * * - * 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. * - * * - ***************************************************************************** - - Author: Mattias Gaertner - - Abstract: - This unit contains TLazDockTree, the default TDockTree for the LCL. -} -unit LDockTree; - -{$mode objfpc}{$H+} - -interface - -uses - Math, Types, Classes, SysUtils, LCLProc, LCLType, LCLStrConsts, - Graphics, Controls, ExtCtrls, Forms, Menus, Themes, LCLIntf, - ComCtrls, LMessages, LResources, typinfo; - -type - TLazDockPages = class; - TLazDockPage = class; - TLazDockSplitter = class; - - - { TLazDockZone } - - TLazDockZone = class(TDockZone) - private - FPage: TLazDockPage; - FPages: TLazDockPages; - FSplitter: TLazDockSplitter; - public - destructor Destroy; override; - procedure FreeSubComponents; - function GetCaption: string; - function GetParentControl: TWinControl; - property Splitter: TLazDockSplitter read FSplitter write FSplitter; - property Pages: TLazDockPages read FPages write FPages; - property Page: TLazDockPage read FPage write FPage; - end; - - TDockHeaderMouseState = record - Rect: TRect; - IsMouseDown: Boolean; - end; - - TDockHeaderImageKind = - ( - dhiRestore, - dhiClose - ); - - TDockHeaderImages = array[TDockHeaderImageKind] of TCustomBitmap; - - { TLazDockTree } - - TLazDockTree = class(TDockTree) - private - FAutoFreeDockSite: boolean; - FMouseState: TDockHeaderMouseState; - FDockHeaderImages: TDockHeaderImages; - protected - procedure AnchorDockLayout(Zone: TLazDockZone); - procedure CreateDockLayoutHelperControls(Zone: TLazDockZone); - procedure ResetSizes(Zone: TLazDockZone); - procedure BreakAnchors(Zone: TDockZone); - procedure PaintDockFrame(ACanvas: TCanvas; AControl: TControl; - const ARect: TRect); override; - procedure UndockControlForDocking(AControl: TControl); - function DefaultDockGrabberSize: Integer; - public - constructor Create(TheDockSite: TWinControl); override; - destructor Destroy; override; - procedure AdjustDockRect(AControl: TControl; var ARect: TRect); override; - procedure InsertControl(AControl: TControl; InsertAt: TAlign; - DropControl: TControl); override; - procedure RemoveControl(AControl: TControl); override; - procedure BuildDockLayout(Zone: TLazDockZone); - procedure FindBorderControls(Zone: TLazDockZone; Side: TAnchorKind; - var List: TFPList); - function FindBorderControl(Zone: TLazDockZone; Side: TAnchorKind): TControl; - function GetAnchorControl(Zone: TLazDockZone; Side: TAnchorKind; - OutSide: boolean): TControl; - procedure PaintSite(DC: HDC); override; - procedure MessageHandler(Sender: TControl; var Message: TLMessage); override; - procedure DumpLayout(FileName: String); override; - public - property AutoFreeDockSite: boolean read FAutoFreeDockSite write FAutoFreeDockSite; - end; - - TLazDockHeaderPart = - ( - ldhpAll, // total header rect - ldhpCaption, // header caption - ldhpRestoreButton, // header restore button - ldhpCloseButton // header close button - ); - - { TLazDockForm - The default DockSite for a TLazDockTree and for TCustomAnchoredDockManager. - - Note: There are two docking managers: - TLazDockTree uses TLazDockZone to allow docking in rows and columns. - TCustomAnchoredDockManager does not use TLazDockZone and allows arbitrary - layouts. - } - - TLazDockForm = class(TCustomForm) - private - FMainControl: TControl; - FMouseState: TDockHeaderMouseState; - FDockHeaderImages: TDockHeaderImages; - procedure SetMainControl(const AValue: TControl); - protected - procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure UpdateMainControl; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; - procedure MouseLeave; override; - procedure PaintWindow(DC: HDC); override; - procedure TrackMouse(X, Y: Integer); - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function CloseQuery: boolean; override; - procedure UpdateCaption; virtual; - class procedure UpdateMainControlInParents(StartControl: TControl); - function FindMainControlCandidate: TControl; - function FindHeader(x, y: integer; out Part: TLazDockHeaderPart): TControl; - procedure InsertControl(AControl: TControl; Index: integer); override; - function IsDockedControl(Control: TControl): boolean; - function ControlHasTitle(Control: TControl): boolean; - function GetTitleRect(Control: TControl): TRect; - function GetTitleOrientation(Control: TControl): TDockOrientation; - property MainControl: TControl read FMainControl write SetMainControl;// used for the default caption - end; - - - { TLazDockPage - Pretty the same as a TLazDockForm but as page of a TLazDockPages } - - TLazDockPage = class(TCustomPage) - private - FDockZone: TDockZone; - function GetPageControl: TLazDockPages; - public - procedure InsertControl(AControl: TControl; Index: integer); override; - property DockZone: TDockZone read FDockZone; - property PageControl: TLazDockPages read GetPageControl; - end; - - - { TLazDockPages } - - TLazDockPages = class(TCustomTabControl) - private - function GetActiveNotebookPageComponent: TLazDockPage; - function GetNoteBookPage(Index: Integer): TLazDockPage; - procedure SetActiveNotebookPageComponent(const AValue: TLazDockPage); - protected - function GetFloatingDockSiteClass: TWinControlClass; override; - procedure Change; override; - public - constructor Create(TheOwner: TComponent); override; - property Page[Index: Integer]: TLazDockPage read GetNoteBookPage; - property ActivePageComponent: TLazDockPage read GetActiveNotebookPageComponent - write SetActiveNotebookPageComponent; - property Pages; - end; - - - { TLazDockSplitter } - - TLazDockSplitter = class(TCustomSplitter) - public - constructor Create(AOwner: TComponent); override; - end; - - - TCustomAnchoredDockManager = class; - - { TLazDockOwnerComponent - A TComponent owning all automatically created controls of a - TCustomAnchoredDockManager, like TLazDockForm } - - TLazDockOwnerComponent = class(TComponent) - public - Manager: TCustomAnchoredDockManager; - end; - - //---------------------------------------------------------------------------- - - { TCustomAnchoredDockManager - This class implements an LCL TDockManager via anchoring. - It implements the docking, undocking, enlarging, shrinking. - - The TCustomLazDockingManager component in LDockCtrl uses this - docking manager and extends it by layouts that can be stored/restored. } - - TCustomAnchoredDockManager = class(TDockManager) - private - FSplitterSize: integer; - FTitleHeight: integer; - FTitleWidth: integer; - FUpdateCount: integer; - protected - FOwnerComponent: TLazDockOwnerComponent; - procedure DeleteSideSplitter(Splitter: TLazDockSplitter; Side: TAnchorKind; - NewAnchorControl: TControl); - procedure CombineSpiralSplitterPair(Splitter1, Splitter2: TLazDockSplitter); - procedure DeletePage(Page: TLazDockPage); - procedure DeletePages(Pages: TLazDockPages); - procedure DeleteDockForm(ADockForm: TLazDockForm); - function GetAnchorDepth(AControl: TControl; Side: TAnchorKind): Integer; - function GetPreferredTitlePosition(AWidth, AHeight: integer): TAnchorKind; - public - constructor Create(ADockSite: TWinControl); override; - destructor Destroy; override; - procedure BeginUpdate; override; - procedure EndUpdate; override; - procedure GetControlBounds(Control: TControl; - out AControlBounds: TRect); override; - procedure DisableLayout(Control: TControl); virtual; - procedure EnableLayout(Control: TControl); virtual; - procedure DockControl(Control: TControl; InsertAt: TAlign; - DropCtl: TControl); - procedure UndockControl(Control: TControl; Float: boolean); - procedure InsertControl(Control: TControl; InsertAt: TAlign; - DropCtl: TControl); override; - function EnlargeControl(Control: TControl; Side: TAnchorKind; - Simulate: boolean = false): boolean; - procedure RemoveControl(Control: TControl); override; - procedure ReplaceAnchoredControl(OldControl, NewControl: TControl); - function GetSplitterWidth(Splitter: TControl): integer; - function GetSplitterHeight(Splitter: TControl): integer; - property SplitterSize: integer read FSplitterSize write FSplitterSize default 5; - property TitleWidth: integer read FTitleWidth write FTitleWidth default 20; - property TitleHeight: integer read FTitleHeight write FTitleHeight default 20; - procedure UpdateTitlePosition(Control: TControl); - - procedure PaintSite(DC: HDC); override; - procedure MessageHandler(Sender: TControl; var Message: TLMessage); override;// not implemented - procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign; - var DockRect: TRect); override;// not implemented - procedure ResetBounds(Force: Boolean); override;// not implemented - procedure SetReplacingControl(Control: TControl); override;// not implemented - procedure LoadFromStream(Stream: TStream); override;// not implemented - procedure SaveToStream(Stream: TStream); override;// not implemented - function AutoFreeByControl: Boolean; override; - - // ToDo: move this to protected, after dockig code from LDockCtrl was moved - // here. - function CreateForm: TLazDockForm; - end; - - -const - DockAlignOrientations: array[TAlign] of TDockOrientation = - ( - { alNone } doPages, - { alTop } doHorizontal, - { alBottom } doHorizontal, - { alLeft } doVertical, - { alRight } doVertical, - { alClient } doPages, - { alCustom } doPages - ); - -type - TAnchorControlsRect = array[TAnchorKind] of TControl; - -function GetLazDockSplitter(Control: TControl; Side: TAnchorKind; - out Splitter: TLazDockSplitter): boolean; -function GetLazDockSplitterOrParent(Control: TControl; Side: TAnchorKind; - out AnchorControl: TControl): boolean; -function CountAnchoredControls(Control: TControl; Side: TAnchorKind - ): Integer; -function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl; - Side: TAnchorKind): boolean; -function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind; - DestControl: TControl): boolean; -procedure GetAnchorControlsRect(Control: TControl; - out ARect: TAnchorControlsRect); -function GetEnclosingControlRect(ControlList: TFPlist; - out ARect: TAnchorControlsRect): boolean; -function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList; - - -implementation - -const - DockHeaderImageNames: array[TDockHeaderImageKind] of String = - ( -{ dhiRestore } 'lcl_dock_restore', -{ dhiClose } 'lcl_dock_close' - ); - -type - - { TDockHeader } - - // maybe once it will be control, so now better to move all related to header things to class - TDockHeader = class - class procedure CreateDockHeaderImages(out Images: TDockHeaderImages); - class procedure DestroyDockHeaderImages(var Images: TDockHeaderImages); - - class function GetRectOfPart(AHeaderRect: TRect; AOrientation: TDockOrientation; APart: TLazDockHeaderPart): TRect; - class function FindPart(AHeaderRect: TRect; APoint: TPoint; AOrientation: TDockOrientation): TLazDockHeaderPart; - class procedure Draw(ACanvas: TCanvas; ACaption: String; DockBtnImages: TDockHeaderImages; AOrientation: TDockOrientation; const ARect: TRect; const MousePos: TPoint); - class procedure PerformMouseUp(AControl: TControl; APart: TLazDockHeaderPart); - class procedure PerformMouseDown(AControl: TControl; APart: TLazDockHeaderPart); - end; - -class procedure TDockHeader.CreateDockHeaderImages(out Images: TDockHeaderImages); -var - ImageKind: TDockHeaderImageKind; -begin - for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do - Images[ImageKind] := CreateBitmapFromLazarusResource(DockHeaderImageNames[ImageKind]); -end; - -class procedure TDockHeader.DestroyDockHeaderImages( - var Images: TDockHeaderImages); -var - ImageKind: TDockHeaderImageKind; -begin - for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do - FreeAndNil(Images[ImageKind]); -end; - -class function TDockHeader.GetRectOfPart(AHeaderRect: TRect; AOrientation: TDockOrientation; - APart: TLazDockHeaderPart): TRect; -var - d: Integer; -begin - Result := AHeaderRect; - if APart = ldhpAll then - Exit; - InflateRect(Result, -2, -2); - case AOrientation of - doHorizontal: - begin - d := Result.Bottom - Result.Top; - if APart = ldhpCloseButton then - begin - Result.Left := Max(Result.Left, Result.Right - d); - Exit; - end; - Result.Right := Max(Result.Left, Result.Right - d - 1); - if APart = ldhpRestoreButton then - begin - Result.Left := Max(Result.Left, Result.Right - d); - Exit; - end; - Result.Right := Max(Result.Left, Result.Right - d - 1); - InflateRect(Result, -4, 0); - end; - doVertical: - begin - d := Result.Right - Result.Left; - if APart = ldhpCloseButton then - begin - Result.Bottom := Min(Result.Bottom, Result.Top + d); - Exit; - end; - Result.Top := Min(Result.Bottom, Result.Top + d + 1); - if APart = ldhpRestoreButton then - begin - Result.Bottom := Min(Result.Bottom, Result.Top + d); - Exit; - end; - Result.Top := Min(Result.Bottom, Result.Top + d + 1); - InflateRect(Result, 0, -4); - end; - end; -end; - -class function TDockHeader.FindPart(AHeaderRect: TRect; APoint: TPoint; AOrientation: TDockOrientation): TLazDockHeaderPart; -var - SubRect: TRect; -begin - for Result := Low(TLazDockHeaderPart) to High(TLazDockHeaderPart) do - begin - if Result = ldhpAll then - Continue; - SubRect := GetRectOfPart(AHeaderRect, AOrientation, Result); - if PtInRect(SubRect, APoint) then - Exit; - end; - Result := ldhpAll; -end; - -class procedure TDockHeader.Draw(ACanvas: TCanvas; ACaption: String; DockBtnImages: TDockHeaderImages; AOrientation: TDockOrientation; const ARect: TRect; const MousePos: TPoint); - - procedure DrawButton(ARect: TRect; IsMouseDown, IsMouseOver: Boolean; ABitmap: TCustomBitmap); inline; - const - // ------------- Pressed, Hot ----------------------- - BtnDetail: array[Boolean, Boolean] of TThemedToolBar = - ( - (ttbButtonNormal, ttbButtonHot), - (ttbButtonNormal, ttbButtonPressed) - ); - var - Details: TThemedElementDetails; - dx, dy: integer; - begin - Details := ThemeServices.GetElementDetails(BtnDetail[IsMouseDown, IsMouseOver]); - ThemeServices.DrawElement(ACanvas.Handle, Details, ARect); - ARect := ThemeServices.ContentRect(ACanvas.Handle, Details, ARect); - dx := (ARect.Right - ARect.Left - ABitmap.Width) div 2; - dy := (ARect.Bottom - ARect.Top - ABitmap.Height) div 2; - ACanvas.Draw(ARect.Left + dx, ARect.Top + dy, ABitmap); - end; - - procedure DrawTitle(ARect: TRect); inline; - begin - ACanvas.Pen.Color := clBtnShadow; - ACanvas.Brush.Color := clBtnFace; - ACanvas.Rectangle(ARect); - end; - -var - BtnRect: TRect; - DrawRect: TRect; - // LCL do not handle orientation in TFont - OldFont, RotatedFont: HFONT; - OldMode: Integer; - ALogFont: TLogFont; - IsMouseDown: Boolean; -begin - DrawRect := ARect; - InflateRect(DrawRect, -1, -1); - DrawTitle(DrawRect); - InflateRect(DrawRect, -1, -1); - - IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0; - - // draw close button - BtnRect := GetRectOfPart(ARect, AOrientation, ldhpCloseButton); - - DrawButton(BtnRect, IsMouseDown, PtInRect(BtnRect, MousePos), DockBtnImages[dhiClose]); - - // draw restore button - BtnRect := GetRectOfPart(ARect, AOrientation, ldhpRestoreButton); - DrawButton(BtnRect, IsMouseDown, PtInRect(BtnRect, MousePos), DockBtnImages[dhiRestore]); - - // draw caption - DrawRect := GetRectOfPart(ARect, AOrientation, ldhpCaption); - - OldMode := SetBkMode(ACanvas.Handle, TRANSPARENT); - - case AOrientation of - doHorizontal: - begin - DrawText(ACanvas.Handle, PChar(ACaption), -1, DrawRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER); - end; - doVertical: - begin - OldFont := 0; - if GetObject(ACanvas.Font.Reference.Handle, SizeOf(ALogFont), @ALogFont) <> 0 then - begin - ALogFont.lfEscapement := 900; - RotatedFont := CreateFontIndirect(ALogFont); - if RotatedFont <> 0 then - OldFont := SelectObject(ACanvas.Handle, RotatedFont); - end; - // from msdn: DrawText doesnot support font with orientation and escapement <> 0 - TextOut(ACanvas.Handle, DrawRect.Left, DrawRect.Bottom, PChar(ACaption), Length(ACaption)); - if OldFont <> 0 then - DeleteObject(SelectObject(ACanvas.Handle, OldFont)); - end; - end; - SetBkMode(ACanvas.Handle, OldMode); -end; - -class procedure TDockHeader.PerformMouseUp(AControl: TControl; - APart: TLazDockHeaderPart); -begin - case APart of - ldhpRestoreButton: - AControl.ManualDock(nil, nil, alNone); - ldhpCloseButton: - if AControl is TCustomForm then - TCustomForm(AControl).Close - else - // not a form => doesnot have close => just hide - AControl.Visible := False; - end; -end; - -class procedure TDockHeader.PerformMouseDown(AControl: TControl; - APart: TLazDockHeaderPart); -begin - case APart of - ldhpAll, ldhpCaption: - // mouse down on not buttons => start drag - AControl.BeginDrag(False); - end; -end; - - -function GetLazDockSplitter(Control: TControl; Side: TAnchorKind; out - Splitter: TLazDockSplitter): boolean; -begin - Result:=false; - Splitter:=nil; - if not (Side in Control.Anchors) then exit; - Splitter:=TLazDockSplitter(Control.AnchorSide[Side].Control); - if not (Splitter is TLazDockSplitter) then begin - Splitter:=nil; - exit; - end; - if Splitter.Parent<>Control.Parent then exit; - Result:=true; -end; - -function GetLazDockSplitterOrParent(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 TLazDockSplitter) - 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.Parent.ControlCount-1 do begin - Neighbour:=Control.Parent.Controls[i]; - if Neighbour=Control then continue; - 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; -const - MinControlSize = 20; -var - Splitter: TLazDockSplitter; -begin - Result:=false; - if not GetLazDockSplitter(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 Parent.ControlCount-1 do begin - if Checked[i] then continue; - SideControl:=Parent.Controls[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 TLazDockSplitter) then - exit;// not a splitter - if (TLazDockSplitter(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; - Candidates.Add(Parent); - for i:=0 to Parent.ControlCount-1 do - if Parent.Controls[i] is TLazDockSplitter 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; - - Candidates.Free; -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; - -{ TLazDockPages } - -function TLazDockPages.GetActiveNotebookPageComponent: TLazDockPage; -begin - Result:=TLazDockPage(inherited ActivePageComponent); -end; - -function TLazDockPages.GetNoteBookPage(Index: Integer): TLazDockPage; -begin - Result:=TLazDockPage(inherited Page[Index]); -end; - -procedure TLazDockPages.SetActiveNotebookPageComponent( - const AValue: TLazDockPage); -begin - ActivePageComponent:=AValue; -end; - -function TLazDockPages.GetFloatingDockSiteClass: TWinControlClass; -begin - Result:=TLazDockForm; -end; - -procedure TLazDockPages.Change; -begin - inherited Change; - TLazDockForm.UpdateMainControlInParents(Self); -end; - -constructor TLazDockPages.Create(TheOwner: TComponent); -begin - PageClass := TLazDockPage; - inherited Create(TheOwner); -end; - -{ TLazDockTree } - -procedure TLazDockTree.UndockControlForDocking(AControl: TControl); -var - AWinControl: TWinControl; - Sibling: TControl; - a: TAnchorKind; - i: Integer; -begin - DebugLn(['TLazDockTree.UndockControlForDocking AControl=',DbgSName(AControl),' AControl.Parent=',DbgSName(AControl.Parent)]); - // undock AControl - if AControl is TWinControl then - begin - AWinControl := TWinControl(AControl); - if (AWinControl.DockManager<>nil) and (AWinControl.DockManager<>Self) then - begin - raise Exception.Create('TLazDockTree.UndockControlForDocking mixing docking managers is not supported'); - end; - end; - if AControl.Parent <> nil then - begin - AControl.Parent := nil; - end; - for i:=AControl.AnchoredControlCount - 1 downto 0 do - begin - Sibling := AControl.AnchoredControls[i]; - if (Sibling <> AControl.Parent) and (Sibling.Parent <> AControl) then - begin - for a := Low(TAnchorKind) to High(TAnchorKind) do - if Sibling.AnchorSide[a].Control = AControl then - Sibling.AnchorSide[a].Control := nil; - end; - end; -end; - -function TLazDockTree.DefaultDockGrabberSize: Integer; -begin - Result := {Abs(DockSite.Font.Height) + 4} 20; -end; - -procedure TLazDockTree.BreakAnchors(Zone: TDockZone); -begin - if Zone = nil then Exit; - if (Zone.ChildControl <> nil) and (Zone.ChildControl <> DockSite) then - begin - Zone.ChildControl.AnchorSide[akLeft].Control := nil; - Zone.ChildControl.AnchorSide[akTop].Control := nil; - Zone.ChildControl.Anchors := [akLeft, akTop]; - Zone.ChildControl.BorderSpacing.Left := 0; - Zone.ChildControl.BorderSpacing.Top := 0; - end; - BreakAnchors(Zone.FirstChild); - BreakAnchors(Zone.NextSibling); -end; - -procedure TLazDockTree.PaintDockFrame(ACanvas: TCanvas; AControl: TControl; const ARect: TRect); -var - Pt: TPoint; -begin - GetCursorPos(Pt); - Pt := DockSite.ScreenToClient(Pt); - TDockHeader.Draw(ACanvas, DockSite.GetDockCaption(AControl), FDockHeaderImages, - AControl.DockOrientation, ARect, Pt); -end; - -procedure TLazDockTree.CreateDockLayoutHelperControls(Zone: TLazDockZone); -var - ParentPages: TLazDockPages; - ZoneIndex: LongInt; -begin - if Zone = nil then - Exit; - - // create needed TLazDockSplitter - if (Zone.Parent <> nil) and - (Zone.Parent.Orientation in [doVertical,doHorizontal]) and - (Zone.PrevSibling <> nil) then - begin - // a zone with a side sibling -> needs a TLazDockSplitter - if Zone.Splitter = nil then - begin - Zone.Splitter := TLazDockSplitter.Create(nil); - Zone.Splitter.Align := alNone; - end; - end - else - if Zone.Splitter <> nil then - begin - // zone no longer needs the splitter - Zone.Splitter.Free; - Zone.Splitter := nil; - end; - - // create needed TLazDockPages - if (Zone.Orientation = doPages) then - begin - // a zone of pages -> needs a TLazDockPages - if Zone.FirstChild = nil then - RaiseGDBException('TLazDockTree.CreateDockLayoutHelperControls Inconsistency: doPages without children'); - if (Zone.Pages = nil) then - Zone.Pages:=TLazDockPages.Create(nil); - end - else - if Zone.Pages<>nil then - begin - // zone no longer needs the pages - Zone.Pages.Free; - Zone.Pages := nil; - end; - - // create needed TLazDockPage - if (Zone.Parent<>nil) and - (Zone.Parent.Orientation = doPages) then - begin - // a zone as page -> needs a TLazDockPage - if (Zone.Page = nil) then - begin - ParentPages := TLazDockZone(Zone.Parent).Pages; - ZoneIndex := Zone.GetIndex; - ParentPages.Pages.Insert(ZoneIndex,Zone.GetCaption); - Zone.Page := ParentPages.Page[ZoneIndex]; - end; - end - else - if Zone.Page <> nil then - begin - // zone no longer needs the page - Zone.Page.Free; - Zone.Page := nil; - end; - - // create controls for children and siblings - CreateDockLayoutHelperControls(Zone.FirstChild as TLazDockZone); - CreateDockLayoutHelperControls(Zone.NextSibling as TLazDockZone); -end; - -procedure TLazDockTree.ResetSizes(Zone: TLazDockZone); -var - NewSize, NewPos: Integer; - Child: TLazDockZone; -begin - if Zone = nil then - Exit; - - // split available size between children - if (Zone.Orientation in [doHorizontal, doVertical]) and - (Zone.VisibleChildCount > 0) then - begin - NewSize := Zone.LimitSize div Zone.VisibleChildCount; - NewPos := Zone.LimitBegin; - Child := Zone.FirstChild as TLazDockZone; - while Child <> nil do - begin - if Child.Visible then - begin - case Zone.Orientation of - doHorizontal: - begin - Child.Top := NewPos; - Child.Height := NewSize; - end; - doVertical: - begin - Child.Left := NewPos; - Child.Width := NewSize; - end; - end; - ResetSizes(Child); - inc(NewPos, NewSize); - end; - Child := Child.NextSibling as TLazDockZone; - end; - end; -end; - -procedure TLazDockTree.AdjustDockRect(AControl: TControl; var ARect: TRect); -begin - // offset one of the borders of control rect in order to get space for frame - case AControl.DockOrientation of - doHorizontal: - Inc(ARect.Top, DefaultDockGrabberSize); - doVertical: - Inc(ARect.Left, DefaultDockGrabberSize); - end; -end; - -procedure TLazDockTree.AnchorDockLayout(Zone: TLazDockZone); -// setup all anchors between all docked controls and helper controls -const - SplitterWidth = 5; - SplitterHeight = 5; -var - AnchorControls: array[TAnchorKind] of TControl; - a: TAnchorKind; - SplitterSide: TAnchorKind; - CurControl: TControl; - NewSplitterAnchors: TAnchors; - NewAnchors: TAnchors; -begin - if Zone = nil then - Exit; - - if Zone.Pages <> nil then - CurControl := Zone.Pages - else - CurControl := Zone.ChildControl; - //DebugLn(['TLazDockTree.AnchorDockLayout CurControl=',DbgSName(CurControl),' DockSite=',DbgSName(DockSite)]); - if ((CurControl <> nil) and (CurControl <> DockSite)) or (Zone.Splitter <> nil) then - begin - // get outside anchor controls - NewAnchors := [akLeft, akRight, akTop, akBottom]; - for a := Low(TAnchorKind) to High(TAnchorKind) do - AnchorControls[a] := GetAnchorControl(Zone, a, true); - - // anchor splitter - if (Zone.Splitter <> nil) then - begin - if Zone.Parent.Orientation = doHorizontal then - begin - SplitterSide := akTop; - NewSplitterAnchors := [akLeft, akRight]; - Zone.Splitter.AnchorSide[akLeft].Side := asrTop; - Zone.Splitter.AnchorSide[akRight].Side := asrBottom; - Zone.Splitter.Height := SplitterHeight; - if Zone.PrevSibling <> nil then - Zone.Splitter.Top := (Zone.PrevSibling.Top + Zone.PrevSibling.Height) - DefaultDockGrabberSize; - Zone.Splitter.ResizeAnchor := akBottom; - end - else - begin - SplitterSide := akLeft; - NewSplitterAnchors := [akTop, akBottom]; - Zone.Splitter.AnchorSide[akTop].Side := asrTop; - Zone.Splitter.AnchorSide[akBottom].Side := asrBottom; - Zone.Splitter.Width := SplitterWidth; - if Zone.PrevSibling <> nil then - Zone.Splitter.Left := (Zone.PrevSibling.Left + Zone.PrevSibling.Width) - DefaultDockGrabberSize; - Zone.Splitter.ResizeAnchor := akRight; - end; - // IMPORTANT: first set the AnchorSide, then set the Anchors - for a := Low(TAnchorKind) to High(TAnchorKind) do - begin - if a in NewSplitterAnchors then - Zone.Splitter.AnchorSide[a].Control := AnchorControls[a] - else - Zone.Splitter.AnchorSide[a].Control := nil; - end; - Zone.Splitter.Anchors := NewSplitterAnchors; - Zone.Splitter.Parent := Zone.GetParentControl; - AnchorControls[SplitterSide] := Zone.Splitter; - end; - - if (CurControl <> nil) then - begin - // anchor pages - // IMPORTANT: first set the AnchorSide, then set the Anchors - //DebugLn(['TLazDockTree.AnchorDockLayout CurControl.Parent=',DbgSName(CurControl.Parent),' ',CurControl.Visible]); - for a := Low(TAnchorKind) to High(TAnchorKind) do - begin - if AnchorControls[a] <> CurControl then - CurControl.AnchorSide[a].Control := AnchorControls[a]; - if (AnchorControls[a] <> nil) and (AnchorControls[a].Parent = CurControl.Parent) then - CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[a] - else - CurControl.AnchorSide[a].Side := DefaultSideForAnchorKind[OppositeAnchor[a]]; - end; - CurControl.Anchors := NewAnchors; - // set space for header - case CurControl.DockOrientation of - doHorizontal: CurControl.BorderSpacing.Top := DefaultDockGrabberSize; - doVertical: CurControl.BorderSpacing.Left := DefaultDockGrabberSize; - end; - end; - end; - - // anchor controls for children and siblings - AnchorDockLayout(Zone.FirstChild as TLazDockZone); - AnchorDockLayout(Zone.NextSibling as TLazDockZone); -end; - -constructor TLazDockTree.Create(TheDockSite: TWinControl); -begin - FillChar(FMouseState, SizeOf(FMouseState), 0); - TDockHeader.CreateDockHeaderImages(FDockHeaderImages); - SetDockZoneClass(TLazDockZone); - if TheDockSite = nil then - begin - TheDockSite := TLazDockForm.Create(nil); - TheDockSite.DockManager := Self; - FAutoFreeDockSite := True; - end; - inherited Create(TheDockSite); -end; - -destructor TLazDockTree.Destroy; -begin - if FAutoFreeDockSite then - begin - if DockSite.DockManager = Self then - DockSite.DockManager := nil; - DockSite.Free; - DockSite := nil; - end; - TDockHeader.DestroyDockHeaderImages(FDockHeaderImages); - inherited Destroy; -end; - -procedure TLazDockTree.InsertControl(AControl: TControl; InsertAt: TAlign; - DropControl: TControl); -{ undocks AControl and docks it into the tree - It creates a new TDockZone for AControl and inserts it as a new leaf. - It automatically changes the tree, so that the parent of the new TDockZone - will have the Orientation for InsertAt. - - Example 1: - - A newly created TLazDockTree has only a DockSite (TLazDockForm) and a single - TDockZone - the RootZone, which has as ChildControl the DockSite. - - Visual: - +-DockSite--+ - | | - +-----------+ - Tree of TDockZone: - RootZone (DockSite,doNoOrient) - - - Inserting the first control: InsertControl(Form1,alLeft,nil); - Visual: - +-DockSite---+ - |+--Form1---+| - || || - |+----------+| - +------------+ - Tree of TDockZone: - RootZone (DockSite,doHorizontal) - +-Zone2 (Form1,doNoOrient) - - - Dock Form2 right of Form1: InsertControl(Form2,alLeft,Form1); - Visual: - +-DockSite----------+ - |+-Form1-+|+-Form2-+| - || || || - |+-------+|+-------+| - +-------------------+ - Tree of TDockZone: - RootZone (DockSite,doHorizontal) - +-Zone2 (Form1,doNoOrient) - +-Zone3 (Form2,doNoOrient) -} - - procedure PrepareControlForResize(AControl: TControl); inline; - var - a: TAnchorKind; - begin - AControl.Align := alNone; - AControl.Anchors := [akLeft, akTop]; - for a := Low(TAnchorKind) to High(TAnchorKind) do - AControl.AnchorSide[a].Control := nil; - AControl.AutoSize := False; - end; - -var - CtlZone, DropZone, OldParentZone, NewParentZone: TDockZone; - NewZone: TLazDockZone; - NewOrientation: TDockOrientation; - NeedNewParentZone: Boolean; - NewBounds: TRect; -begin - CtlZone := RootZone.FindZone(AControl); - if CtlZone <> nil then - RemoveControl(AControl); - - if (DropControl = nil) or (DropControl = AControl) then - DropControl := DockSite; - - DropZone := RootZone.FindZone(DropControl); - if DropZone = nil then - raise Exception.Create('TLazDockTree.InsertControl DropControl is not part of this TDockTree'); - - NewOrientation := DockAlignOrientations[InsertAt]; - - // undock - UndockControlForDocking(AControl); - - // dock - // create a new zone for AControl - NewZone := DockZoneClass.Create(Self,AControl) as TLazDockZone; - - // insert new zone into tree - if (DropZone = RootZone) and (RootZone.FirstChild = nil) then - begin - // this is the first child - debugln('TLazDockTree.InsertControl First Child'); - //RootZone.Orientation := NewOrientation; - RootZone.AddAsFirstChild(NewZone); - AControl.DockOrientation := NewOrientation; - if not AControl.Visible then - DockSite.Visible := False; - - NewBounds := DockSite.ClientRect; - AdjustDockRect(AControl, NewBounds); - PrepareControlForResize(AControl); - - AControl.BoundsRect := NewBounds; - AControl.Parent := DockSite; - - if AControl.Visible then - DockSite.Visible := True; - end else - begin - // there are already other children - - // optimize DropZone - if (DropZone.ChildCount>0) and - (NewOrientation in [doHorizontal,doVertical]) and - (DropZone.Orientation in [NewOrientation, doNoOrient]) then - begin - // docking on a side of an inner node is the same as docking to a side of - // a child - if InsertAt in [alLeft,alTop] then - DropZone := DropZone.FirstChild - else - DropZone := DropZone.GetLastChild; - end; - - // insert a new Parent Zone if needed - NeedNewParentZone := True; - if (DropZone.Parent <> nil) then - begin - if (DropZone.Parent.Orientation = doNoOrient) then - NeedNewParentZone := False; - if (DropZone.Parent.Orientation = NewOrientation) then - NeedNewParentZone := False; - end; - if NeedNewParentZone then - begin - // insert a new zone between current DropZone.Parent and DropZone - // this new zone will become the new DropZone.Parent - OldParentZone := DropZone.Parent; - NewParentZone := DockZoneClass.Create(Self, nil); - if OldParentZone <> nil then - OldParentZone.ReplaceChild(DropZone, NewParentZone); - NewParentZone.AddAsFirstChild(DropZone); - if RootZone = DropZone then - FRootZone := NewParentZone; - end; - - if DropZone.Parent = nil then - RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Parent=nil'); - // adjust Orientation in tree - if DropZone.Parent.Orientation = doNoOrient then - begin - // child control already had orientation but now we moved it to parent - // which can take another orientation => change child control orientation - DropZone.Parent.Orientation := NewOrientation; - if (DropZone.Parent.ChildCount = 1) and (DropZone.Parent.FirstChild.ChildControl <> nil) then - DropZone.Parent.FirstChild.ChildControl.DockOrientation := NewOrientation; - end; - if DropZone.Parent.Orientation <> NewOrientation then - RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Orientation<>NewOrientation'); - - // insert new node - //DoDi: should insert relative to dropzone, not at begin/end of the parent zone - DropZone.AddSibling(NewZone, InsertAt); - - // add AControl to DockSite - PrepareControlForResize(AControl); - AControl.DockOrientation := NewOrientation; - AControl.Parent := NewZone.GetParentControl; - end; - - // Build dock layout (anchors, splitters, pages) - if NewZone.Parent <> nil then - BuildDockLayout(NewZone.Parent as TLazDockZone) - else - BuildDockLayout(RootZone as TLazDockZone); -end; - -procedure TLazDockTree.RemoveControl(AControl: TControl); -var - RemoveZone, ParentZone: TLazDockZone; -begin - RemoveZone := RootZone.FindZone(AControl) as TLazDockZone; - - // no such control => exit - if RemoveZone = nil then - Exit; - - // has children - if (RemoveZone.ChildCount > 0) then - raise Exception.Create('TLazDockTree.RemoveControl RemoveZone.ChildCount > 0'); - - // destroy child zone and all parents if they does not contain anything else - while (RemoveZone <> RootZone) and - (RemoveZone.ChildCount = 0) do - begin - ParentZone := RemoveZone.Parent as TLazDockZone; - RemoveZone.FreeSubComponents; - BreakAnchors(RemoveZone); - if ParentZone <> nil then - ParentZone.Remove(RemoveZone); - RemoveZone.Free; - // try with ParentZone now - RemoveZone := ParentZone; - end; - - // reset orientation - if (RemoveZone.ChildCount = 1) and (RemoveZone.Orientation in [doHorizontal, doVertical]) then - RemoveZone.Orientation := doNoOrient; - - // Build dock layout (anchors, splitters, pages) - if (RemoveZone.Parent <> nil) then - BuildDockLayout(RemoveZone.Parent as TLazDockZone) - else - BuildDockLayout(RootZone as TLazDockZone); -end; - -procedure TLazDockTree.BuildDockLayout(Zone: TLazDockZone); -begin - if DockSite <> nil then - DockSite.DisableAlign; - try - BreakAnchors(Zone); - CreateDockLayoutHelperControls(Zone); - ResetSizes(Zone); - AnchorDockLayout(Zone); - finally - if DockSite <> nil then - begin - DockSite.EnableAlign; - DockSite.Invalidate; - end; - end; -end; - -procedure TLazDockTree.FindBorderControls(Zone: TLazDockZone; Side: TAnchorKind; - var List: TFPList); -begin - if List=nil then List:=TFPList.Create; - if Zone=nil then exit; - - if (Zone.Splitter<>nil) and (Zone.Parent<>nil) - and (Zone.Orientation=doVertical) then begin - // this splitter is leftmost, topmost, bottommost - if Side in [akLeft,akTop,akBottom] then - List.Add(Zone.Splitter); - if Side=akLeft then begin - // the splitter fills the whole left side => no more controls - exit; - end; - end; - if (Zone.Splitter<>nil) and (Zone.Parent<>nil) - and (Zone.Orientation=doHorizontal) then begin - // this splitter is topmost, leftmost, rightmost - if Side in [akTop,akLeft,akRight] then - List.Add(Zone.Splitter); - if Side=akTop then begin - // the splitter fills the whole top side => no more controls - exit; - end; - end; - if Zone.ChildControl<>nil then begin - // the ChildControl fills the whole zone (except for the splitter) - List.Add(Zone.ChildControl); - exit; - end; - if Zone.Pages<>nil then begin - // the pages fills the whole zone (except for the splitter) - List.Add(Zone.Pages); - exit; - end; - - // go recursively through all child zones - if (Zone.Parent<>nil) and (Zone.Orientation in [doVertical,doHorizontal]) - and (Zone.FirstChild<>nil) then - begin - if Side in [akLeft,akTop] then - FindBorderControls(Zone.FirstChild as TLazDockZone,Side,List) - else - FindBorderControls(Zone.GetLastChild as TLazDockZone,Side,List); - end; -end; - -function TLazDockTree.FindBorderControl(Zone: TLazDockZone; Side: TAnchorKind - ): TControl; -var - List: TFPList; -begin - Result:=nil; - if Zone=nil then exit; - List:=nil; - FindBorderControls(Zone,Side,List); - if (List=nil) or (List.Count=0) then - Result:=DockSite - else - Result:=TControl(List[0]); - List.Free; -end; - -function TLazDockTree.GetAnchorControl(Zone: TLazDockZone; Side: TAnchorKind; - OutSide: boolean): TControl; -// find a control to anchor the Zone's Side -begin - if Zone = nil then - begin - Result := DockSite; - exit; - end; - - if not OutSide then - begin - // also check the Splitter and the Page - if (Side = akLeft) and (Zone.Parent <> nil) and - (Zone.Parent.Orientation = doVertical) and (Zone.Splitter<>nil) then - begin - Result := Zone.Splitter; - exit; - end; - if (Side = akTop) and (Zone.Parent<>nil) and - (Zone.Parent.Orientation=doHorizontal) and (Zone.Splitter<>nil) then - begin - Result := Zone.Splitter; - exit; - end; - if (Zone.Page <> nil) then - begin - Result := Zone.Page; - exit; - end; - end; - - // search the neighbour zones: - Result := DockSite; - if (Zone.Parent = nil) then - Exit; - - case Zone.Parent.Orientation of - doHorizontal: - if (Side=akTop) and (Zone.PrevSibling<>nil) then - Result:=FindBorderControl(Zone.PrevSibling as TLazDockZone,akBottom) - else if (Side=akBottom) and (Zone.NextSibling<>nil) then - Result:=FindBorderControl(Zone.NextSibling as TLazDockZone,akTop) - else - Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false); - doVertical: - if (Side=akLeft) and (Zone.PrevSibling<>nil) then - Result:=FindBorderControl(Zone.PrevSibling as TLazDockZone,akRight) - else if (Side=akRight) and (Zone.NextSibling<>nil) then - Result:=FindBorderControl(Zone.NextSibling as TLazDockZone,akLeft) - else - Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false); - doPages: - Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false); - end; -end; - -procedure TLazDockTree.PaintSite(DC: HDC); -var - ACanvas: TCanvas; - ARect: TRect; - i: integer; -begin - // paint bounds for each control and close button - if DockSite.ControlCount > 0 then - begin - ACanvas := TCanvas.Create; - ACanvas.Handle := DC; - try - for i := 0 to DockSite.ControlCount - 1 do - begin - if (DockSite.Controls[i].HostDockSite = DockSite) and - (DockSite.Controls[i].Visible) then - begin - ARect := DockSite.Controls[i].BoundsRect; - case DockSite.Controls[i].DockOrientation of - doHorizontal: - begin - ARect.Bottom := ARect.Top; - Dec(ARect.Top, DefaultDockGrabberSize); - end; - doVertical: - begin - ARect.Right := ARect.Left; - Dec(ARect.Left, DefaultDockGrabberSize); - end; - end; - PaintDockFrame(ACanvas, DockSite.Controls[i], ARect); - end; - end; - finally - ACanvas.Free; - end; - end; -end; - -procedure TLazDockTree.MessageHandler(Sender: TControl; var Message: TLMessage); - - procedure CheckNeedRedraw(AControl: TControl; ARect: TRect; APart: TLazDockHeaderPart); - var - NewMouseState: TDockHeaderMouseState; - begin - if AControl = nil then - FillChar(ARect, SizeOf(ARect), 0) - else - ARect := TDockHeader.GetRectOfPart(ARect, AControl.DockOrientation, APart); - // we cannot directly redraw this part since we should paint only in paint events - FillChar(NewMouseState, SizeOf(NewMouseState), 0); - NewMouseState.Rect := ARect; - NewMouseState.IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0; - if not CompareMem(@FMouseState, @NewMouseState, SizeOf(NewMouseState)) then - begin - if not CompareRect(@FMouseState.Rect, @NewMouseState.Rect) then - InvalidateRect(DockSite.Handle, @FMouseState.Rect, False); - FMouseState := NewMouseState; - InvalidateRect(DockSite.Handle, @NewMouseState.Rect, False); - end; - end; - - function GetControlHeaderRect(AControl: TControl; out ARect: TRect): Boolean; - begin - Result := True; - ARect := AControl.BoundsRect; - case AControl.DockOrientation of - doHorizontal: - begin - ARect.Bottom := ARect.Top; - Dec(ARect.Top, DefaultDockGrabberSize); - end; - doVertical: - begin - ARect.Right := ARect.Left; - Dec(ARect.Left, DefaultDockGrabberSize); - end; - else - Result := False; - end; - end; - - function FindControlAndPart(MouseMsg: TLMMouse; out ARect: TRect; out APart: TLazDockHeaderPart): TControl; - var - i: integer; - Pt: TPoint; - begin - Pt := SmallPointToPoint(MouseMsg.Pos); - for i := 0 to DockSite.ControlCount - 1 do - begin - if DockSite.Controls[i].HostDockSite = DockSite then - begin - if not GetControlHeaderRect(DockSite.Controls[i], ARect) then - Continue; - if not PtInRect(ARect, Pt) then - Continue; - // we have control here - Result := DockSite.Controls[i]; - APart := TDockHeader.FindPart(ARect, Pt, DockSite.Controls[i].DockOrientation); - Exit; - end; - end; - Result := nil; - end; - -var - ARect: TRect; - Part: TLazDockHeaderPart; - Control: TControl; - AZone: TLazDockZone; -begin - case Message.msg of - LM_LBUTTONUP: - begin - Control := FindControlAndPart(TLMMouse(Message), ARect, Part); - CheckNeedRedraw(Control, ARect, Part); - TDockHeader.PerformMouseUp(Control, Part); - end; - LM_LBUTTONDOWN: - begin - Control := FindControlAndPart(TLMMouse(Message), ARect, Part); - CheckNeedRedraw(Control, ARect, Part); - TDockHeader.PerformMouseDown(Control, Part); - end; - LM_MOUSEMOVE: - begin - Control := FindControlAndPart(TLMMouse(Message), ARect, Part); - CheckNeedRedraw(Control, ARect, Part); - end; - CM_MOUSELEAVE: - CheckNeedRedraw(nil, Rect(0,0,0,0), ldhpAll); - CM_TEXTCHANGED: - begin - if GetControlHeaderRect(Sender, ARect) then - begin - ARect := TDockHeader.GetRectOfPart(ARect, Sender.DockOrientation, ldhpCaption); - InvalidateRect(DockSite.Handle, @ARect, False); - end; - end; - CM_VISIBLECHANGED: - begin - if not (csDestroying in Sender.ComponentState) then - begin - AZone := RootZone.FindZone(Sender) as TLazDockZone; - if AZone <> nil then - BuildDockLayout(TLazDockZone(AZone.Parent)); - end; - end; - LM_SIZE, LM_MOVE: - begin - if GetControlHeaderRect(Sender, ARect) then - InvalidateRect(DockSite.Handle, @ARect, False); - end; - end -end; - -procedure TLazDockTree.DumpLayout(FileName: String); -var - Stream: TStream; - - procedure WriteLn(S: String); - begin - S := S + #$D#$A; - Stream.Write(S[1], Length(S)); - end; - - procedure WriteHeader; - begin - WriteLn(''); - WriteLn(''); - WriteLn('Dock Layout'); - WriteLn(''); - WriteLn(''); - WriteLn(''); - end; - - procedure WriteFooter; - begin - WriteLn(''); - WriteLn(''); - end; - - procedure DumpAnchors(Title: String; AControl: TControl); - var - a: TAnchorKind; - S, Name: String; - begin - S := Title; - if AControl.Anchors <> [] then - begin - S := S + '
    '; - for a := Low(TAnchorKind) to High(TAnchorKind) do - if a in AControl.Anchors then - begin - Name := DbgsName(AControl.AnchorSide[a].Control); - if (AControl.AnchorSide[a].Control <> nil) and (AControl.AnchorSide[a].Control.Name = '') then - Name := dbgs(AControl.AnchorSide[a].Control) + Name; - S := S + '
  • ' + GetEnumName(TypeInfo(TAnchorKind), Ord(a)) + ' = ' + - Name + ' (' + - GetEnumName(TypeInfo(TAnchorSideReference), Ord(AControl.AnchorSide[a].Side)) + - ')' + '
    • '; - end; - S := S + '
'; - end - else - S := S + '[]'; - WriteLn(S); - end; - - procedure DumpZone(Zone: TDockZone); - const - DumpStr = 'Zone: Orientation = %s, ChildCount = %d, ChildControl = %s, %s, Splitter = %s'; - var - S: string; - begin - WriteStr(S, Zone.Orientation); - WriteLn(Format(DumpStr, [S, Zone.ChildCount, DbgSName(Zone.ChildControl), - DbgS(Bounds(Zone.Left, Zone.Top, Zone.Width, Zone.Height)), - dbgs(TLazDockZone(Zone).Splitter)])); - if TLazDockZone(Zone).Splitter <> nil then - DumpAnchors('
Splitter anchors: ', TLazDockZone(Zone).Splitter); - if Zone.ChildControl <> nil then - DumpAnchors('
ChildControl anchors: ', Zone.ChildControl); - end; - - procedure WriteZone(Zone: TDockZone); - begin - if Zone <> nil then - begin - WriteLn('
  • '); - DumpZone(Zone); - if Zone.ChildCount > 0 then - begin - WriteLn('
      '); - WriteZone(Zone.FirstChild); - WriteLn('
    '); - end; - WriteLn('
    • '); - WriteZone(Zone.NextSibling); - end; - end; - - procedure WriteLayout; - begin - WriteLn('
      '); - WriteZone(RootZone); - WriteLn('
    '); - end; - -begin - Stream := TFileStream.Create(FileName, fmCreate); - try - WriteHeader; - WriteLayout; - WriteFooter; - finally - Stream.Free; - end; -end; - -{ TLazDockZone } - -destructor TLazDockZone.Destroy; -begin - FreeSubComponents; - inherited Destroy; -end; - -procedure TLazDockZone.FreeSubComponents; -begin - FreeAndNil(FSplitter); - FreeAndNil(FPage); - FreeAndNil(FPages); -end; - -function TLazDockZone.GetCaption: string; -begin - if ChildControl<>nil then - Result:=ChildControl.Caption - else - Result:=IntToStr(GetIndex); -end; - -function TLazDockZone.GetParentControl: TWinControl; -var - Zone: TDockZone; -begin - Result := nil; - Zone := Parent; - while Zone <> nil do - begin - if Zone.Orientation = doPages then - Exit((Zone as TLazDockZone).Pages); - - if (Zone.Parent = nil) then - begin - if Zone.ChildControl is TWinControl then - Result := TWinControl(Zone.ChildControl) - else - if Zone = Tree.RootZone then - Result := Tree.DockSite; - Exit; - end; - Zone := Zone.Parent; - end; -end; - -{ TCustomAnchoredDockManager } - -procedure TCustomAnchoredDockManager.DeleteSideSplitter(Splitter: TLazDockSplitter; - Side: TAnchorKind; NewAnchorControl: TControl); -var - SplitterParent: TWinControl; - i: Integer; - CurControl: TControl; - NewSideRef: TAnchorSideReference; -begin - //DebugLn('TCustomAnchoredDockManager.DeleteSideSplitter Splitter=',DbgSName(Splitter),' Side=',dbgs(Side),' NewAnchorControl=',DbgSName(NewAnchorControl)); - SplitterParent:=Splitter.Parent; - SplitterParent.DisableAlign; - try - for i:=0 to SplitterParent.ControlCount-1 do begin - CurControl:=SplitterParent.Controls[i]; - if CurControl.AnchorSide[Side].Control=Splitter then begin - CurControl.AnchorSide[Side].Control:=NewAnchorControl; - if NewAnchorControl=CurControl.Parent then - NewSideRef:=DefaultSideForAnchorKind[OppositeAnchor[Side]] - else - NewSideRef:=DefaultSideForAnchorKind[Side]; - CurControl.AnchorSide[Side].Side:=NewSideRef; - //DebugLn('TCustomAnchoredDockManager.DeleteSideSplitter Anchor ',DbgSName(CurControl),'(',dbgs(Side),') to ',DbgSName(NewAnchorControl)); - end; - end; - Splitter.Free; - finally - SplitterParent.EnableAlign; - end; -end; - -procedure TCustomAnchoredDockManager.CombineSpiralSplitterPair(Splitter1, - Splitter2: TLazDockSplitter); -{ - Anchor all controls anchored to Splitter2 to Splitter1 - - extend Splitter1 - - delete Splitter2 - - Example: - - Four spiral splitters: - - Before: - | - A | - ---------| - | +--+ | C - B | | | | - | +--+ | - | ---------- - | D - - The left and right splitter will be combined to one. - - After: - | - A | - -------| - | C - B | - | - |------ - | D - } - - procedure MoveAnchorSide(AControl: TControl; Side: TAnchorKind); - begin - if AControl.AnchorSide[Side].Control=Splitter2 then - AControl.AnchorSide[Side].Control:=Splitter1; - end; - - procedure EnlargeSplitter(Side: TAnchorKind); - begin - if GetAnchorDepth(Splitter1,Side)>GetAnchorDepth(Splitter2,Side) then - Splitter1.AnchorSide[Side].Assign(Splitter2.AnchorSide[Side]); - end; - -var - LeftRightSplitter: boolean; - ParentControl: TWinControl; - i: Integer; - CurControl: TControl; -begin - DebugLn('TCustomAnchoredDockManager.CombineSpiralSplitterPair Splitter1=',DbgSName(Splitter1),dbgs(Splitter1.BoundsRect),' Splitter2=',DbgSName(Splitter2),dbgs(Splitter2.BoundsRect)); - // check splitters have the same Parent - ParentControl:=Splitter1.Parent; - if (ParentControl=nil) then - RaiseGDBException('TCustomAnchoredDockManager.CombineSpiralSplitterPair Inconsistency: Parent=nil'); - if (ParentControl<>Splitter2.Parent) then - RaiseGDBException('TCustomAnchoredDockManager.CombineSpiralSplitterPair Inconsistency: Splitters not siblings'); - // check splitters have same orientation - LeftRightSplitter:=(Splitter1.ResizeAnchor in [akLeft,akRight]); - if LeftRightSplitter<>(Splitter2.ResizeAnchor in [akLeft,akRight]) then - RaiseGDBException('TCustomAnchoredDockManager.CombineSpiralSplitterPair Inconsistency: different orientation'); - - ParentControl.DisableAlign; - try - // move incident anchors from Splitter2 to Splitter1 - for i:=0 to ParentControl.ControlCount-1 do begin - CurControl:=ParentControl.Controls[i]; - if CurControl=Splitter1 then continue; - if CurControl=Splitter2 then continue; - if LeftRightSplitter then begin - MoveAnchorSide(CurControl,akLeft); - MoveAnchorSide(CurControl,akRight); - end else begin - MoveAnchorSide(CurControl,akTop); - MoveAnchorSide(CurControl,akBottom); - end; - end; - - // enlarge Splitter1 - if LeftRightSplitter then begin - // enlarge Splitter1 to top and bottom - EnlargeSplitter(akTop); - EnlargeSplitter(akBottom); - end else begin - // enlarge Splitter1 to left and right - EnlargeSplitter(akLeft); - EnlargeSplitter(akRight); - end; - - // delete Splitter2 - Splitter2.Free; - finally - ParentControl.EnableAlign; - end; -end; - -procedure TCustomAnchoredDockManager.DeletePage(Page: TLazDockPage); -var - Pages: TLazDockPages; -begin - DebugLn('TCustomAnchoredDockManager.DeletePage Page=',DbgSName(Page)); - Pages:=Page.PageControl; - Page.Free; - if Pages.PageCount=0 then - DeletePages(Pages); -end; - -procedure TCustomAnchoredDockManager.DeletePages(Pages: TLazDockPages); -begin - DebugLn('TCustomAnchoredDockManager.DeletePages Pages=',DbgSName(Pages)); - if Pages.Parent<>nil then - UndockControl(Pages,false); - Pages.Free; -end; - -procedure TCustomAnchoredDockManager.DeleteDockForm(ADockForm: TLazDockForm); -begin - DebugLn('TCustomAnchoredDockManager.DeleteDockForm ADockForm=',DbgSName(ADockForm)); - if ADockForm.Parent<>nil then - UndockControl(ADockForm,false); - ADockForm.DockManager:=nil; - ADockForm.UseDockManager:=false; - Application.ReleaseComponent(ADockForm); -end; - -function TCustomAnchoredDockManager.GetAnchorDepth(AControl: TControl; - Side: TAnchorKind): Integer; -var - NewControl: TControl; -begin - Result:=0; - while (AControl<>nil) do begin - inc(Result); - if not (Side in AControl.Anchors) then break; // loose end - NewControl:=AControl.AnchorSide[Side].Control; - if NewControl=nil then break; // loose end - if NewControl.Parent<>AControl.Parent then break; // parent end - if Result>AControl.Parent.ControlCount then break; // circle - AControl:=NewControl; - end; -end; - -function TCustomAnchoredDockManager.GetPreferredTitlePosition(AWidth, - AHeight: integer): TAnchorKind; -begin - if AWidth>((AHeight*3) div 2) then - Result:=akLeft - else - Result:=akTop; -end; - -procedure TCustomAnchoredDockManager.UpdateTitlePosition(Control: TControl); -var - TitlePos: TAnchorKind; -begin - if Control.Parent is TLazDockForm then begin - TitlePos:=GetPreferredTitlePosition(Control.Width,Control.Height); - if TitlePos=akLeft then begin - Control.BorderSpacing.Left:=TitleWidth; - Control.BorderSpacing.Top:=0; - end else begin - Control.BorderSpacing.Left:=0; - Control.BorderSpacing.Top:=TitleHeight; - end; - end else begin - Control.BorderSpacing.Left:=0; - Control.BorderSpacing.Top:=0; - end; -end; - -constructor TCustomAnchoredDockManager.Create(ADockSite: TWinControl); -begin - inherited Create(ADockSite); - FOwnerComponent:=TLazDockOwnerComponent.Create(nil); - FSplitterSize:=5; - FTitleWidth:=20; - FTitleHeight:=20; -end; - -destructor TCustomAnchoredDockManager.Destroy; -begin - FreeAndNil(FOwnerComponent); - inherited Destroy; -end; - -procedure TCustomAnchoredDockManager.BeginUpdate; -begin - inc(FUpdateCount); -end; - -procedure TCustomAnchoredDockManager.EndUpdate; -begin - if FUpdateCount<=0 then - RaiseGDBException('TCustomAnchoredDockManager.EndUpdate'); - dec(FUpdateCount); - if FUpdateCount=0 then begin - - end; -end; - -procedure TCustomAnchoredDockManager.GetControlBounds(Control: TControl; - out AControlBounds: TRect); -begin - AControlBounds:=Control.BoundsRect; -end; - -procedure TCustomAnchoredDockManager.DisableLayout(Control: TControl); -begin - -end; - -procedure TCustomAnchoredDockManager.EnableLayout(Control: TControl); -begin - -end; - -{------------------------------------------------------------------------------- - procedure TCustomAnchoredDockManager.DockControl(Control: TControl; - InsertAt: TAlign; DropCtl: TControl); - - Docks Control to or into DropCtl. - Control.Parent must be nil. - - If InsertAt in [alLeft,alTop,alRight,alBottom] then Control will be docked to - the side of DropCtl. - Otherwise it is docked as Page to a TLazDockPages. - - Docking to a side: - If DockCtl.Parent=nil then a parent will be created via - DropCtl.ManualFloat. - Then Control is added as child to DockCtl.Parent. - Then a Splitter is added. - Then all three are anchored. - - Docking as page: - if DropCtl.Parent is not a TLazDockPage then a new TLazDockPages is created - and replaces DropCtl and DropCtl is added as page. - Then Control is added as page. --------------------------------------------------------------------------------} -procedure TCustomAnchoredDockManager.DockControl(Control: TControl; - InsertAt: TAlign; DropCtl: TControl); -var - Splitter: TLazDockSplitter; - NewDropCtlBounds: TRect; - NewControlBounds: TRect; - NewDropCtlWidth: Integer; - SplitterBounds: TRect; - a: TAnchorKind; - ControlAnchor: TAnchorKind; - DropCtlAnchor: TAnchorKind; - NewDropCtlHeight: Integer; - SplitterWidth: LongInt; - SplitterHeight: LongInt; - DockPages: TLazDockPages; - DropCtlPage: TLazDockPage; - NewPageIndex: Integer; - NewPage: TLazDockPage; - NewParent: TLazDockForm; - ParentDisabledAlign: Boolean; - DropCtlTitlePos: TAnchorKind; -begin - if Control.Parent<>nil then - RaiseGDBException('TCustomAnchoredDockManager.InsertControl Control.Parent<>nil'); - if Control=DropCtl then - RaiseGDBException('TCustomAnchoredDockManager.InsertControl Control=DropCtl'); - DisableLayout(Control); - DisableLayout(DropCtl); - try - - // dock Control to DropCtl - case InsertAt of - alLeft,alTop,alRight,alBottom: - begin - // dock Control to a side of DropCtl - // e.g. alLeft: insert Control to the left of DropCtl - - DropCtlAnchor:=MainAlignAnchor[InsertAt]; - ControlAnchor:=OppositeAnchor[DropCtlAnchor]; - - DropCtlTitlePos:=GetPreferredTitlePosition(DropCtl.ClientWidth, - DropCtl.ClientHeight); - - ParentDisabledAlign := False; - try - NewDropCtlBounds:=DropCtl.BoundsRect; - if DropCtlTitlePos=akLeft then - inc(NewDropCtlBounds.Right,TitleWidth) - else - inc(NewDropCtlBounds.Bottom,TitleHeight); - - // make sure, there is a parent HostSite - if DropCtl.Parent=nil then begin - // remember bounds - NewDropCtlBounds:=Rect(0,0,DropCtl.ClientWidth,DropCtl.ClientHeight); - // create a TLazDockForm as new parent with the size of DropCtl - NewParent := CreateForm;// starts with Visible=false - NewParent.DisableAlign; - ParentDisabledAlign := True; - NewParent.BoundsRect:=DropCtl.BoundsRect; - // move the WindowState to the new parent - if DropCtl is TCustomForm then - begin - NewParent.WindowState:=TCustomForm(DropCtl).WindowState; - TCustomForm(DropCtl).WindowState:=wsNormal; - end; - // first move DropCtl to the invsible parent, so changes do not cause flicker - DropCtl.Dock(NewParent, Rect(0, 0, 0, 0)); - // init anchors of DropCtl - DropCtl.Align:=alNone; - DropCtl.AnchorClient(0); - DropCtl.Anchors:=[akLeft,akTop,akRight,akBottom]; - DropCtl.Visible:=true; - NewParent.Visible:=true; - //DebugLn('TCustomAnchoredDockManager.DockControl DropCtl=',DbgSName(DropCtl),' NewParent.BoundsRect=',dbgs(NewParent.BoundsRect)); - end else begin - if (DropCtl.Parent is TLazDockForm) then begin - // ok - end else if (DropCtl.Parent is TLazDockPage) then begin - // ok - end else begin - RaiseGDBException('TCustomAnchoredDockManager.InsertControl DropCtl has invalid parent'); - end; - end; - - if not ParentDisabledAlign then - begin - DropCtl.Parent.DisableAlign; - ParentDisabledAlign := True; - end; - // create a splitter - Splitter := TLazDockSplitter.Create(Control); - Splitter.Align:=alNone; - Splitter.Beveled:=true; - Splitter.ResizeAnchor:=ControlAnchor; - //debugln('TCustomAnchoredDockManager.InsertControl A Control.Bounds=',DbgSName(Control),dbgs(Control.BoundsRect),' DropCtl.Bounds=',DbgSName(DropCtl),dbgs(DropCtl.BoundsRect),' Splitter.Bounds=',DbgSName(Splitter),dbgs(Splitter.BoundsRect)); - - // calculate new bounds - NewControlBounds := NewDropCtlBounds; - if InsertAt in [alLeft,alRight] then begin - SplitterWidth:=Splitter.Constraints.MinMaxWidth(SplitterSize); - NewDropCtlWidth:=NewDropCtlBounds.Right-NewDropCtlBounds.Left; - dec(NewDropCtlWidth,Control.Width+SplitterWidth); - NewDropCtlWidth:=DropCtl.Constraints.MinMaxWidth(NewDropCtlWidth); - if InsertAt=alLeft then begin - // alLeft: insert Control to the left of DropCtl - NewDropCtlBounds.Left:=NewDropCtlBounds.Right-NewDropCtlWidth; - NewControlBounds.Right:=NewDropCtlBounds.Left-SplitterWidth; - SplitterBounds:=Rect(NewControlBounds.Right,NewDropCtlBounds.Top, - NewDropCtlBounds.Left,NewDropCtlBounds.Bottom); - end else begin - // alRight: insert Control to the right of DropCtl - NewDropCtlBounds.Right:=NewDropCtlBounds.Left+NewDropCtlWidth; - NewControlBounds.Left:=NewDropCtlBounds.Right+SplitterWidth; - SplitterBounds:=Rect(NewDropCtlBounds.Right,NewDropCtlBounds.Top, - NewControlBounds.Left,NewDropCtlBounds.Bottom); - //debugln('TCustomAnchoredDockManager.InsertControl A NewDropCtlBounds=',dbgs(NewDropCtlBounds),' NewControlBounds=',dbgs(NewControlBounds),' SplitterBounds=',dbgs(SplitterBounds)); - end; - end else begin - SplitterHeight:=Splitter.Constraints.MinMaxHeight(SplitterSize); - NewDropCtlHeight:=NewDropCtlBounds.Bottom-NewDropCtlBounds.Top; - dec(NewDropCtlHeight,Control.Height+SplitterHeight); - NewDropCtlHeight:=DropCtl.Constraints.MinMaxHeight(NewDropCtlHeight); - if InsertAt=alTop then begin - // alTop: insert Control to the top of DropCtl - NewDropCtlBounds.Top:=NewDropCtlBounds.Bottom-NewDropCtlHeight; - NewControlBounds.Bottom:=NewDropCtlBounds.Top-SplitterHeight; - SplitterBounds:=Rect(NewDropCtlBounds.Left,NewControlBounds.Bottom, - NewDropCtlBounds.Right,NewDropCtlBounds.Top); - end else begin - // alBottom: insert Control to the bottom of DropCtl - NewDropCtlBounds.Bottom:=NewDropCtlBounds.Top+NewDropCtlHeight; - NewControlBounds.Top:=NewDropCtlBounds.Bottom+SplitterHeight; - SplitterBounds:=Rect(NewDropCtlBounds.Left,NewDropCtlBounds.Bottom, - NewDropCtlBounds.Right,NewControlBounds.Top); - end; - //debugln('TCustomAnchoredDockManager.InsertControl A NewDropCtlBounds=',dbgs(NewDropCtlBounds),' NewControlBounds=',dbgs(NewControlBounds),' SplitterBounds=',dbgs(SplitterBounds)); - end; - - // position splitter - Splitter.BoundsRect:=SplitterBounds; - if InsertAt in [alLeft,alRight] then begin - Splitter.AnchorSide[akTop].Assign(DropCtl.AnchorSide[akTop]); - Splitter.AnchorSide[akBottom].Assign(DropCtl.AnchorSide[akBottom]); - Splitter.Anchors:=[akLeft,akTop,akBottom]; - end else begin - Splitter.AnchorSide[akLeft].Assign(DropCtl.AnchorSide[akLeft]); - Splitter.AnchorSide[akRight].Assign(DropCtl.AnchorSide[akRight]); - Splitter.Anchors:=[akLeft,akTop,akRight]; - end; - Splitter.Parent := DropCtl.Parent; - - // position Control - Control.Align := alNone; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - Control.AnchorSide[a].Control:=nil; - Control.BorderSpacing.Space[a]:=0; - end; - Control.AnchorSide[DropCtlAnchor].Assign(DropCtl.AnchorSide[DropCtlAnchor]); - Control.AnchorToNeighbour(ControlAnchor,0,Splitter); - if InsertAt in [alLeft,alRight] then begin - Control.AnchorSide[akTop].Assign(DropCtl.AnchorSide[akTop]); - Control.AnchorSide[akBottom].Assign(DropCtl.AnchorSide[akBottom]); - end else begin - Control.AnchorSide[akLeft].Assign(DropCtl.AnchorSide[akLeft]); - Control.AnchorSide[akRight].Assign(DropCtl.AnchorSide[akRight]); - end; - Control.Anchors := [akLeft,akTop,akRight,akBottom]; - Control.Dock(DropCtl.Parent, Rect(0, 0, 0, 0)); - Control.Visible := true; - - // position DropCtl - DropCtl.AnchorToNeighbour(DropCtlAnchor,0,Splitter); - - // set titles - UpdateTitlePosition(DropCtl); - UpdateTitlePosition(Control); - - //debugln('TCustomAnchoredDockManager.InsertControl BEFORE ALIGNING Control.Bounds=',DbgSName(Control),dbgs(Control.BoundsRect),' DropCtl.Bounds=',DbgSName(DropCtl),dbgs(DropCtl.BoundsRect),' Splitter.Bounds=',DbgSName(Splitter),dbgs(Splitter.BoundsRect)); - finally - // in case of Exception inside try-finally Parent can be nil - if ParentDisabledAlign and (DropCtl.Parent <> nil) then - DropCtl.Parent.EnableAlign; - end; - //debugln('TCustomAnchoredDockManager.InsertControl END Control.Bounds=',DbgSName(Control),dbgs(Control.BoundsRect),' DropCtl.Bounds=',DbgSName(DropCtl),dbgs(DropCtl.BoundsRect),' Splitter.Bounds=',DbgSName(Splitter),dbgs(Splitter.BoundsRect)); - end; - - alClient: - begin - // docking as page - DebugLn('TCustomAnchoredDockManager.InsertControl alClient DropCtl=',DbgSName(DropCtl),' Control=',DbgSName(Control)); - - if not (DropCtl.Parent is TLazDockPage) then begin - // create a new TLazDockPages - //DebugLn('TCustomAnchoredDockManager.InsertControl Create TLazDockPages'); - DockPages:=TLazDockPages.Create(nil); - if DropCtl.Parent<>nil then begin - // DockCtl is a child control - // => replace the anchors to and from DockCtl with the new DockPages - ReplaceAnchoredControl(DropCtl,DockPages); - end else begin - // DockCtl has no parent - // => float DockPages - DockPages.ManualFloat(DropCtl.BoundsRect); - DockPages.AnchorClient(0); - end; - // add DockCtl as page to DockPages - DockPages.Pages.Add(DropCtl.Caption); - DropCtlPage:=DockPages.Page[0]; - DropCtlPage.DisableAlign; - try - DropCtl.Dock(DropCtlPage, Rect(0,0,0,0)); - DropCtl.AnchorClient(0); - finally - DropCtlPage.EnableAlign; - end; - end; - // add Control as new page behind the page of DockCtl - DropCtlPage:=DropCtl.Parent as TLazDockPage; - DockPages:=DropCtlPage.PageControl as TLazDockPages; - NewPageIndex:=DropCtlPage.PageIndex+1; - DockPages.Pages.Insert(NewPageIndex,Control.Caption); - NewPage:=DockPages.Page[NewPageIndex]; - DebugLn(['TCustomAnchoredDockManager.DockControl NewPage=',NewPage.Caption,' Control=',Control.Caption,',',DbgSName(Control)]); - NewPage.DisableAlign; - try - if DropCtl is TCustomForm then - TCustomForm(DropCtl).WindowState:=wsNormal; - Control.Dock(NewPage, Rect(0, 0, 0, 0)); - Control.AnchorClient(0); - finally - NewPage.EnableAlign; - end; - end; - else - RaiseGDBException('TCustomAnchoredDockManager.InsertControl TODO'); - end; - finally - EnableLayout(Control); - EnableLayout(DropCtl); - end; -end; - -{------------------------------------------------------------------------------- - procedure TCustomAnchoredDockManager.UndockControl(Control: TControl); - - Removes a control from a docking form. - It breaks all anchors and cleans up. - - The created gap will be tried to fill up. - It removes TLazDockSplitter, TLazDockPage and TLazDockPages if they are no - longer needed. --------------------------------------------------------------------------------} -procedure TCustomAnchoredDockManager.UndockControl(Control: TControl; Float: boolean); -{ - - Examples: - - Search Order: - - 1. A TLazDockSplitter dividing only two controls: - - Before: - |------------- - | +--+ | +--- - | | | | | B - | +--+ | +--- - |------------- - - The splitter will be deleted and the right control will be anchored to the - left. - - After: - |------------- - | +--- - | | B - | +--- - |------------- - - - 2. Four spiral splitters: - - Before: - | - A | - ---------| - | +--+ | C - B | | | | - | +--+ | - | ---------- - | D - - The left and right splitter will be combined to one. - - After: - | - A | - -------| - | C - B | - | - |------ - | D - - - 3. No TLazDockSplitter. Control is the only child of a TLazDockPage - In this case the page will be deleted. - If the TLazDockPages has no children left, it is recursively undocked. - - 4. No TLazDockSplitter, Control is the only child of a TLazDockForm. - The TLazDockForm is deleted and the Control is floated. - This normally means: A form will simply be placed on the desktop, other - controls will be docked into their DockSite. - - 5. Otherwise: this control was not docked. -} -var - AnchorControl: TControl; - AnchorSplitter: TLazDockSplitter; - i: Integer; - Sibling: TControl; - OldAnchorControls: array[TAnchorKind] of TControl; - IsSpiralSplitter: Boolean; - ParentControl: TWinControl; - Done: Boolean; - - procedure DoFinallyForParent; - var - OldParentControl: TWinControl; - NewBounds: TRect; - NewOrigin: TPoint; - OtherControl: TControl; - a: TAnchorKind; - begin - try - NewBounds:=Control.BoundsRect; - NewOrigin:=Control.ControlOrigin; - OffsetRect(NewBounds,NewOrigin.X,NewOrigin.Y); - if Float then begin - Control.ManualFloat(NewBounds); - if Control.Parent<>nil then - Control.AnchorClient(0); - end else if Control.Parent<>nil then begin - Control.Anchors:=[akLeft,akTop]; - for a:=Low(TAnchorKind) to High(TAnchorKind) do - Control.AnchorSide[a].Control:=nil; - Control.BoundsRect:=NewBounds; - Control.Parent:=nil; - end; - finally - if (ParentControl<>nil) then begin - OldParentControl:=ParentControl; - ParentControl:=nil; - DebugLn(['DoFinallyForParent EnableAlign for ',DbgSName(OldParentControl),' Control=',DbgSName(Control),' OldParentControl.ControlCount=',OldParentControl.ControlCount]); - OldParentControl.EnableAlign; - - // check if the remaining is a TLazDockForm with only one child - if (OldParentControl is TLazDockForm) - and (OldParentControl.ControlCount=1) then - begin - OtherControl:=OldParentControl.Controls[0]; - DebugLn(['DoFinallyForParent OtherControl=',DbgSName(OtherControl)]); - if (OtherControl is TWinControl) - and (TWinControl(OtherControl).UseDockManager) - and (TWinControl(OtherControl).DockManager=Self) - then begin - UndockControl(OtherControl,true); - end; - end; - - //OldParentControl.WriteLayoutDebugReport('X '); - end; - end; - end; - -var - OldParentPage: TLazDockPage; - OldParentForm: TLazDockForm; - a: TAnchorKind; -begin - if Control.Parent=nil then begin - // already undocked - RaiseGDBException('TCustomAnchoredDockManager.UndockControl Control.Parent=nil'); - end; - - ParentControl:=Control.Parent; - ParentControl.DisableAlign; - try - // break anchors - Control.Align:=alNone; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - OldAnchorControls[a]:=Control.AnchorSide[a].Control; - Control.AnchorSide[a].Control:=nil; - end; - Control.Anchors:=[akLeft,akTop]; - - Done:=false; - - if not Done then begin - // check if there is a splitter, that has a side with only 'Control' - // anchored to it. - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - AnchorControl:=OldAnchorControls[a]; - if AnchorControl is TLazDockSplitter then begin - AnchorSplitter:=TLazDockSplitter(AnchorControl); - i:=ParentControl.ControlCount-1; - while i>=0 do begin - Sibling:=ParentControl.Controls[i]; - if (Sibling.AnchorSide[a].Control=AnchorSplitter) then begin - // Sibling is anchored with the same side to the splitter - // => this splitter is needed, can not be deleted. - //DebugLn('TCustomAnchoredDockManager.UndockControl Splitter still needed: ',DbgSName(AnchorSplitter),'(',dbgs(AnchorSplitter.BoundsRect),') by ',DbgSName(Sibling)); - break; - end; - dec(i); - end; - if i<0 then begin - // this splitter is not needed anymore - //DebugLn('TCustomAnchoredDockManager.UndockControl Splitter not needed: ',DbgSName(AnchorSplitter),'(',dbgs(AnchorSplitter.BoundsRect),')'); - DeleteSideSplitter(AnchorSplitter,OppositeAnchor[a], - OldAnchorControls[OppositeAnchor[a]]); - //update caption - if (ParentControl is TLazDockPage) and (TLazDockPage(ParentControl).ControlCount > 1) and - (TLazDockPage(ParentControl).Controls[0] = Control) then - TLazDockPage(ParentControl).Caption := TLazDockPage(ParentControl).Controls[1].Caption; - Done:=true; - end; - end; - end; - end; - - if not Done then begin - // check if there are four spiral splitters around Control - IsSpiralSplitter:=true; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - AnchorControl:=OldAnchorControls[a]; - if (AnchorControl=nil) - or (not (AnchorControl is TLazDockSplitter)) then begin - IsSpiralSplitter:=false; - end; - end; - if IsSpiralSplitter then begin - CombineSpiralSplitterPair(OldAnchorControls[akLeft] as TLazDockSplitter, - OldAnchorControls[akRight] as TLazDockSplitter); - Done:=true; - end; - end; - - if not Done then begin - // check if Control is the only child of a TLazDockPage - if (ParentControl.ControlCount=1) - and (ParentControl is TLazDockPage) then begin - OldParentPage:=TLazDockPage(ParentControl); - DoFinallyForParent; - DeletePage(OldParentPage); - Done:=true; - end; - end; - - if not Done then begin - // check if Control is the only child of a TLazDockForm - if (ParentControl.ControlCount=1) - and (ParentControl is TLazDockForm) then begin - OldParentForm:=TLazDockForm(ParentControl); - DoFinallyForParent; - DeleteDockForm(OldParentForm); - Done:=true; - end; - end; - - if not Done then begin - // otherwise: keep - end; - - finally - DoFinallyForParent; - end; -end; - -procedure TCustomAnchoredDockManager.InsertControl(Control: TControl; - InsertAt: TAlign; DropCtl: TControl); -begin - DockControl(Control, InsertAt, DropCtl); -end; - -function TCustomAnchoredDockManager.EnlargeControl(Control: TControl; - Side: TAnchorKind; Simulate: boolean): boolean; -{ If Simulate=true then it will only test if control can be enlarged. - - Case A: - Shrink one neighbour control, enlarge Control. Two splitters are resized. - - |#| |# |#| |# - |#| Control |# |#| |# - --+#+---------+# --> --+#| Control |# - ===============# ===#| |# - --------------+# --+#| |# - A |# A|#| |# - --------------+# --+#+---------+# - ================== =================== - - - Case B: - Move one neighbour splitter, enlarge Control, resize one splitter, - rotate the other splitter. - - |#| |#| |#| |#| - |#| Control |#| |#| |#| - --+#+---------+#+-- --> --+#| Control |#+-- - =================== ===#| |#=== - --------+#+-------- --+#| |#+-- - |#| B |#| |#|B - |#+-------- |#| |#+-- - A |#========= A|#| |#=== - |#+-------- |#| |#+-- - |#| C |#| |#|C - --------+#+-------- --+#+---------+#+-- - =================== =================== -} -const - MinControlSize = 20; -var - MainSplitter: TLazDockSplitter; - Side2: TAnchorKind; - Side3: TAnchorKind; - Side2Anchor: TControl; - Side3Anchor: TControl; - Parent: TWinControl; - i: Integer; - Sibling: TControl; - CurSplitter: TLazDockSplitter; - Neighbour: TControl; - ShrinkSide: TAnchorKind; - ParentDisabledAlign: Boolean; - EnlargeSplitter: TLazDockSplitter; - RotateSplitter: TLazDockSplitter; - - procedure ParentDisableAlign; - begin - if ParentDisabledAlign then exit; - ParentDisabledAlign:=true; - Parent.DisableAlign; - end; - -begin - Result:=false; - if Control=nil then exit; - DebugLn(['TCustomAnchoredDockManager.EnlargeControl Control=',DbgSName(Control), - ' Side=',DbgS(Side)]); - if Side in [akLeft,akRight] then - Side2:=akTop - else - Side2:=akLeft; - Side3:=OppositeAnchor[Side2]; - if not GetLazDockSplitter(Control,Side,MainSplitter) then exit; - if not GetLazDockSplitterOrParent(Control,Side2,Side2Anchor) then exit; - if not GetLazDockSplitterOrParent(Control,Side3,Side3Anchor) then exit; - Parent:=Control.Parent; - if (Side2Anchor=Parent) and (Side3Anchor=Parent) then exit; - - // search controls anchored to the MainSplitter on the other side - Neighbour:=nil; - for i:=0 to Parent.ControlCount-1 do begin - Sibling:=Parent.Controls[i]; - if (not GetLazDockSplitter(Sibling,OppositeAnchor[Side],CurSplitter)) - or (CurSplitter<>MainSplitter) then continue; - DebugLn(['TCustomAnchoredDockManager.EnlargeControl neighbour Sibling=',DbgSName(Sibling)]); - // Sibling is anchored to MainSplitter on the other side - // check if it is at the same height as Control - if Side in [akTop,akBottom] then begin - if (Side2Anchor is TLazDockSplitter) then begin - if (Sibling.Left+Sibling.WidthSide3Anchor.Left+Side3Anchor.Width) then continue; - end else begin - // Side3Anchor is Parent - if Sibling.Left>Control.Left+Control.Width then continue; - end; - end else begin - if (Side2Anchor is TLazDockSplitter) then begin - if (Sibling.Top+Sibling.HeightSide3Anchor.Top+Side3Anchor.Height) then continue; - end else begin - // Side3Anchor is Parent - if Sibling.Top>Control.Top+Control.Height then continue; - end; - end; - - if Neighbour=nil then - Neighbour:=Sibling - else if Sibling is TLazDockSplitter then begin - if Neighbour is TLazDockSplitter then begin - // two splitters means, there is at least one Neighbour which can not - // be shrinked - exit; - end; - Neighbour:=Sibling; - end; - end; - - if Neighbour=nil then exit; // no neighbour found - DebugLn(['TCustomAnchoredDockManager.EnlargeControl Neighbour=',DbgSName(Neighbour)]); - - ParentDisabledAlign:=false; - try - if Neighbour is TLazDockSplitter then begin - // one splitter as Neighbour - RotateSplitter:=TLazDockSplitter(Neighbour); - DebugLn(['TCustomAnchoredDockManager.EnlargeControl rotate splitter RotateSplitter=',DbgSName(RotateSplitter)]); - // check that all anchored controls of this splitter can be shrinked - for i:=0 to Parent.ControlCount-1 do begin - Sibling:=Parent.Controls[i]; - if Sibling=RotateSplitter then continue; - if GetLazDockSplitter(Sibling,Side2,CurSplitter) - and (CurSplitter=RotateSplitter) - and (not NeighbourCanBeShrinked(Control,Sibling,Side2)) - then begin - // this Sibling is anchored with Side2 at RotateSplitter - // but can not be shrinked - exit; - end; - if GetLazDockSplitter(Sibling,Side3,CurSplitter) - and (CurSplitter=RotateSplitter) - and (not NeighbourCanBeShrinked(Control,Sibling,Side3)) - then begin - // this Sibling is anchored with Side3 at RotateSplitter - // but can not be shrinked - exit; - end; - end; - - { |#| |#| |#| |#| - |#| Control |#| |#| |#| - --+#+---------+#+-- --> --+#| Control |#+-- - =================== ===#| |#=== - --------+#+-------- --+#| |#+-- - |#| B |#| |#|B - |#+-------- |#| |#+-- - A |#========= A|#| |#=== - |#+-------- |#| |#+-- - |#| C |#| |#|C - --------+#+-------- --+#+---------+#+-- - =================== =================== } - - Result:=true; - if not Simulate then begin - ParentDisableAlign; - GetLazDockSplitter(Control,OppositeAnchor[Side2],EnlargeSplitter); - // enlarge Control and its two side splitters - Control.AnchorSame(Side,RotateSplitter); - Side2Anchor.AnchorSame(Side,RotateSplitter); - Side3Anchor.AnchorSame(Side,RotateSplitter); - // shrink controls anchored to RotateSplitter - for i:=0 to Parent.ControlCount-1 do begin - Sibling:=Parent.Controls[i]; - if Sibling=RotateSplitter then continue; - if GetLazDockSplitter(Sibling,Side2,CurSplitter) - and (CurSplitter=RotateSplitter) then begin - // this Sibling is anchored with Side2 at RotateSplitter - Sibling.AnchorToNeighbour(Side2,0,Side3Anchor); - end; - if GetLazDockSplitter(Sibling,Side3,CurSplitter) - and (CurSplitter=RotateSplitter) then begin - // this Sibling is anchored with Side3 at RotateSplitter - Sibling.AnchorToNeighbour(Side3,0,Side2Anchor); - end; - end; - // rotate RotateSplitter - RotateSplitter.AnchorSide[Side].Control:=nil; - RotateSplitter.AnchorSide[OppositeAnchor[Side]].Control:=nil; - RotateSplitter.ResizeAnchor:=Side; - RotateSplitter.AnchorToNeighbour(Side2,0,Side3Anchor); - RotateSplitter.AnchorSame(Side3,MainSplitter); - if Side in [akLeft,akRight] then - RotateSplitter.Anchors:=RotateSplitter.Anchors-[akRight]+[akLeft] - else - RotateSplitter.Anchors:=RotateSplitter.Anchors-[akBottom]+[akTop]; - // shrink MainSplitter - MainSplitter.AnchorToNeighbour(Side2,0,Side2Anchor); - // reanchor controls from MainSplitter to RotateSplitter - for i:=0 to Parent.ControlCount-1 do begin - Sibling:=Parent.Controls[i]; - if GetLazDockSplitter(Sibling,Side,CurSplitter) - and (CurSplitter=MainSplitter) then begin - if Side in [akLeft,akRight] then begin - if Sibling.Top>Control.Top then - Sibling.AnchorSide[Side].Control:=RotateSplitter; - end else begin - if Sibling.Left>Control.Left then - Sibling.AnchorSide[Side].Control:=RotateSplitter; - end; - end; - end; - UpdateTitlePosition(Control); - end; - - end else begin - // shrink a neighbour control - DebugLn(['TCustomAnchoredDockManager.EnlargeControl Shrink one control: Neighbour=',DbgSName(Neighbour)]); - // check if Neighbour already shares a side with Control - if (Neighbour.AnchorSide[Side2].Control<>Side2Anchor) - and (Neighbour.AnchorSide[Side3].Control<>Side3Anchor) then begin - { Neighbour is too broad. - |#| |#| - |#| Control |#| - --+#+---------+#+-- - =================== - ------------------- - Neighbour - ------------------- } - exit; - end; - - // check if the Neighbour can be shrinked - if NeighbourCanBeShrinked(Control,Neighbour,Side2) then begin - ShrinkSide:=Side2; - end else if NeighbourCanBeShrinked(Control,Neighbour,Side3) then begin - ShrinkSide:=Side3; - end else begin - // Neighbour can not be shrinked - exit; - end; - - - { EnlargeSplitter - ^ - |#| |# |#| |# - |#| Control |# |#| |# - --+#+---------+# --> --+#| Control |# - MainSplitter <-- ===============# ===#| |# - --------------+# --+#| |# - Neighbour|# N|#| |# - --------------+# --+#+---------+# - ================== =================== } - Result:=true; - if not Simulate then begin - ParentDisableAlign; - GetLazDockSplitter(Control,OppositeAnchor[ShrinkSide],EnlargeSplitter); - Neighbour.AnchorToNeighbour(ShrinkSide,0,EnlargeSplitter); - MainSplitter.AnchorToNeighbour(ShrinkSide,0,EnlargeSplitter); - EnlargeSplitter.AnchorSame(Side,Neighbour); - Control.AnchorSame(Side,Neighbour); - UpdateTitlePosition(Control); - UpdateTitlePosition(Neighbour); - end; - end; - finally - if ParentDisabledAlign then - Parent.EnableAlign; - end; -end; - -procedure TCustomAnchoredDockManager.LoadFromStream(Stream: TStream); -begin - RaiseGDBException('TCustomAnchoredDockManager.LoadFromStream TODO'); -end; - -procedure TCustomAnchoredDockManager.PaintSite(DC: HDC); -begin - // drawing of titles is done by TLazDockForm -end; - -procedure TCustomAnchoredDockManager.PositionDockRect(Client, DropCtl: TControl; - DropAlign: TAlign; var DockRect: TRect); -begin - RaiseGDBException('TCustomAnchoredDockManager.PositionDockRect TODO'); -end; - -procedure TCustomAnchoredDockManager.RemoveControl(Control: TControl); -begin - UndockControl(Control,false); -end; - -procedure TCustomAnchoredDockManager.ResetBounds(Force: Boolean); -begin - // TODO: 'TCustomAnchoredDockManager.ResetBounds' -end; - -procedure TCustomAnchoredDockManager.SaveToStream(Stream: TStream); -begin - RaiseGDBException('TCustomAnchoredDockManager.SaveToStream TODO'); -end; - -function TCustomAnchoredDockManager.AutoFreeByControl: Boolean; -begin - Result:=false; -end; - -procedure TCustomAnchoredDockManager.SetReplacingControl(Control: TControl); -begin - RaiseGDBException('TCustomAnchoredDockManager.SetReplacingControl TODO'); -end; - -procedure TCustomAnchoredDockManager.MessageHandler(Sender: TControl; var Message: TLMessage); -begin - -end; - -function TCustomAnchoredDockManager.CreateForm: TLazDockForm; -begin - Result:=TLazDockForm.Create(FOwnerComponent); - Result.DockManager:=Self; - Result.UseDockManager:=true; -end; - -procedure TCustomAnchoredDockManager.ReplaceAnchoredControl(OldControl, - NewControl: TControl); -var - a: TAnchorKind; - Side: TAnchorSide; - i: Integer; - Sibling: TControl; - CurParent: TWinControl; -begin - if OldControl.Parent<>nil then begin - CurParent:=OldControl.Parent; - CurParent.DisableAlign; - try - // put NewControl on the same Parent with the same bounds - NewControl.Parent:=nil; - NewControl.Align:=alNone; - NewControl.BoundsRect:=OldControl.BoundsRect; - NewControl.Parent:=CurParent; - // copy all four AnchorSide - for a:=Low(TAnchorKind) to High(TAnchorKind) do - NewControl.AnchorSide[a].Assign(OldControl.AnchorSide[a]); - // bend all Anchors from OldControl to NewControl - for i:=0 to CurParent.ControlCount-1 do begin - Sibling:=CurParent.Controls[i]; - if (Sibling=NewControl) or (Sibling=OldControl) then continue; - for a:=Low(TAnchorKind) to High(TAnchorKind) do begin - Side:=Sibling.AnchorSide[a]; - if Side.Control=OldControl then begin - Side.Control:=NewControl; - end; - end; - end; - // remove OldControl from its Parent - OldControl.Parent:=nil; - finally - CurParent.EnableAlign; - end; - end else begin - NewControl.Parent:=nil; - NewControl.Align:=alNone; - NewControl.BoundsRect:=OldControl.BoundsRect; - end; -end; - -function TCustomAnchoredDockManager.GetSplitterWidth(Splitter: TControl): integer; -begin - Result:=Splitter.Constraints.MinMaxWidth(SplitterSize); -end; - -function TCustomAnchoredDockManager.GetSplitterHeight(Splitter: TControl): integer; -begin - Result:=Splitter.Constraints.MinMaxHeight(SplitterSize); -end; - -{ TLazDockPage } - -function TLazDockPage.GetPageControl: TLazDockPages; -begin - Result:=Parent as TLazDockPages; -end; - -procedure TLazDockPage.InsertControl(AControl: TControl; Index: integer); -begin - inherited InsertControl(AControl, Index); - TLazDockForm.UpdateMainControlInParents(Self); -end; - -{ TLazDockForm } - -procedure TLazDockForm.SetMainControl(const AValue: TControl); -var - NewValue: TControl; -begin - if (AValue<>nil) and (not IsParentOf(AValue)) then - raise Exception.Create('invalid main control'); - NewValue:=AValue; - if NewValue=nil then - NewValue:=FindMainControlCandidate; - if FMainControl=NewValue then exit; - FMainControl:=NewValue; - if FMainControl<>nil then - FMainControl.FreeNotification(Self); - UpdateCaption; -end; - -procedure TLazDockForm.PaintWindow(DC: HDC); -var - i: Integer; - Control: TControl; - ACanvas: TCanvas; - Pt: TPoint; -begin - inherited PaintWindow(DC); - ACanvas:=nil; - try - for i := 0 to ControlCount-1 do - begin - Control := Controls[i]; - if not ControlHasTitle(Control) then - continue; - - if ACanvas = nil then - begin - ACanvas := TCanvas.Create; - ACanvas.Handle := DC; - end; - GetCursorPos(Pt); - Pt := ScreenToClient(Pt); - TDockHeader.Draw(ACanvas, Control.Caption, FDockHeaderImages, - GetTitleOrientation(Control), GetTitleRect(Control), Pt); - end; - finally - ACanvas.Free; - end; -end; - -procedure TLazDockForm.Notification(AComponent: TComponent; - Operation: TOperation); -begin - if (Operation=opRemove) then begin - if AComponent=FMainControl then - MainControl:=nil; - end; - inherited Notification(AComponent, Operation); -end; - -procedure TLazDockForm.InsertControl(AControl: TControl; Index: integer); -begin - inherited InsertControl(AControl, Index); - UpdateMainControl; -end; - -procedure TLazDockForm.UpdateMainControl; -var - NewMainControl: TControl; -begin - if (FMainControl=nil) or (not FMainControl.IsVisible) then begin - NewMainControl:=FindMainControlCandidate; - if NewMainControl<>nil then - MainControl:=NewMainControl; - end; -end; - -function TLazDockForm.CloseQuery: boolean; -// query all top level forms, if form can close - - function QueryForms(ParentControl: TWinControl): boolean; - var - i: Integer; - AControl: TControl; - begin - for i:=0 to ParentControl.ControlCount-1 do begin - AControl:=ParentControl.Controls[i]; - if (AControl is TWinControl) then begin - if (AControl is TCustomForm) then begin - // a top level form: query and do not ask children - if (not TCustomForm(AControl).CloseQuery) then - exit(false); - end - else if not QueryForms(TWinControl(AControl)) then - // search children for forms - exit(false); - end; - end; - Result:=true; - end; - -begin - Result:=inherited CloseQuery; - if Result then - Result:=QueryForms(Self); -end; - -procedure TLazDockForm.MouseUp(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); -var - Part: TLazDockHeaderPart; - Control: TControl; -begin - inherited MouseUp(Button, Shift, X, Y); - TrackMouse(X, Y); - if Button = mbLeft then - begin - Control := FindHeader(X, Y, Part); - if (Control <> nil) then - TDockHeader.PerformMouseUp(Control, Part); - end; -end; - -procedure TLazDockForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); -var - Part: TLazDockHeaderPart; - Control: TControl; -begin - inherited MouseDown(Button, Shift, X, Y); - TrackMouse(X, Y); - if Button = mbLeft then - begin - Control := FindHeader(X, Y, Part); - if (Control <> nil) then - TDockHeader.PerformMouseDown(Control, Part); - end; -end; - -procedure TLazDockForm.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - inherited MouseMove(Shift, X, Y); - TrackMouse(X, Y); -end; - -procedure TLazDockForm.MouseLeave; -begin - inherited MouseLeave; - TrackMouse(-1, -1); -end; - -procedure TLazDockForm.TrackMouse(X, Y: Integer); -var - Control: TControl; - Part: TLazDockHeaderPart; - ARect: TRect; - NewMouseState: TDockHeaderMouseState; -begin - Control := FindHeader(X, Y, Part); - FillChar(NewMouseState,SizeOf(NewMouseState),0); - if (Control <> nil) then - begin - ARect := GetTitleRect(Control); - ARect := TDockHeader.GetRectOfPart(ARect, GetTitleOrientation(Control), Part); - NewMouseState.Rect := ARect; - NewMouseState.IsMouseDown := (GetKeyState(VK_LBUTTON) and $80) <> 0; - end; - if not CompareMem(@FMouseState, @NewMouseState, SizeOf(NewMouseState)) then - begin - if not CompareRect(@FMouseState.Rect, @NewMouseState.Rect) then - InvalidateRect(Handle, @FMouseState.Rect, False); - FMouseState := NewMouseState; - InvalidateRect(Handle, @NewMouseState.Rect, False); - end; -end; - -constructor TLazDockForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FillChar(FMouseState, SizeOf(FMouseState), 0); - TDockHeader.CreateDockHeaderImages(FDockHeaderImages); -end; - -destructor TLazDockForm.Destroy; -begin - TDockHeader.DestroyDockHeaderImages(FDockHeaderImages); - inherited Destroy; -end; - -procedure TLazDockForm.UpdateCaption; -begin - if FMainControl<>nil then - Caption:=FMainControl.Caption - else - Caption:=''; -end; - -class procedure TLazDockForm.UpdateMainControlInParents(StartControl: TControl); -var - Form: TLazDockForm; -begin - while StartControl<>nil do begin - if (StartControl is TLazDockForm) then - begin - Form:=TLazDockForm(StartControl); - if (Form.MainControl=nil) - or (not Form.MainControl.IsVisible) then - Form.UpdateMainControl; - end; - StartControl:=StartControl.Parent; - end; -end; - -function TLazDockForm.FindMainControlCandidate: TControl; -var - BestLevel: integer; - - procedure FindCandidate(ParentControl: TWinControl; Level: integer); - var - i: Integer; - AControl: TControl; - ResultIsForm, ControlIsForm: boolean; - begin - for i:=0 to ParentControl.ControlCount-1 do begin - AControl:=ParentControl.Controls[i]; - //DebugLn(['FindCandidate ParentControl=',DbgSName(ParentControl),' AControl=',DbgSName(AControl)]); - if (not AControl.IsControlVisible) then continue; - if ((AControl.Name<>'') or (AControl.Caption<>'')) - and (not (AControl is TLazDockForm)) - and (not (AControl is TLazDockSplitter)) - and (not (AControl is TLazDockPages)) - and (not (AControl is TLazDockPage)) - then begin - // this is a candidate - // prefer forms and top level controls - if (Application<>nil) and (Application.MainForm=AControl) then begin - // the MainForm is the best control - Result:=Application.MainForm; - BestLevel:=-1; - exit; - end; - ResultIsForm:=Result is TCustomForm; - ControlIsForm:=AControl is TCustomForm; - if (Result=nil) - or ((not ResultIsForm) and ControlIsForm) - or ((ResultIsForm=ControlIsForm) and (Level check sub parts - Result := Control; - Orientation := GetTitleOrientation(Control); - Part := TDockHeader.FindPart(TitleRect, p, Orientation); - Exit; - end; - Result := nil; -end; - -function TLazDockForm.IsDockedControl(Control: TControl): boolean; -// checks if control is a child, not a TLazDockSplitter and properly anchor docked -var - a: TAnchorKind; - AnchorControl: TControl; -begin - Result:=false; - if (Control.Anchors<>[akLeft,akRight,akBottom,akTop]) - or (Control.Parent<>Self) then - exit; - for a:=low(TAnchorKind) to high(TAnchorKind) do begin - AnchorControl:=Control.AnchorSide[a].Control; - if (AnchorControl=nil) then exit; - if (AnchorControl<>Self) and (not (AnchorControl is TLazDockSplitter)) then - exit; - end; - Result:=true; -end; - -function TLazDockForm.ControlHasTitle(Control: TControl): boolean; -begin - Result:=Control.Visible - and IsDockedControl(Control) - and ((Control.BorderSpacing.Left>0) or (Control.BorderSpacing.Top>0)); -end; - -function TLazDockForm.GetTitleRect(Control: TControl): TRect; -begin - Result := Control.BoundsRect; - if Control.BorderSpacing.Top > 0 then - begin - Result.Top := Control.Top - Control.BorderSpacing.Top; - Result.Bottom := Control.Top; - end else - begin - Result.Left := Control.Left - Control.BorderSpacing.Left; - Result.Right := Control.Left; - end; -end; - -function TLazDockForm.GetTitleOrientation(Control: TControl): TDockOrientation; -begin - if Control.BorderSpacing.Top > 0 then - Result := doHorizontal - else - if Control.BorderSpacing.Left > 0 then - Result := doVertical - else - Result := doNoOrient; -end; - -{ TLazDockSplitter } - -constructor TLazDockSplitter.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - MinSize := 1; -end; - -initialization - DefaultDockManagerClass := TLazDockTree; -{$I lcl_dock_images.lrs} - -end.