Как в VirtualTreeView пеpетаскивать итемы?
uses
{...,} ActiveX;
type
TForm1 = class(TForm)
VirtualStringTree1: TVirtualStringTree;
procedure FormCreate(Sender: TObject);
procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
procedure VirtualStringTree1DragAllowed(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure VirtualStringTree1DragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
procedure VirtualStringTree1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure VirtualStringTree1InitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
private
FDragNode: PVirtualNode;
public
{ Public declarations }
end;
{...}
implementation
{...}
procedure TForm1.FormCreate(Sender: TObject);
begin
VirtualStringTree1.RootNodeCount := 100;
// VirtualTree поддерживает так же и OLE Drag&Drop, поэтому явно указываем,
// что будем исполользовать механизм, реализованный в VCL
VirtualStringTree1.DragType := dtVCL;
VirtualStringTree1.NodeDataSize := SizeOf( Integer );
VirtualStringTree1.TreeOptions.MiscOptions :=
VirtualStringTree1.TreeOptions.MiscOptions + [toFullRowDrag];
Randomize;
end;
procedure TForm1.VirtualStringTree1InitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
PInteger( Sender.GetNodeData( Node ) )^ := Random( 100 );
end;
procedure TForm1.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
begin
CellText := 'Node# ' + IntToStr( PInteger( Sender.GetNodeData( Node ) )^ );
end;
procedure TForm1.VirtualStringTree1DragAllowed(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
FDragNode := Node;
// Указываем, что данный узел можно drag'ать
Allowed := True;
end;
procedure TForm1.VirtualStringTree1DragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
// Drop'ать узел сам на себя нельзя
Accept := VirtualStringTree1.GetNodeAt( Pt.x, Pt.y ) <> FDragNode;
end;
procedure TForm1.VirtualStringTree1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
Node: PVirtualNode;
begin
Node := VirtualStringTree1.GetNodeAt( Pt.x, Pt.y );
if Node = FDragNode then
Exit;
case Mode of
dmOnNode, dmBelow: VirtualStringTree1.MoveTo( FDragNode, Node, amInsertAfter, False );
dmAbove: VirtualStringTree1.MoveTo( FDragNode, Node, amInsertBefore, False );
end;
FDragNode := nil;
end;
|