Пытаюсь реализовать Drag&Drop в VirtualStringTree, но узлы не драгаются. Разрешил, обработчики сделал, не пойму что не так. Заполняется событием OnGetText.
procedure TfrFuelKinds.vstFuelKindsDragAllowed(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := True;
end;
procedure TfrFuelKinds.vstFuelKindsDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
pSource, pTarget: PVirtualNode;
attMode: TVTNodeAttachMode;
begin
pSource := TVirtualStringTree(Source).FocusedNode;
pTarget := Sender.DropTargetNode;
case Mode of
dmNowhere: attMode := amNoWhere;
dmAbove: attMode := amInsertBefore;
dmOnNode, dmBelow: attMode := amInsertAfter;
end;
Sender.MoveTo(pSource, pTarget, attMode, False);end;
procedure TfrFuelKinds.vstFuelKindsDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
Accept := (Sender = Source) and (Sender.DropTargetNode <> Sender.FocusedNode);
end;