paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 09:40:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: apply "Proper initialization of the docking object" from Hans-Peter Diettrich (issue #0013945)

Browse Source 
git-svn-id: trunk@20628 -
This commit is contained in:
paul 2009-06-15 02:18:26 +00:00
parent 61942c9056
commit 9a7b124e9d
2 changed files with 34 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/controls.pp
View File

@ -490,6 +490,7 @@ type
procedure EndUpdate; virtual; abstract; procedure EndUpdate; virtual; abstract;
procedure GetControlBounds(Control: TControl; procedure GetControlBounds(Control: TControl;
out AControlBounds: TRect); virtual; abstract; out AControlBounds: TRect); virtual; abstract;
function GetDockEdge(ADockObject: TDragDockObject): boolean; virtual;
procedure InsertControl(Control: TControl; InsertAt: TAlign; procedure InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl); virtual; abstract; DropCtl: TControl); virtual; abstract;
procedure LoadFromStream(Stream: TStream); virtual; abstract; procedure LoadFromStream(Stream: TStream); virtual; abstract;
@ -3569,6 +3570,16 @@ begin
Result := True; Result := True;
end; 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 initialization
//DebugLn('controls.pp - initialization'); //DebugLn('controls.pp - initialization');
RegisterPropertyToSkip(TControl, 'Ctl3D', 'VCL compatibility property', ''); RegisterPropertyToSkip(TControl, 'Ctl3D', 'VCL compatibility property', '');

42
lcl/include/dragmanager.inc
View File

@ -301,15 +301,13 @@ end;
procedure TDockPerformer.DragMove(APosition: TPoint); procedure TDockPerformer.DragMove(APosition: TPoint);
function GetDropControl: TControl; function GetDropControl(ADragTarget: TWinControl): TControl;
//Select a control where the dragged control will be docked //Select a control where the dragged control will be docked
var var
ADragTarget: TWinControl;
AControl: TControl; AControl: TControl;
i: integer; i: integer;
begin begin
Result := nil; Result := nil;
ADragTarget := TWinControl(FDockObject.DragTarget);
if ADragTarget <> nil then if ADragTarget <> nil then
begin begin
if ADragTarget.UseDockManager then if ADragTarget.UseDockManager then
@ -402,7 +400,7 @@ procedure TDockPerformer.DragMove(APosition: TPoint);
end; end;
var var
ATarget: TControl; ATarget: TWinControl;
DragCursor: TCursor; DragCursor: TCursor;
begin begin
if FDockObject = nil then if FDockObject = nil then
@ -416,25 +414,31 @@ begin
if ATarget <> FDockObject.DragTarget then if ATarget <> FDockObject.DragTarget then
begin begin
SendCmDragMsg(FDockObject, dmDragLeave); SendCmDragMsg(FDockObject, dmDragLeave); //using the old values in FDockObject
FDockObject.DragTarget := TWinControl(ATarget); end;
FDockObject.DragPos := APosition; FDockObject.DragPos := APosition;
SendCmDragMsg(FDockObject, dmDragEnter);
end
else
FDockObject.DragPos := APosition;
if ATarget <> nil then
if FDockObject.DragTarget <> nil then
with FDockObject do with FDockObject do
begin //determine precise target now, before dmDragMove begin //determine precise target now, before dmDragMove
DragTargetPos := DragTarget.ScreenToClient(APosition); DragTargetPos := ATarget.ScreenToClient(APosition);
DropOnControl := GetDropControl; DropOnControl := GetDropControl(ATarget);
if DropOnControl = nil then if not ATarget.UseDockManager or
DropAlign := FDockObject.DragTarget.GetDockEdge(DragTargetPos) not ATarget.DockManager.GetDockEdge(FDockObject) then
else begin
DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(APosition)); if DropOnControl = nil then
DropAlign := ATarget.GetDockEdge(DragTargetPos)
else
DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(APosition));
end;
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); DragCursor := FDockObject.GetDragCursor(SendCmDragMsg(FDockObject, dmDragMove),APosition.X, APosition.Y);
if FDragImageList <> nil then if FDragImageList <> nil then
begin begin