mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 22:29:25 +02:00
LCL: anchor docking: started restoring page in neighbourhod
git-svn-id: trunk@11656 -
This commit is contained in:
mattias
parent
1db4ac6d80
commit
cbedb2962f
@ -76,7 +76,6 @@ const
|
||||
);
|
||||
|
||||
type
|
||||
TAnchorControls = array[TAnchorKind] of TControl;
|
||||
|
||||
{ TLazDockConfigNode }
|
||||
|
||||
@ -237,8 +236,9 @@ type
|
||||
procedure ShrinkNeighbourhood(Layout: TLazDockConfigNode;
|
||||
AControl: TControl; Sides: TAnchors);
|
||||
function FindPageNeighbours(Layout: TLazDockConfigNode;
|
||||
StartControl: TControl; out AnchorControls: TAnchorControls
|
||||
): TFPList; // list of TControls
|
||||
StartControl: TControl;
|
||||
out AnchorControls: TAnchorControlsRect
|
||||
): TFPList; // list of TControls
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
procedure ShowDockingEditor; virtual;
|
||||
@ -269,13 +269,21 @@ type
|
||||
|
||||
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
|
||||
|
||||
|
||||
function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType;
|
||||
begin
|
||||
for Result:=Low(TLDConfigNodeType) to High(TLDConfigNodeType) do
|
||||
@ -283,6 +291,249 @@ begin
|
||||
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<Result.Count-1 do begin
|
||||
AControl:=TControl(Result[i]);
|
||||
// test all anchored to
|
||||
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
|
||||
Candidate:=AControl.AnchorSide[a].Control;
|
||||
if (not IsBoundary(Candidate)) and (Result.IndexOf(Candidate)<0) then
|
||||
Result.Add(Candidate);
|
||||
end;
|
||||
// test all anchored by
|
||||
for j:=0 to Splitter.Parent.ControlCount-1 do begin
|
||||
Candidate:=Splitter.Parent.Controls[j];
|
||||
if IsBoundary(Candidate) then continue;
|
||||
if Result.IndexOf(Candidate)>=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
|
||||
@ -740,8 +991,10 @@ var
|
||||
Page: TLazDockPage;
|
||||
PageIndex: LongInt;
|
||||
NeighbourList: TFPList;
|
||||
AnchorControls: TAnchorControls;
|
||||
AnchorControls: TAnchorControlsRect;
|
||||
TopFormBounds: TRect;
|
||||
i: Integer;
|
||||
a: TAnchorKind;
|
||||
begin
|
||||
Result:=false;
|
||||
DebugLn(['TCustomLazControlDocker.DockAsPage DockerName="',DockerName,'"']);
|
||||
@ -826,14 +1079,53 @@ begin
|
||||
// TODO enlarge parents
|
||||
end else begin
|
||||
// NeighbourControl is a child control, but the parent is not yet a page
|
||||
// => collect all neighbour controls for 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 neigbbours onto
|
||||
// TODO: create a PageControl and two pages. And move the neighbours onto
|
||||
// one page and Control to the other page.
|
||||
if AnchorControls[akLeft]=nil then ;
|
||||
|
||||
// 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;
|
||||
@ -1169,100 +1461,135 @@ begin
|
||||
end;
|
||||
|
||||
function TCustomLazControlDocker.FindPageNeighbours(Layout: TLazDockConfigNode;
|
||||
StartControl: TControl; out AnchorControls: TAnchorControls): TFPList;
|
||||
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;
|
||||
|
||||
function AddNeighbour(AControl: TControl): boolean;
|
||||
procedure InitCompatibility;
|
||||
var
|
||||
i: Integer;
|
||||
Sibling: TControl;
|
||||
a: TAnchorKind;
|
||||
AControl: TControl;
|
||||
NodeName: String;
|
||||
Node: TLazDockConfigNode;
|
||||
OldAnchorControls: TAnchorControls;
|
||||
begin
|
||||
Result:=false;
|
||||
if (AControl=nil) or (AControl.Parent<>StartControl.Parent) then exit;
|
||||
if ControlList.IndexOf(AControl)>=0 then begin
|
||||
// already added
|
||||
exit(true);
|
||||
end;
|
||||
NodeName:=Manager.GetControlConfigName(AControl);
|
||||
Node:=Layout.FindByName(NodeName);
|
||||
if (Node=nil) or (Node.Parent<>PageNode) then begin
|
||||
// this control does not belong to this page
|
||||
exit;
|
||||
end;
|
||||
|
||||
// add AControl to the list of neighbours
|
||||
ControlList.Add(AControl);
|
||||
// fix AnchorControls, so
|
||||
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
|
||||
OldAnchorControls[a]:=nil;
|
||||
Sibling:=AControl.AnchorSide[a].Control;
|
||||
if (Sibling<>nil)
|
||||
and ((AnchorControls[a]=AControl)
|
||||
or (AnchorControls[a]=AControl.AnchorSide[OppositeAnchor[a]].Control))
|
||||
then begin
|
||||
OldAnchorControls[a]:=AnchorControls[a];
|
||||
AnchorControls[a]:=Sibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
try
|
||||
// add all controls anchored to this control
|
||||
for i:=0 to StartControl.Parent.ControlCount-1 do begin
|
||||
Sibling:=StartControl.Parent.Controls[i];
|
||||
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
|
||||
if Sibling.AnchorSide[a].Control=AControl then
|
||||
if not AddNeighbour(Sibling) then exit;
|
||||
end;
|
||||
end;
|
||||
Result:=true;
|
||||
finally
|
||||
if not Result then begin
|
||||
// remove AControl from list and restore AnchorControls
|
||||
ControlList.Remove(AControl);
|
||||
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
|
||||
if OldAnchorControls[a]<>nil then
|
||||
AnchorControls[a]:=OldAnchorControls[a];
|
||||
end;
|
||||
// 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
|
||||
a: TAnchorKind;
|
||||
Added: Boolean;
|
||||
NodeName: String;
|
||||
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;
|
||||
|
||||
NodeName:=Manager.GetControlConfigName(StartControl);
|
||||
if NodeName='' then exit;
|
||||
StartNode:=Layout.FindByName(NodeName);
|
||||
// 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;
|
||||
repeat
|
||||
Added:=false;
|
||||
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
|
||||
if AddNeighbour(AnchorControls[a]) then
|
||||
Added:=true;
|
||||
end;
|
||||
until not Added;
|
||||
|
||||
// init
|
||||
Parent:=StartControl.Parent;
|
||||
InitCompatibility;
|
||||
|
||||
// try some possibilities
|
||||
if (not TryLayoutSolution) then
|
||||
TrySubsets;
|
||||
|
||||
Result:=ControlList;
|
||||
end;
|
||||
|
||||
|
||||
@ -200,6 +200,9 @@ const
|
||||
doPages //alCustom
|
||||
);
|
||||
|
||||
type
|
||||
TAnchorControlsRect = array[TAnchorKind] of TControl;
|
||||
|
||||
function GetLazDockSplitter(Control: TControl; Side: TAnchorKind;
|
||||
out Splitter: TLazDockSplitter): boolean;
|
||||
function GetLazDockSplitterOrParent(Control: TControl; Side: TAnchorKind;
|
||||
@ -208,9 +211,18 @@ function CountAnchoredControls(Control: TControl; Side: TAnchorKind
|
||||
): Integer;
|
||||
function NeighbourCanBeShrinked(EnlargeControl, Neighbour: TControl;
|
||||
Side: TAnchorKind): boolean;
|
||||
function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind;
|
||||
DestControl: TControl): boolean;
|
||||
procedure GetAnchorControlsRect(Control: TControl;
|
||||
out ARect: TAnchorControlsRect);
|
||||
function GetEnclosingControlRect(ControlList: TFPlist;
|
||||
out ARect: TAnchorControlsRect): boolean;
|
||||
function GetEnclosedControls(const ARect: TAnchorControlsRect): TFPList;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function GetLazDockSplitter(Control: TControl; Side: TAnchorKind; out
|
||||
Splitter: TLazDockSplitter): boolean;
|
||||
begin
|
||||
@ -283,6 +295,248 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ControlIsAnchoredIndirectly(StartControl: TControl; Side: TAnchorKind;
|
||||
DestControl: TControl): boolean;
|
||||
{ true if there is an Anchor way from StartControl to DestControl over Side.
|
||||
For example:
|
||||
|
||||
+-+|+-+
|
||||
|A|||B|
|
||||
+-+|+-+
|
||||
|
||||
A is akLeft to B.
|
||||
B is akRight to A.
|
||||
The splitter is akLeft to B.
|
||||
The splitter is akRight to A.
|
||||
All other are false.
|
||||
}
|
||||
var
|
||||
Checked: array of Boolean;
|
||||
Parent: TWinControl;
|
||||
|
||||
function Check(ControlIndex: integer): boolean;
|
||||
var
|
||||
AControl: TControl;
|
||||
SideControl: TControl;
|
||||
i: Integer;
|
||||
begin
|
||||
if Checked[ControlIndex] then
|
||||
exit(false);
|
||||
Checked[ControlIndex]:=true;
|
||||
AControl:=Parent.Controls[ControlIndex];
|
||||
if AControl=DestControl then exit(true);
|
||||
|
||||
if (Side in AControl.Anchors) then begin
|
||||
SideControl:=AControl.AnchorSide[Side].Control;
|
||||
if (SideControl<>nil) 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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user