paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 11:38:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Make sure dragging is not cancelled. Issue #40266, patch by Alexey Torgashin.

Browse Source
This commit is contained in:
Juha 2025-01-03 00:13:21 +02:00
parent 5963c7d45f
commit 0ed604c806
1 changed files with 4 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/include/dragmanager.inc
View File

@ -170,6 +170,7 @@ procedure TDragPerformer.DragMove(APosition: TPoint);
var
ATarget: TControl;
DragCursor: TCursor;
bAccepted: boolean;
begin
if FDragObject = nil then
Exit;
@ -190,7 +191,9 @@ begin
//TODO: Need to rewrite this(or even delete it, back to the roots)
if FDragObject.DragTarget <> nil then
FDragObject.DragTargetPos := FDragObject.DragTarget.ScreenToClient(APosition);
DragCursor := FDragObject.GetDragCursor(SendCmDragMsg(FDragObject, dmDragMove),APosition.X, APosition.Y);
bAccepted := SendCmDragMsg(FDragObject, dmDragMove);
if not DragManager.IsDragging then Exit; // avoids crash: accessing FDragObject which is not valid
DragCursor := FDragObject.GetDragCursor(bAccepted, APosition.X, APosition.Y);
if FDragImageList <> nil then
begin
if (ATarget = nil) or (csDisplayDragImage in ATarget.ControlStyle) or