Ошибка в Delphi VCL Drag and Drop?

В моем приложении, скомпилированном с помощью Delphi 2007, есть перетаскивание между сетками, и в большинстве случаев оно работает нормально. Но иногда случайно получалось нарушение доступа. Я отлаживал его в Controls.pas методом DragTo в VCL.

Это начинается так:

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 и вызвать CancelDrag, если DragControl = nil, но это не удалось еще и потому, что DragObject также равен нулю.

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

Чтобы выяснить, почему значение 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;

Может быть причина ... Итак, мой вопрос.

  1. Были ли у кого-нибудь подобные проблемы с перетаскиванием?
  2. Если я обнаружил, что DragControl = nil, как я могу отменить текущее перетаскивание?

Изменить: В настоящее время у меня нет решения этой проблемы, но я могу добавить дополнительную информацию об этом. Сетка называется суперсеткой. Это внутренний компонент, который мы разработали в соответствии с нашими потребностями. Он наследует TcxGrid от Devexpress. Я думаю (но не уверен), что эта проблема возникает, когда пользователь перетаскивает строку сетки одновременно с перезагрузкой данных сетки. Каким-то образом ссылка на текущую строку стала нулевой. В долгосрочной перспективе у нас есть планы заменить эту суперсетку сеткой, поддерживающей полужирный шрифт (поскольку мы используем полужирный шрифт для Delphi), которая также наследуется от TcxGrid. Затем сетка обновляется, как только данные изменяются (без обновления пользователем или в коде), и, надеюсь, это решит проблему.

5
задан Roland Bengtsson 9 January 2017 в 12:06
поделиться