Delphi VCL 拖放中的错误？答案

【问题标题】：Bug in Delphi VCL Drag and Drop?Delphi VCL 拖放中的错误？
【发布时间】：2011-12-23 12:24:07
【问题描述】：

我用 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 为 nil。 DragControl 是 TControl 类型的全局变量。我尝试使用 assigncheck 修补此方法并在 DragControl = nil 时调用 CancelDrag，但这也失败了，因为 DragObject 也是 nil。

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

为了找出 DragControl 为 nil 的原因，我检查了 DragInitControl。如果 DragControl 为 nil，则有 2 行将退出。

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;

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

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

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

【问题讨论】：

您考虑过与Shell 扩展的交互吗？我使用 TOpenDialog 遇到了类似的问题。
很好的问题。我没有使用 VCL 内置拖放从控件到控件的经验，但如果我确实需要这样做，我会尝试 A. Melander 的代码，而不是这个主题领域的裸 VCL，看看是否有演示和一些这里的代码更可靠； melander.dk/delphi/dragdrop
我在拖放时遇到了类似的问题（delphi 2007 也是）。但奇怪的是，这种问题仅在使用“netviewer”远程运行程序时出现（并且经常出现）。
我可以确认，我遇到了类似的问题，并且确实与“当用户在网格重新加载数据的同时拖动网格行时出现问题”有关。当我在完成 DD 后放弃数据重新加载时，AV 消失了。

标签： delphi drag-and-drop delphi-2007 bold-delphi

【解决方案1】：

不，我在使用 VCL 拖放时从来没有遇到过任何（这类）问题，而且我对此有相当的经验。
DragControl 是控制单元本地的，那么如何在生产代码中检测到DragControl = nil？通常情况下，不需要检查它，至少我从来不需要。通过调用CancelDrag 来取消拖动操作，除了通过在不接受的目标上释放鼠标或点击ESC 来完成。正如您已经注意到的那样，该例程仅在DragObject <> nil 时才调用DragDone。因此，显然DragObject 为 nil 已经表示没有正在进行的拖动操作（不再）。

此外，您认为 AV 的来源来自 Controls.DragTo 中的特定行的观察似乎是错误的。在正常的拖放操作中，DragControl 成为 nil 不会产生 AV。但是，在Controls.DragFindTarget 之后，在拖放操作中可能会出现问题，但是您没有提及进行任何停靠。

您能否澄清一下这个“错误”是在什么情况下出现的，或者是用什么代码出现的？

【讨论】：