Ошибка в 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;
Может быть причина... Так что мой вопрос.
- У кого-нибудь были похожие проблемы с перетаскиванием?
- Если я обнаружу DragControl = nil, как я могу отменить текущее перетаскивание?
Изменить: В настоящее время у меня нет решения этой проблемы, но я могу добавить дополнительную информацию об этом. Сетка называется суперсетка. Это внутренний компонент, который мы разработали для удовлетворения наших потребностей. Он наследует TcxGrid от Devexpress. Я думаю (но не уверен), что эта проблема возникает, когда пользователь перетаскивает строку сетки одновременно с данными перезагрузки сетки. Каким-то образом ссылка на текущий ряд становится нулевой. В долгосрочной перспективе у нас есть планы заменить эту суперсеть сеткой с поддержкой Bold (так как мы используем Bold для Delphi), которая также наследуется от TcxGrid. Затем сетка обновляется, как только данные изменяются (без обновления пользователем или в коде), и, надеюсь, это решит проблему.
1 ответ
Нет, у меня никогда не было (такого рода) проблем с перетаскиванием с помощью VCL, и у меня есть некоторый опыт с этим.
DragControl
является локальным для блока управления, так как вы обнаружитеDragControl = nil
в вашем производственном коде? Обычно нет необходимости проверять это, по крайней мере, мне никогда не приходилось. Отмена операции перетаскивания, за исключением отпускания мыши на непринятой цели или нажатия ESC, выполняется путем вызоваCancelDrag
, И, как вы уже заметили, эти рутинные вызовыDragDone
только когдаDragObject <> nil
, Таким образом, по-видимомуDragObject
nil уже говорит о том, что операция перетаскивания не выполняется (больше).
Кроме того, вы заметили, что источником AV является именно эта линия в Controls.DragTo
кажется, неправильно. В обычной операции перетаскивания, DragControl
являющийся nil
не приводит к AV. Однако, следуя Controls.DragFindTarget
, это может быть проблематично в операции перетаскивания и закрепления, но вы не упомянули о выполнении какой-либо стыковки.
Не могли бы вы уточнить, в какой ситуации или с каким кодом появляется эта "ошибка"?