Moja aplikacja skompilowana z Delphi 2007 ma funkcję przeciągania i upuszczania między siatkami i działa dobrze przez większość czasu. Ale czasami losowo dostałem naruszenie dostępu. I debugowałem go do metody Controls.pas DragTo w VCL.Błąd w Delphi VCL Drag and Drop?
Zaczyna się tak:
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);
Wyjątkiem dzieje w ostatnim rzędzie, ponieważ DragControl jest zerowa. DragControl jest globalną zmienną typu TControl. Próbowałem łatać tę metodę przy pomocy polecenia assigncheck i wywołać CancelDrag jeśli DragControl = nil, ale to również się nie powiedzie, ponieważ DragObject również jest zerowe.
procedure CancelDrag;
begin
if DragObject <> nil then DragDone(False);
DragControl := nil;
end;
Aby dowiedzieć się, dlaczego DragControl jest zerowy Sprawdziłem DragInitControl. Istnieją 2 linie, które kończą się po usunięciu 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;
Może to być powodem ... Moje pytanie.
- Czy ktoś miał podobne problemy z przeciąganiem i upuszczaniem?
- Jeśli wykryję DragControl = zero, w jaki sposób mogę anulować bieżące przeciąganie i upuszczanie?
Edit: Obecnie nie mam na to rozwiązanie, ale można dodać trochę więcej informacji na ten temat. Siatki nazywa się supergrid. Jest to wewnętrzny komponent, który opracowaliśmy, aby odpowiadał naszym potrzebom. Dziedziczy TcxGrid z Devexpress. Myślę (ale nie jestem pewien), że problem ten pojawia się, gdy użytkownik przeciąga wiersz siatki w tym samym czasie, gdy dane przeładowują sieć. W jakiś sposób odniesienie do bieżącego wiersza staje się zerowe. W dłuższej perspektywie mamy zamiar zastąpić tę supergrid świadomą siatką Bold (jak używamy Bold dla Delphi), która również dziedziczy z TcxGrid. Następnie siatka jest aktualizowana natychmiast po zmianie danych (brak odświeżania przez użytkownika lub kod) i mam nadzieję, że to rozwiąże problem.
Czy rozważałeś interakcję z rozszerzeniami Shell? Stawiłem czoła podobnemu problemowi używając TOpenDialog. – menjaraz
Doskonałe pytanie. Nie mam doświadczenia z wykorzystaniem wbudowanego mechanizmu przeciągania i upuszczania VCL z kontroli do sterowania, ale gdybym tego potrzebował, wypróbowałbym kod A. Melandera zamiast gołego VCL dla tego obszaru tematycznego i sprawdziłbym, czy jest wersja demonstracyjna i niektóre kod tutaj, który jest bardziej solidny; http://melander.dk/delphi/dragdrop/ –
Miałem podobne problemy z drag and drop (delphi 2007 też). ale dziwnie ten problem pojawia się tylko (i często) przy zdalnym uruchomieniu programu z "netviewer". – DamienD