paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 16:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix issue #39923 (AnchorDocking Docked forms sometimes overlap)

Browse Source
This commit is contained in:
zamtmn 2022-09-22 18:28:01 +05:00 committed by Maxim Ganetsky
parent 04ffdbc374
commit 989070fa91
3 changed files with 33 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/anchordocking/anchordocking.pas
View File

@ -489,6 +489,7 @@ type
procedure StoreConstraints; procedure StoreConstraints;
function GetSitePreferredClientSize: TPoint; function GetSitePreferredClientSize: TPoint;
function IsEnabledControl(Control: TControl):Boolean; override; function IsEnabledControl(Control: TControl):Boolean; override;
function CanBeDoubleDocked:Boolean; override;
property Site: TWinControl read FSite; // the associated TControl (a TAnchorDockHostSite or a custom dock site) property Site: TWinControl read FSite; // the associated TControl (a TAnchorDockHostSite or a custom dock site)
property DockSite: TAnchorDockHostSite read FDockSite; // if Site is a TAnchorDockHostSite, this is it property DockSite: TAnchorDockHostSite read FDockSite; // if Site is a TAnchorDockHostSite, this is it
@ -7560,6 +7561,11 @@ begin
Result := (DockMaster <> nil) and DockMaster.IsSite(Control); Result := (DockMaster <> nil) and DockMaster.IsSite(Control);
end; end;
function TAnchorDockManager.CanBeDoubleDocked:Boolean;
begin
Result := False;
end;
{ TAnchorDockSplitter } { TAnchorDockSplitter }
procedure TAnchorDockSplitter.SetResizeAnchor(const AValue: TAnchorKind); procedure TAnchorDockSplitter.SetResizeAnchor(const AValue: TAnchorKind);

6
lcl/controls.pp
View File

@ -624,6 +624,7 @@ type
procedure SetReplacingControl(Control: TControl); virtual; procedure SetReplacingControl(Control: TControl); virtual;
function AutoFreeByControl: Boolean; virtual; function AutoFreeByControl: Boolean; virtual;
function IsEnabledControl(Control: TControl):Boolean; virtual; function IsEnabledControl(Control: TControl):Boolean; virtual;
function CanBeDoubleDocked:Boolean; virtual;
end; end;
TDockManagerClass = class of TDockManager; TDockManagerClass = class of TDockManager;
@ -4638,6 +4639,11 @@ begin
end; end;
function TDockManager.CanBeDoubleDocked:Boolean;
begin
result:=true;
end;
function TDockManager.IsEnabledControl(Control: TControl):Boolean; function TDockManager.IsEnabledControl(Control: TControl):Boolean;
begin begin
Result := true; Result := true;

21
lcl/include/dragmanager.inc
View File

@ -367,6 +367,25 @@ procedure TDockPerformer.DragMove(APosition: TPoint);
end; end;
end; end;
function IsClientChildOfControl(AControl:TWinControl): Boolean;
var
Client:TControl;
begin
Result := False;
Client := FDockObject.Control;
if Assigned(AControl) then
while Assigned(Client) do
begin
if AControl=Client then
begin
Result := True;
exit;
end;
Client := Client.Parent;
end;
end;
function FindDockSiteAtPosition: TWinControl; function FindDockSiteAtPosition: TWinControl;
//Replace with lookup in Screen.Zorder(?) //Replace with lookup in Screen.Zorder(?)
var var
@ -416,6 +435,8 @@ procedure TDockPerformer.DragMove(APosition: TPoint);
if not AControl.IsVisible then continue; if not AControl.IsVisible then continue;
if AControl=FDockObject.Control then continue; if AControl=FDockObject.Control then continue;
if IsControlChildOfClient(AControl) then continue; if IsControlChildOfClient(AControl) then continue;
if not AControl.DockManager.CanBeDoubleDocked then
if IsClientChildOfControl(AControl) then continue;
if ItCanBeHostSite then if ItCanBeHostSite then
begin begin