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

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. Я думаю (но не уверен), что эта проблема возникает, когда пользователь перетаскивает строку сетки одновременно с данными перезагрузки сетки. Каким-то образом ссылка на текущий ряд становится нулевой. В долгосрочной перспективе у нас есть планы заменить эту суперсеть сеткой с поддержкой Bold (так как мы используем Bold для Delphi), которая также наследуется от TcxGrid. Затем сетка обновляется, как только данные изменяются (без обновления пользователем или в коде), и, надеюсь, это решит проблему.

1 ответ

  1. Нет, у меня никогда не было (такого рода) проблем с перетаскиванием с помощью VCL, и у меня есть некоторый опыт с этим.

  2. DragControl является локальным для блока управления, так как вы обнаружите DragControl = nil в вашем производственном коде? Обычно нет необходимости проверять это, по крайней мере, мне никогда не приходилось. Отмена операции перетаскивания, за исключением отпускания мыши на непринятой цели или нажатия ESC, выполняется путем вызова CancelDrag, И, как вы уже заметили, эти рутинные вызовы DragDone только когда DragObject <> nil, Таким образом, по-видимому DragObject nil уже говорит о том, что операция перетаскивания не выполняется (больше).

Кроме того, вы заметили, что источником AV является именно эта линия в Controls.DragTo кажется, неправильно. В обычной операции перетаскивания, DragControl являющийся nil не приводит к AV. Однако, следуя Controls.DragFindTarget, это может быть проблематично в операции перетаскивания и закрепления, но вы не упомянули о выполнении какой-либо стыковки.

Не могли бы вы уточнить, в какой ситуации или с каким кодом появляется эта "ошибка"?

Другие вопросы по тегам