mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-26 20:40:36 +02:00
lcl: apply "Proper initialization of the docking object" from Hans-Peter Diettrich (issue #0013945)
git-svn-id: trunk@20628 -
This commit is contained in:
parent
61942c9056
commit
9a7b124e9d
@ -490,6 +490,7 @@ type
|
||||
procedure EndUpdate; virtual; abstract;
|
||||
procedure GetControlBounds(Control: TControl;
|
||||
out AControlBounds: TRect); virtual; abstract;
|
||||
function GetDockEdge(ADockObject: TDragDockObject): boolean; virtual;
|
||||
procedure InsertControl(Control: TControl; InsertAt: TAlign;
|
||||
DropCtl: TControl); virtual; abstract;
|
||||
procedure LoadFromStream(Stream: TStream); virtual; abstract;
|
||||
@ -3569,6 +3570,16 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TDockManager.GetDockEdge(ADockObject: TDragDockObject): boolean;
|
||||
begin
|
||||
(* Determine the DropAlign.
|
||||
ADockObject contains valid DragTarget, DragPos, DragTargetPos relative dock site,
|
||||
and DropOnControl.
|
||||
Return True if ADockObject.DropAlign has been determined.
|
||||
*)
|
||||
Result := False; //not implemented
|
||||
end;
|
||||
|
||||
initialization
|
||||
//DebugLn('controls.pp - initialization');
|
||||
RegisterPropertyToSkip(TControl, 'Ctl3D', 'VCL compatibility property', '');
|
||||
|
@ -301,15 +301,13 @@ end;
|
||||
|
||||
procedure TDockPerformer.DragMove(APosition: TPoint);
|
||||
|
||||
function GetDropControl: TControl;
|
||||
function GetDropControl(ADragTarget: TWinControl): TControl;
|
||||
//Select a control where the dragged control will be docked
|
||||
var
|
||||
ADragTarget: TWinControl;
|
||||
AControl: TControl;
|
||||
i: integer;
|
||||
begin
|
||||
Result := nil;
|
||||
ADragTarget := TWinControl(FDockObject.DragTarget);
|
||||
if ADragTarget <> nil then
|
||||
begin
|
||||
if ADragTarget.UseDockManager then
|
||||
@ -402,7 +400,7 @@ procedure TDockPerformer.DragMove(APosition: TPoint);
|
||||
end;
|
||||
|
||||
var
|
||||
ATarget: TControl;
|
||||
ATarget: TWinControl;
|
||||
DragCursor: TCursor;
|
||||
begin
|
||||
if FDockObject = nil then
|
||||
@ -416,25 +414,31 @@ begin
|
||||
|
||||
if ATarget <> FDockObject.DragTarget then
|
||||
begin
|
||||
SendCmDragMsg(FDockObject, dmDragLeave);
|
||||
FDockObject.DragTarget := TWinControl(ATarget);
|
||||
FDockObject.DragPos := APosition;
|
||||
SendCmDragMsg(FDockObject, dmDragEnter);
|
||||
end
|
||||
else
|
||||
FDockObject.DragPos := APosition;
|
||||
SendCmDragMsg(FDockObject, dmDragLeave); //using the old values in FDockObject
|
||||
end;
|
||||
FDockObject.DragPos := APosition;
|
||||
|
||||
|
||||
if FDockObject.DragTarget <> nil then
|
||||
if ATarget <> nil then
|
||||
with FDockObject do
|
||||
begin //determine precise target now, before dmDragMove
|
||||
DragTargetPos := DragTarget.ScreenToClient(APosition);
|
||||
DropOnControl := GetDropControl;
|
||||
if DropOnControl = nil then
|
||||
DropAlign := FDockObject.DragTarget.GetDockEdge(DragTargetPos)
|
||||
else
|
||||
DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(APosition));
|
||||
DragTargetPos := ATarget.ScreenToClient(APosition);
|
||||
DropOnControl := GetDropControl(ATarget);
|
||||
if not ATarget.UseDockManager or
|
||||
not ATarget.DockManager.GetDockEdge(FDockObject) then
|
||||
begin
|
||||
if DropOnControl = nil then
|
||||
DropAlign := ATarget.GetDockEdge(DragTargetPos)
|
||||
else
|
||||
DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(APosition));
|
||||
end;
|
||||
end;
|
||||
|
||||
if ATarget <> FDockObject.DragTarget then
|
||||
begin
|
||||
FDockObject.DragTarget := ATarget;
|
||||
SendCmDragMsg(FDockObject, dmDragEnter);
|
||||
end;
|
||||
|
||||
DragCursor := FDockObject.GetDragCursor(SendCmDragMsg(FDockObject, dmDragMove),APosition.X, APosition.Y);
|
||||
if FDragImageList <> nil then
|
||||
begin
|
||||
|
Loading…
Reference in New Issue
Block a user