lazarus/lcl/ldocktree.pas
mattias 6eb4930179 fixed references to COPYING.LCL
git-svn-id: trunk@9243 -
2006-05-05 05:52:08 +00:00

1536 lines
49 KiB
ObjectPascal

{ $Id$ }
{
/***************************************************************************
LDockTree.pas
-----------------
***************************************************************************/
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, 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
Classes, SysUtils, LCLProc, LCLType, Forms, Controls, ExtCtrls, Menus,
LCLStrConsts;
type
TLazDockPages = class;
TLazDockPage = class;
TLazDockSplitter = class;
{ TLazDockZone }
TLazDockZone = class(TDockZone)
private
FPage: TLazDockPage;
FPages: TLazDockPages;
FSplitter: TLazDockSplitter;
public
destructor Destroy; override;
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;
{ TLazDockTree }
TLazDockTree = class(TDockTree)
private
FAutoFreeDockSite: boolean;
protected
procedure UndockControlForDocking(AControl: TControl);
procedure BreakAnchors(Zone: TDockZone);
procedure CreateDockLayoutHelperControls(Zone: TLazDockZone);
procedure AnchorDockLayout(Zone: TLazDockZone);
public
constructor Create(TheDockSite: TWinControl); override;
destructor Destroy; override;
procedure InsertControl(AControl: TControl; InsertAt: TAlign;
DropControl: 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;
public
property AutoFreeDockSite: boolean read FAutoFreeDockSite write FAutoFreeDockSite;
end;
{ TLazDockForm
The default DockSite for a TLazDockTree
Note: AnchorDocking does not use DockZone.
if DockZone<>nil then
If DockZone is a leaf (DockZone.ChildCount=0) then
Only child control is DockZone.ChildControl
else
if DockZone.Orientation in [doHorizontal,doVertical] then
Child controls are TLazDockForm and TSplitter
else if DockZone.Orientation=doPages then
Child control is a TLazDockPages
}
TLazDockForm = class(TCustomForm)
private
FDockZone: TDockZone;
FMainControl: TControl;
FPageControl: TLazDockPages;
procedure SetMainControl(const AValue: TControl);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure InsertControl(AControl: TControl; Index: integer); override;
function CloseQuery: boolean; override;
public
procedure UpdateCaption; virtual;
function FindMainControlCandidate: TControl;
property DockZone: TDockZone read FDockZone;
property PageControl: TLazDockPages read FPageControl;
property MainControl: TControl read FMainControl write SetMainControl;
end;
{ TLazDockPage
Pretty the same as a TLazDockForm but as page of a TLazDockPages }
TLazDockPage = class(TCustomPage)
private
FDockZone: TDockZone;
function GetPageControl: TLazDockPages;
public
property DockZone: TDockZone read FDockZone;
property PageControl: TLazDockPages read GetPageControl;
end;
{ TLazDockPages }
TLazDockPages = class(TCustomNotebook)
private
function GetActiveNotebookPageComponent: TLazDockPage;
function GetNoteBookPage(Index: Integer): TLazDockPage;
procedure SetActiveNotebookPageComponent(const AValue: TLazDockPage);
public
constructor Create(TheOwner: TComponent); override;
property Page[Index: Integer]: TLazDockPage read GetNoteBookPage;
property ActivePageComponent: TLazDockPage read GetActiveNotebookPageComponent
write SetActiveNotebookPageComponent;
property Pages;
end;
TLazDockSplitter = class(TCustomSplitter)
end;
//----------------------------------------------------------------------------
{ TAnchoredDockManager }
TAnchoredDockManager = class(TDockManager)
private
FSplitterSize: integer;
FUpdateCount: integer;
protected
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;
public
constructor Create;
procedure BeginUpdate; override;
procedure EndUpdate; override;
procedure GetControlBounds(Control: TControl;
out AControlBounds: TRect); override;
procedure DockControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl);
procedure UndockControl(Control: TControl; Float: boolean);
procedure InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl); override;
procedure LoadFromStream(Stream: TStream); override;
procedure PaintSite(DC: HDC); override;
procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
var DockRect: TRect); override;
procedure RemoveControl(Control: TControl); override;
procedure ResetBounds(Force: Boolean); override;
procedure SaveToStream(Stream: TStream); override;
procedure SetReplacingControl(Control: TControl); override;
procedure ReplaceAnchoredControl(OldControl, NewControl: TControl);
property SplitterSize: integer read FSplitterSize write FSplitterSize default 5;
end;
const
DockAlignOrientations: array[TAlign] of TDockOrientation = (
doPages, //alNone,
doVertical, //alTop,
doVertical, //alBottom,
doHorizontal,//alLeft,
doHorizontal,//alRight,
doPages, //alClient,
doPages //alCustom
);
implementation
{ TLazDockPages }
function TLazDockPages.GetActiveNotebookPageComponent: TLazDockPage;
begin
Result:=TLazDockPage(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;
constructor TLazDockPages.Create(TheOwner: TComponent);
begin
PageClass:=TLazDockPage;
inherited Create(TheOwner);
end;
{ TLazDockTree }
procedure TLazDockTree.UndockControlForDocking(AControl: TControl);
var
AWinControl: TWinControl;
begin
// undock AControl
if AControl is TWinControl then begin
AWinControl:=TWinControl(AControl);
if AWinControl.DockManager<>nil then begin
// TODO
end;
end;
if AControl.Parent<>nil then begin
AControl.Parent:=nil;
end;
end;
procedure TLazDockTree.BreakAnchors(Zone: TDockZone);
begin
if Zone=nil then exit;
if Zone.ChildControl<>nil then begin
Zone.ChildControl.AnchorSide[akLeft].Control:=nil;
Zone.ChildControl.AnchorSide[akTop].Control:=nil;
Zone.ChildControl.Anchors:=[akLeft,akTop];
end;
BreakAnchors(Zone.FirstChild);
BreakAnchors(Zone.NextSibling);
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);
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 childs');
if (Zone.Pages=nil) then begin
Zone.Pages:=TLazDockPages.Create(nil);
end;
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 childs and siblings
CreateDockLayoutHelperControls(Zone.FirstChild as TLazDockZone);
CreateDockLayoutHelperControls(Zone.NextSibling as TLazDockZone);
end;
procedure TLazDockTree.AnchorDockLayout(Zone: TLazDockZone);
// setup all anchors between all docked controls and helper controls
var
AnchorControls: array[TAnchorKind] of TControl;
a: TAnchorKind;
SplitterSide: TAnchorKind;
CurControl: TControl;
NewAnchors: TAnchors;
begin
if Zone=nil then exit;
// get outside anchor controls
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
SplitterSide:=akLeft
else
SplitterSide:=akTop;
// IMPORTANT: first set the AnchorSide, then set the Anchors
NewAnchors:=[akLeft,akRight,akTop,akBottom]-[SplitterSide];
for a:=Low(TAnchorKind) to High(TAnchorKind) do
if a in NewAnchors then
Zone.Splitter.AnchorSide[a].Control:=AnchorControls[a];
Zone.Splitter.Anchors:=NewAnchors;
AnchorControls[SplitterSide]:=Zone.Splitter;
end;
// anchor pages
if Zone.Pages<>nil then
CurControl:=Zone.Pages
else
CurControl:=Zone.ChildControl;
if CurControl<>nil then begin
// IMPORTANT: first set the AnchorSide, then set the Anchors
for a:=Low(TAnchorKind) to High(TAnchorKind) do
CurControl.AnchorSide[a].Control:=AnchorControls[a];
CurControl.Anchors:=[akLeft,akRight,akTop,akBottom];
end;
// anchor controls for childs and siblings
AnchorDockLayout(Zone.FirstChild as TLazDockZone);
AnchorDockLayout(Zone.NextSibling as TLazDockZone);
end;
constructor TLazDockTree.Create(TheDockSite: TWinControl);
begin
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;
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)
}
const
SplitterWidth = 5;
SplitterHeight = 5;
var
DropZone: TDockZone;
NewZone: TLazDockZone;
NewOrientation: TDockOrientation;
NeedNewParentZone: Boolean;
NewParentZone: TDockZone;
OldParentZone: TDockZone;
NewBounds: TRect;
ASibling: TDockZone;
begin
if DropControl=nil 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);
if not AControl.Visible then
DockSite.Visible:=false;
DockSite.BoundsRect:=AControl.BoundsRect;
AControl.Parent:=DockSite;
if AControl.Visible then
DockSite.Visible:=true;
end else begin
// there are already other childs
// optimize DropZone
if (DropZone.ChildCount>0)
and (NewOrientation in [doHorizontal,doVertical])
and ((DropZone.Orientation=NewOrientation)
or (DropZone.Orientation=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.Orientation=doNoOrient) then
NeedNewParentZone:=false;
if (DropZone.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);
end;
// adjust Orientation in tree
if DropZone.Parent.Orientation=doNoOrient then
DropZone.Parent.Orientation:=NewOrientation;
if DropZone.Parent.Orientation<>NewOrientation then
RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Orientation<>NewOrientation');
// insert new node
if DropZone.Parent=nil then
RaiseGDBException('TLazDockTree.InsertControl Inconsistency DropZone.Parent=nil');
if InsertAt in [alLeft,alTop] then
DropZone.Parent.AddAsFirstChild(NewZone)
else
DropZone.Parent.AddAsLastChild(NewZone);
// break anchors and resize DockSite
BreakAnchors(RootZone);
NewBounds:=DockSite.BoundsRect;
case InsertAt of
alLeft: dec(NewBounds.Left,SplitterWidth+AControl.Width);
alRight: inc(NewBounds.Right,SplitterWidth+AControl.Width);
alTop: dec(NewBounds.Top,SplitterHeight+AControl.Height);
alBottom:inc(NewBounds.Bottom,SplitterHeight+AControl.Height);
else // no change
end;
DockSite.BoundsRect:=NewBounds;
// add AControl to DockSite
AControl.Visible:=false;
AControl.Parent:=nil;
AControl.Align:=alNone;
AControl.Anchors:=[akLeft,akTop];
AControl.AnchorSide[akLeft].Control:=nil;
AControl.AnchorSide[akTop].Control:=nil;
AControl.AutoSize:=false;
// resize control
RaiseGDBException('TLazDockTree.InsertControl TODO resize control');
if NewOrientation in [doHorizontal,doVertical] then begin
ASibling:=NewZone.PrevSibling;
if ASibling=nil then ASibling:=NewZone.NextSibling;
if ASibling<>nil then begin
if NewOrientation=doHorizontal then
AControl.Height:=ASibling.Height
else
AControl.Width:=ASibling.Width;
end;
end;
AControl.Parent:=NewZone.GetParentControl;
// Build dock layout (anchors, splitters, pages)
BuildDockLayout(RootZone as TLazDockZone);
end;
end;
procedure TLazDockTree.BuildDockLayout(Zone: TLazDockZone);
begin
BreakAnchors(Zone);
CreateDockLayoutHelperControls(Zone);
AnchorDockLayout(Zone);
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=doHorizontal)
and (Zone.Splitter<>nil) then begin
Result:=Zone.Splitter;
exit;
end;
if (Side=akTop)
and (Zone.Parent<>nil) and (Zone.Parent.Orientation=doVertical)
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 neigbour zones:
Result:=DockSite;
if (Zone.Parent=nil) then exit;
case Zone.Parent.Orientation of
doHorizontal:
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);
doVertical:
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);
doPages:
Result:=GetAnchorControl(Zone.Parent as TLazDockZone,Side,false);
end;
end;
{ TLazDockZone }
destructor TLazDockZone.Destroy;
begin
inherited Destroy;
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 begin
Result:=(Zone as TLazDockZone).Pages;
exit;
end;
if (Zone.Parent=nil) then begin
if Zone.ChildControl is TWinControl then
Result:=TWinControl(Zone.ChildControl);
exit;
end;
Zone:=Zone.Parent;
end;
end;
{ TAnchoredDockManager }
procedure TAnchoredDockManager.DeleteSideSplitter(Splitter: TLazDockSplitter;
Side: TAnchorKind; NewAnchorControl: TControl);
var
SplitterParent: TWinControl;
i: Integer;
CurControl: TControl;
NewSideRef: TAnchorSideReference;
begin
//DebugLn('TAnchoredDockManager.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('TAnchoredDockManager.DeleteSideSplitter Anchor ',DbgSName(CurControl),'(',dbgs(Side),') to ',DbgSName(NewAnchorControl));
end;
end;
Splitter.Free;
finally
SplitterParent.EnableAlign;
end;
end;
procedure TAnchoredDockManager.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('TAnchoredDockManager.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('TAnchoredDockManager.CombineSpiralSplitterPair Inconsistency: Parent=nil');
if (ParentControl<>Splitter2.Parent) then
RaiseGDBException('TAnchoredDockManager.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('TAnchoredDockManager.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 TAnchoredDockManager.DeletePage(Page: TLazDockPage);
var
Pages: TLazDockPages;
begin
DebugLn('TAnchoredDockManager.DeletePage Page=',DbgSName(Page));
Pages:=Page.PageControl;
Page.Free;
if Pages.PageCount=0 then
DeletePages(Pages);
end;
procedure TAnchoredDockManager.DeletePages(Pages: TLazDockPages);
begin
DebugLn('TAnchoredDockManager.DeletePages Pages=',DbgSName(Pages));
if Pages.Parent<>nil then
UndockControl(Pages,false);
Pages.Free;
end;
procedure TAnchoredDockManager.DeleteDockForm(ADockForm: TLazDockForm);
begin
DebugLn('TAnchoredDockManager.DeleteDockForm ADockForm=',DbgSName(ADockForm));
if ADockForm.Parent<>nil then
UndockControl(ADockForm,false);
ADockForm.Free;
end;
function TAnchoredDockManager.GetAnchorDepth(AControl: TControl;
Side: TAnchorKind): Integer;
var
NewControl: TControl;
begin
Result:=0;
while (AControl<>nil) do begin
inc(Result);
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;
constructor TAnchoredDockManager.Create;
begin
FSplitterSize:=5;
end;
procedure TAnchoredDockManager.BeginUpdate;
begin
inc(FUpdateCount);
end;
procedure TAnchoredDockManager.EndUpdate;
begin
if FUpdateCount<=0 then
RaiseGDBException('TAnchoredDockManager.EndUpdate');
dec(FUpdateCount);
if FUpdateCount=0 then begin
end;
end;
procedure TAnchoredDockManager.GetControlBounds(Control: TControl;
out AControlBounds: TRect);
begin
AControlBounds:=Control.BoundsRect;
end;
{-------------------------------------------------------------------------------
procedure TAnchoredDockManager.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 TAnchoredDockManager.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;
begin
if Control.Parent<>nil then
RaiseGDBException('TAnchoredDockManager.InsertControl Control.Parent<>nil');
// 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];
// make sure, there is a parent HostSite
if DropCtl.Parent=nil then begin
// create a TLazDockForm as new parent
NewParent:=TLazDockForm.Create(Application);
NewParent.BoundsRect:=DropCtl.BoundsRect;
DropCtl.Parent:=NewParent;
// init anchors of DropCtl
DropCtl.Align:=alNone;
for a:=Low(TAnchorKind) to High(TAnchorKind) do
DropCtl.AnchorParallel(a,0,DropCtl.Parent);
DropCtl.Anchors:=[akLeft,akTop,akRight,akBottom];
NewParent.Visible:=true;
//DebugLn('TAnchoredDockManager.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('TAnchoredDockManager.InsertControl DropCtl has invalid parent');
end;
end;
DropCtl.Parent.DisableAlign;
try
// create a splitter
Splitter:=TLazDockSplitter.Create(Control);
Splitter.Align:=alNone;
Splitter.Beveled:=true;
Splitter.ResizeAnchor:=ControlAnchor;
//debugln('TAnchoredDockManager.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
NewDropCtlBounds:=DropCtl.BoundsRect;
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('TAnchoredDockManager.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('TAnchoredDockManager.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
Control.AnchorSide[a].Control:=nil;
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.Parent:=DropCtl.Parent;
// position DropCtl
DropCtl.AnchorToNeighbour(DropCtlAnchor,0,Splitter);
//debugln('TAnchoredDockManager.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
DropCtl.Parent.EnableAlign;
end;
//debugln('TAnchoredDockManager.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('TAnchoredDockManager.InsertControl alClient DropCtl=',DbgSName(DropCtl),' Control=',DbgSName(Control));
if not (DropCtl.Parent is TLazDockPage) then begin
// create a new TLazDockPages
//DebugLn('TAnchoredDockManager.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);
end;
// add DockCtl as page to DockPages
DockPages.Pages.Add(DropCtl.Caption);
DropCtlPage:=DockPages.Page[0];
DropCtl.Parent:=DropCtlPage;
DropCtl.Align:=alClient;
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];
Control.Parent:=NewPage;
Control.Align:=alClient;
end;
else
RaiseGDBException('TAnchoredDockManager.InsertControl TODO');
end;
end;
{-------------------------------------------------------------------------------
procedure TAnchoredDockManager.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 TAnchoredDockManager.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 childs 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
a: TAnchorKind;
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;
begin
try
if Float then begin
NewBounds:=Control.BoundsRect;
NewOrigin:=Control.ControlOrigin;
OffsetRect(NewBounds,NewOrigin.X,NewOrigin.Y);
Control.ManualFloat(NewBounds);
end else begin
Control.Parent:=nil;
end;
finally
if (ParentControl<>nil) then begin
OldParentControl:=ParentControl;
ParentControl:=nil;
//DebugLn('DoFinallyForParent EnableAlign for ',DbgSName(OldParentControl));
OldParentControl.EnableAlign;
//OldParentControl.WriteLayoutDebugReport('X ');
end;
end;
end;
begin
if Control.Parent=nil then begin
// already undocked
RaiseGDBException('TAnchoredDockManager.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('TAnchoredDockManager.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('TAnchoredDockManager.UndockControl Splitter not needed: ',DbgSName(AnchorSplitter),'(',dbgs(AnchorSplitter.BoundsRect),')');
DeleteSideSplitter(AnchorSplitter,OppositeAnchor[a],
OldAnchorControls[OppositeAnchor[a]]);
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
DoFinallyForParent;
DeletePage(TLazDockPage(Control.Parent));
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
DoFinallyForParent;
DeleteDockForm(TLazDockForm(ParentControl));
end;
end;
if not Done then begin
// otherwise: keep
end;
finally
DoFinallyForParent;
end;
end;
procedure TAnchoredDockManager.InsertControl(Control: TControl;
InsertAt: TAlign; DropCtl: TControl);
begin
DockControl(Control, InsertAt, DropCtl);
end;
procedure TAnchoredDockManager.LoadFromStream(Stream: TStream);
begin
RaiseGDBException('TAnchoredDockManager.LoadFromStream TODO');
end;
procedure TAnchoredDockManager.PaintSite(DC: HDC);
begin
RaiseGDBException('TAnchoredDockManager.PaintSite TODO');
end;
procedure TAnchoredDockManager.PositionDockRect(Client, DropCtl: TControl;
DropAlign: TAlign; var DockRect: TRect);
begin
RaiseGDBException('TAnchoredDockManager.PositionDockRect TODO');
end;
procedure TAnchoredDockManager.RemoveControl(Control: TControl);
begin
UndockControl(Control,false);
end;
procedure TAnchoredDockManager.ResetBounds(Force: Boolean);
begin
RaiseGDBException('TAnchoredDockManager.ResetBounds TODO');
end;
procedure TAnchoredDockManager.SaveToStream(Stream: TStream);
begin
RaiseGDBException('TAnchoredDockManager.SaveToStream TODO');
end;
procedure TAnchoredDockManager.SetReplacingControl(Control: TControl);
begin
RaiseGDBException('TAnchoredDockManager.SetReplacingControl TODO');
end;
procedure TAnchoredDockManager.ReplaceAnchoredControl(OldControl,
NewControl: TControl);
var
a: TAnchorKind;
Side: TAnchorSide;
i: Integer;
Sibling: TControl;
begin
if OldControl.Parent<>nil then begin
NewControl.Parent.DisableAlign;
try
// put NewControl on the same Parent with the same bounds
NewControl.Parent:=nil;
NewControl.Align:=alNone;
NewControl.BoundsRect:=OldControl.BoundsRect;
NewControl.Parent:=OldControl.Parent;
// 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 OldControl.Parent.ControlCount-1 do begin
Sibling:=OldControl.Parent.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
NewControl.Parent.EnableAlign;
end;
end else begin
NewControl.Parent:=nil;
NewControl.Align:=alNone;
NewControl.BoundsRect:=OldControl.BoundsRect;
end;
end;
{ TLazDockPage }
function TLazDockPage.GetPageControl: TLazDockPages;
begin
Result:=Parent as TLazDockPages;
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.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);
var
NewMainConrtrol: TControl;
begin
inherited InsertControl(AControl, Index);
if FMainControl=nil then begin
NewMainConrtrol:=FindMainControlCandidate;
if NewMainConrtrol<>nil then
MainControl:=NewMainConrtrol;
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 childs
if (not TCustomForm(AControl).CloseQuery) then
exit(false);
end
else if not QueryForms(TWinControl(AControl)) then
// search childs for forms
exit(false);
end;
end;
Result:=true;
end;
begin
Result:=inherited CloseQuery;
if Result then
Result:=QueryForms(Self);
end;
procedure TLazDockForm.UpdateCaption;
begin
if FMainControl<>nil then
Caption:=FMainControl.Caption
else
Caption:='';
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];
if (AControl.Name<>'')
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<BestLevel))
then begin
BestLevel:=Level;
Result:=AControl;
end;
end;
if AControl is TWinControl then
FindCandidate(TWinControl(AControl),Level+1);
end;
end;
begin
Result:=nil;
BestLevel:=High(Integer);
FindCandidate(Self,0);
end;
end.