Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Bug in Delphi VCL Drag and Drop?

My application compiled with Delphi 2007 have drag and drop between grids and it works fine most of the time. But sometimes randomly I got Access violation. I debugged it to Controls.pas method DragTo in VCL.

It begins like this:

begin
  if (ActiveDrag <> dopNone) or (Abs(DragStartPos.X - Pos.X) >= DragThreshold) or
    (Abs(DragStartPos.Y - Pos.Y) >= DragThreshold) then
  begin
    Target := DragFindTarget(Pos, TargetHandle, DragControl.DragKind, DragControl);

The exception happens on the last row because DragControl is nil. DragControl is a global variable of type TControl. I have tried to patch this method with an assigncheck and call CancelDrag if DragControl = nil, but that fails also because DragObject is also nil.

procedure CancelDrag;
begin
 if DragObject <> nil then DragDone(False);
 DragControl := nil;
end;

To find out why DragControl is nil I inspected DragInitControl. There are 2 lines that just exit if DragControl is nil.

procedure DragInitControl(Control: TControl; Immediate: Boolean; Threshold: Integer);
var
  DragObject: TDragObject;
  StartPos: TPoint;
begin
  DragControl := Control;
  try
    DragObject := nil;
    DragInternalObject := False;    
    if Control.FDragKind = dkDrag then
    begin
      Control.DoStartDrag(DragObject);
      if DragControl = nil then Exit;
      if DragObject = nil then
      begin
        DragObject := TDragControlObjectEx.Create(Control);
        DragInternalObject := True;
      end
    end
    else
    begin
      Control.DoStartDock(DragObject);
      if DragControl = nil then Exit;
      if DragObject = nil then
      begin
        DragObject := TDragDockObjectEx.Create(Control);
        DragInternalObject := True;        
      end;
      with TDragDockObject(DragObject) do
      begin
        if Control is TWinControl then
          GetWindowRect(TWinControl(Control).Handle, FDockRect)
        else
        begin
          if (Control.Parent = nil) and not (Control is TWinControl) then
          begin
            GetCursorPos(StartPos);
            FDockRect.TopLeft := StartPos;
          end
          else
            FDockRect.TopLeft := Control.ClientToScreen(Point(0, 0));
          FDockRect.BottomRight := Point(FDockRect.Left + Control.Width,
            FDockRect.Top + Control.Height);
        end;
        FEraseDockRect := FDockRect;
      end;
    end;
    DragInit(DragObject, Immediate, Threshold);
  except
    DragControl := nil;
    raise;
  end;
end;

Could be the reason... So my question.

  1. Have anyone had similar problems with drag and drop ?
  2. If I detect DragControl = nil how can I cancel the current drag and drop ?

Edit: Currently I have no solution to this but I can add some more info about it. The grids is called supergrid. This is an internal component that we developed to suit our needs. It inherit TcxGrid from Devexpress. I think (but not sure) that this problem come when user drag a grid row at the same time the grid reload data. Somehow the the reference to the current row become nil. In the long term we have plans to replace this supergrid with a Bold aware grid (as we use Bold for Delphi) that also inherit from TcxGrid. Then the grid is updated as soon as the data is changed (no refresh by the user or in code) and hopefully this fix the problem.

like image 798
Roland Bengtsson Avatar asked Oct 23 '22 14:10

Roland Bengtsson


1 Answers

  1. No, I never had any (of these kind of) problems with drag and drop by VCL, and I have quite some experience with it.

  2. DragControl is local to the Controls unit, so how do you detect DragControl = nil within your production code? Normally, there is no need for checking it, at least I never had to. Cancelling a drag operation, other then by releasing the mouse on a no accepting target or by hitting ESC, is done by calling CancelDrag. And as you noticed yourself already, that routine calls DragDone only when DragObject <> nil. Thus appearantly DragObject being nil is already saying that there is no drag operation in progress (anymore).

Also, your observation that the source of the AV is from that specific line in Controls.DragTo appears to be wrong. In a normal drag and drop operation, DragControl being nil does not result in an AV. However, following Controls.DragFindTarget, it could be problematic in a drag and dock operation, but you did not mention doing any docking.

Could you please clarify in what situation, or with what code this 'bug' appears?

like image 144
NGLN Avatar answered Oct 29 '22 23:10

NGLN