mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-27 11:00:37 +02:00
* Drag drop cursor patch from Paul Ishenin
git-svn-id: trunk@10459 -
This commit is contained in:
parent
52796d556e
commit
0558c2b8fa
@ -21,6 +21,7 @@ var
|
||||
DragStartPos: TPoint; // mouse position at start of drag
|
||||
ActiveDrag: TDragOperation;// current phase of drag operation
|
||||
DragThreshold: Integer;// treshold before the drag becomes activated
|
||||
DragStartCursor: hCursor; // cursor that was before dragging
|
||||
|
||||
Procedure DragTo(const Position: TPoint); forward;
|
||||
|
||||
@ -162,6 +163,14 @@ begin
|
||||
DragObject.DragTarget := nil;
|
||||
GetCursorPos(DragStartPos);
|
||||
DragObject.DragPos := DragStartPos;
|
||||
|
||||
// get current cursor
|
||||
// But this would not be work if control sets its cursor via WM_SETCURSOR
|
||||
// to handle such situaltions we must call here: WidgetSet.GetCursor
|
||||
if Screen.Cursor = crDefault then
|
||||
DragStartCursor := Screen.Cursors[Control.Cursor] else
|
||||
DragStartCursor := Screen.Cursors[Screen.Cursor];
|
||||
|
||||
//DragCapture := DragObject.Capture;
|
||||
DragThreshold := Threshold;
|
||||
|
||||
@ -237,6 +246,7 @@ end;
|
||||
Procedure DragTo(const Position: TPoint);
|
||||
var
|
||||
TargetControl: TControl;
|
||||
ADragCursor: TCursor;
|
||||
Begin
|
||||
{$IFDEF VerboseDrag}
|
||||
DebugLn('DragTo P=',Position.X,',',Position.Y);
|
||||
@ -268,10 +278,12 @@ Begin
|
||||
DragObject.DragPos := Position;
|
||||
SendDragOver(dmDragEnter);
|
||||
if DragObject = nil then Exit;
|
||||
end else begin
|
||||
end else
|
||||
begin
|
||||
// same target => send dmDragMove
|
||||
DragObject.DragPos := Position;
|
||||
SendDragOver(dmDragMove);
|
||||
ADragCursor := DragObject.GetDragCursor(SendDragOver(dmDragMove), Position.X, Position.Y);
|
||||
WidgetSet.SetCursor(Screen.Cursors[ADragCursor]);
|
||||
if DragObject = nil then Exit;
|
||||
end;
|
||||
|
||||
@ -335,6 +347,7 @@ Begin
|
||||
// erase global variables (dragging stopped)
|
||||
DragControl := nil;
|
||||
DragObject := nil;
|
||||
WidgetSet.SetCursor(DragStartCursor);
|
||||
|
||||
// drop
|
||||
if (OldDragObject<>nil) and (OldDragObject.DragTarget <> nil) then
|
||||
|
@ -132,7 +132,10 @@ end;
|
||||
function TDragControlObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
|
||||
): TCursor;
|
||||
begin
|
||||
Result:=inherited GetDragCursor(Accepted, X, Y);
|
||||
//Result := inherited GetDragCursor(Accepted, X, Y);
|
||||
if Accepted then
|
||||
Result := Control.DragCursor else
|
||||
Result := crNoDrop;
|
||||
end;
|
||||
|
||||
function TDragControlObject.GetDragImages: TDragImageList;
|
||||
|
@ -674,6 +674,7 @@ Var
|
||||
var
|
||||
lControl: TControl;
|
||||
BoundsOffset: TRect;
|
||||
ACursor: TCursor;
|
||||
begin
|
||||
if (lWinControl <> nil) and not (csDesigning in lWinControl.ComponentState)
|
||||
and (LOWORD(LParam) = HTCLIENT) then
|
||||
@ -685,13 +686,19 @@ Var
|
||||
Dec(P.X, BoundsOffset.Left);
|
||||
Dec(P.Y, BoundsOffset.Top);
|
||||
end;
|
||||
// statictext controls do not get WM_SETCURSOR messages...
|
||||
lControl := lWinControl.ControlAtPos(P, false, true);
|
||||
if lControl = nil then
|
||||
lControl := lWinControl;
|
||||
if lControl.Cursor <> crDefault then
|
||||
ACursor := Screen.Cursor;
|
||||
if ACursor = crDefault then
|
||||
begin
|
||||
Windows.SetCursor(Screen.Cursors[lControl.Cursor]);
|
||||
// statictext controls do not get WM_SETCURSOR messages...
|
||||
lControl := lWinControl.ControlAtPos(P, false, true);
|
||||
if lControl = nil then
|
||||
lControl := lWinControl;
|
||||
if lControl.Cursor <> crDefault then
|
||||
ACursor := lControl.Cursor;
|
||||
end;
|
||||
if ACursor <> crDefault then
|
||||
begin
|
||||
Windows.SetCursor(Screen.Cursors[ACursor]);
|
||||
LMessage.Result := 1;
|
||||
end;
|
||||
end;
|
||||
|
Loading…
Reference in New Issue
Block a user