Delphi VCL拖放功能存在Bug？

Question

我应用程序是使用Delphi 2007编译的，其中包含网格之间的拖放功能，大多数时候运行正常。但有时会出现“访问冲突”的错误。我进行了调试，并定位到了VCL中Controls.pas方法DragTo。

代码如下：

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);

异常发生在最后一行，因为DragControl为空。DragControl是一个类型为TControl的全局变量。 我已经尝试使用assigncheck来修补此方法，并在DragControl = nil时调用CancelDrag，但这也失败了，因为DragObject也为空。

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

为了找出DragControl为什么是nil，我检查了DragInitControl。如果DragControl是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;

可能是因为...所以我的问题是。

1. 有人遇到过拖放的类似问题吗？
2. 如果我检测到DragControl = nil，如何取消当前的拖放操作？

编辑： 目前我没有解决方案，但我可以添加一些关于它的更多信息。这个网格被称为超级网格。这是我们开发的内部组件，以满足我们的需求。它继承了Devexpress的TcxGrid。我认为（但不确定）当用户同时拖动网格行并重新加载数据时，就会出现这个问题。某种方式，对当前行的引用变为nil。长期来看，我们计划用一个Bold感知网格（因为我们使用Delphi的Bold）替换这个超级网格，它也继承自TcxGrid。然后，网格在数据更改时立即更新（用户或代码中没有刷新），希望这样能解决问题。

- Roland Bengtsson

---

你考虑过与Shell扩展的交互吗？我使用TOpenDialog时遇到了类似的问题。 - menjaraz

非常好的问题。我没有使用VCL内置的从控件到控件的拖放经验，但如果我确实需要这样做，我会尝试A. Melander的代码，而不是裸的VCL来处理这个主题，并查看是否有演示和一些更可靠的代码; http://melander.dk/delphi/dragdrop/ - Warren P

我在拖放方面也遇到了类似的问题（Delphi 2007）。但奇怪的是，这种问题只有在使用“Netviewer”远程运行程序时才会出现（而且经常出现）。 - DamienD

我可以确认，我曾经遇到过类似的问题，确实与“当用户同时拖动网格行并重新加载数据时出现问题”有关。当我在DD完成后放弃了数据重新加载时，AV就消失了。 - TomR

Answer 1

1. 不，我从未在VCL中遇到过拖放问题，并且我对此有相当多的经验。

2. DragControl是局部于Controls单元的，那么你如何在生产代码中检测DragControl = nil？通常情况下，不需要检查它，至少我从来没有遇到过这种情况。取消拖动操作除了通过在不接受目标上释放鼠标或按下ESC之外，还可以通过调用CancelDrag来完成。正如你自己已经注意到的那样，只有在DragObject <> nil时，该例程才会调用DragDone。因此，显然，DragObject为nil已经说明没有正在进行的拖动操作。

此外，你观察到AV源自Controls.DragTo中的特定行似乎是错误的。在正常的拖放操作中，DragControl为nil不会导致AV。但是，在执行Controls.DragFindTarget后，它可能在拖动和停靠操作中引起问题，但你并没有提到进行任何停靠操作。

请问在什么情况下或使用什么代码会出现此“错误”？

- NGLN