Ошибка в Delphi VCL Drag and Drop? - PullRequest
Новая
       31

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

5 голосов
/ 23 декабря 2011

Мое приложение, скомпилированное с 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 =ноль, как я могу отменить текущее перетаскивание?

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

1 Ответ

3 голосов
/ 24 декабря 2011

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

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

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

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

...