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