FAQ VCL
Компоненты\VirtualTreeView

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как запретить сворачивание/разворачивание узлов по двойному клику мыши?

VirtualStringTree1.TreeOptions.MiscOptions := VirtualStringTree1.TreeOptions.MiscOptions - [toToggleOnDblClick];


Как включить перетаскивание нода путем клика на любом месте ветки, а не только в области текста?

VirtualStringTree1.TreeOptions.MiscOptions := VirtualStringTree1.TreeOptions.MiscOptions + [toFullRowDrag];


Как в 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;


Как в VirtualTreeView избавиться от автоматической прокрутки по горизонтали при клике на строке, не помещается на экране по ширине?

VirtualStringTree1.TreeOptions.AutoOptions := VirtualStringTree1.TreeOptions.AutoOptions + [toDisableAutoscrollOnFocus];

При использовании материала - ссылка на сайт обязательна