Delphi VCL中的Bug拖放?

Rol*_*son 5 delphi drag-and-drop delphi-2007 bold-delphi

我使用Delphi 2007编译的应用程序在网格之间拖放,并且它在大多数情况下都能正常工作.但有时我会随机获得Access违规.我在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);
Run Code Online (Sandbox Code Playgroud)

异常发生在最后一行,因为DragControl为零.DragControl是TControl类型的全局变量.我尝试使用assigncheck修补此方法,如果DragControl = nil则调用CancelDrag,但这也失败,因为DragObject也是nil.

procedure CancelDrag;
begin
 if DragObject <> nil then DragDone(False);
 DragControl := nil;
end;
Run Code Online (Sandbox Code Playgroud)

为了找出为什么DragControl为零,我检查了DragInitControl.如果DragControl为零,则有两行刚刚退出.

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;
Run Code Online (Sandbox Code Playgroud)

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

  1. 有没有人有类似的拖放问题?
  2. 如果我检测到DragControl = nil怎么能取消当前的拖放?

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

NGL*_*GLN 3

  1. 不,我从来没有遇到过任何(此类)VCL 拖放问题,而且我对此有相当多的经验。

  2. DragControl是控制单元本地的,那么您如何DragControl = nil在生产代码中进行检测?一般情况下,没有必要去检查,至少我从来没有必要去检查。取消拖动操作,除了在不接受的目标上释放鼠标或点击 之外ESC,还可以通过调用 来完成CancelDrag。正如您已经注意到的那样,该例程DragDone仅在以下情况下调用DragObject <> nil。因此,表面上DragObject为零已经表明没有正在进行的拖动操作(不再)。

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

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