D&D all columns virtual treeview

unit DRAG;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, ActiveX, Vcl.StdCtrls,
  Vcl.ButtonGroup, Vcl.ExtCtrls, Vcl.ToolWin, Vcl.ComCtrls, Vcl.Grids,
  Vcl.Outline, Vcl.WinXCtrls, Vcl.ActnMan, Vcl.ActnCtrls, Vcl.ActnMenus,
  System.Actions, Vcl.ActnList, Vcl.PlatformDefaultStyleActnCtrls, XML.XMLIntf,
  XML.XMLDoc;

type
  PItemNode1 = ^TItemNode1;

  TItemNode1 = record
    Name: String;
    Order: string;
  end;

type
  PItemNode2 = ^TItemNode2;

  TItemNode2 = record
    Name: String;
    Order: string;
  end;

type
  TForm1 = class(TForm)
    VT: TVirtualStringTree;
    VT2: TVirtualStringTree;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Timer1: TTimer;
    Splitter1: TSplitter;
    ActionManager1: TActionManager;
    ActionNew: TAction;
    ActionOpen: TAction;
    ActionSave: TAction;
    ActionSaveAs: TAction;
    ActionExit: TAction;
    ActionCopy: TAction;
    ActionPaste: TAction;
    ActionVisibleToolBar: TAction;
    ActionList1: TActionList;
    NewAction: TAction;
    OpenAction: TAction;
    SaveAction: TAction;
    SaveAsAction: TAction;
    ExitAction: TAction;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VT2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: string);
    procedure VT2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VT2InitNode(Sender: TBaseVirtualTree;
      ParentNode, Node: PVirtualNode;
      var InitialStates: TVirtualNodeInitStates);
    procedure VTDragDrop(Sender: TBaseVirtualTree; Source: TObject;
      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
      Pt: TPoint; var Effect: Integer; Mode: TDropMode);

    procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject;
      Formats: TFormatArray; Effect: Integer; Mode: TVTNodeAttachMode);
    procedure VTDragOver(Sender: TBaseVirtualTree; Source: TObject;
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
      var Effect: Integer; var Accept: Boolean);
    procedure VT2DragOver(Sender: TBaseVirtualTree; Source: TObject;
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
      var Effect: Integer; var Accept: Boolean);
    procedure VT2DragDrop(Sender: TBaseVirtualTree; Source: TObject;
      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
    procedure VT2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
    procedure VT2BeforeItemErase(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
      var ItemColor: TColor; var EraseAction: TItemEraseAction);
    procedure Button1Click(Sender: TObject);
    procedure VT2SaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Stream: TStream);
    procedure VT2LoadNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Stream: TStream);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: string);
    procedure VTInitNode(Sender: TBaseVirtualTree;
      ParentNode, Node: PVirtualNode;
      var InitialStates: TVirtualNodeInitStates);
    procedure StringToStream(const Astr: string; Stream: TStream);
    procedure StreamToString(var Astr: string; Stream: TStream);
    procedure RecordToXML(const Rec: PItemNode1; RootNode: IXMLNode);
    procedure XMLToRecord(var Rec: PItemNode2; RootNode: IXMLNode);
    procedure VTSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Stream: TStream);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  VT2.SaveToFile('mySave.feproj');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  VT2.LoadFromFile('mySave.feproj');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Node: PVirtualNode;
  i: Integer;
  ItemNode: PItemNode1;
begin
  VT.NodeDataSize := SizeOf(TItemNode1);
  VT2.NodeDataSize := SizeOf(TItemNode2);
  VT.RootNodeCount := 2;
  VT2.RootNodeCount := 10;
  {
    Node := VT.AddChild(VT.RootNode);
    if not(vsInitialized in Node.States) then
    VT.ReinitNode(Node, false);
    ItemNode := VT.GetNodeData(Node);
    ItemNode.Name := 'Узел';
    ItemNode.Order := '111'; }

end;

procedure TForm1.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject;
  Formats: TFormatArray; Effect: Integer; Mode: TVTNodeAttachMode);
var
  FormatAccepted: Boolean; // True, если принятые данные уже обработались
  i: Integer;
begin
  // Ищем в переданных форматах тот, который можем обработать
  FormatAccepted := false;
  for i := 0 to High(Formats) do
  begin
    if Formats[i] = CF_VIRTUALTREE then
    // Родной формат VT. Обрабатывает вставку своих же
    // TVirtualNode-узлов.
    begin
      if not FormatAccepted then
      begin
        Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, Mode);
        FormatAccepted := True;
      end;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  y, a: Integer;
  po, Cpo: TPoint;
  con: TControl;
begin
  { GetCursorPos(po);
    y:=po.y;
    po:=ScreenToClient(po);
    Cpo:=Form1.ClientOrigin;
    con:=Form1.ControlAtPos(po,True,True);
    if (con<>nil) and (y>Cpo.y) and (y<Cpo.y+Form1.ClientHeight) then begin
    if (con.Name='Panel1') or (con.Parent.Name='Panel1') then begin
    if Panel1.Left>Form1.ClientWidth-Panel1.Width then
    if Panel1.Left+Panel1.Width-3>Form1.ClientWidth then Panel1.Left:= Panel1.Left-3  //показать
    else Panel1.Left:=Form1.ClientWidth-Panel1.Width;
    end;
    end
    else begin
    a:=Form1.ClientWidth-7;
    if Panel1.Left<a then
    if Panel1.Left+3<a then Panel1.Left:= Panel1.Left+3 //убрать
    else Panel1.Left:=a;
    end; }
end;

procedure TForm1.VT2BeforeItemErase(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
  var ItemColor: TColor; var EraseAction: TItemEraseAction);
// The second tree uses manual drag and we want to show the lines which are allowed to start a drag operation by
// a colored background.

begin
  if Odd(Node.Index) then
  begin
    ItemColor := $FFEEEE;
    EraseAction := eaColor;
  end;
end;

procedure TForm1.VT2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := True;
end;

procedure TForm1.VT2DragDrop(Sender: TBaseVirtualTree; Source: TObject;
  DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
  Pt: TPoint; var Effect: Integer; Mode: TDropMode);
  procedure DetermineEffect;
  begin
    // Нажаты ли какие-нибудь управляющие клавиши?
    if Shift = [] then
    begin
      // Неа, не нажаты
      // Тогда, если отправитель и получатель - одинаковые объекты (например,
      // если узлы перемещаются из одного и того же дерева), то
      // надо переместить узлы, в противном случае - копировать.
      if Source = Sender then
        Effect := DROPEFFECT_MOVE
      else
        Effect := DROPEFFECT_COPY;
    end
    else
    begin
      // Нажаты. В зависмости от комбинации решаем что делать
      if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then
        Effect := DROPEFFECT_LINK
      else if Shift = [ssCtrl] then
        Effect := DROPEFFECT_COPY
      else
        // Effect := DROPEFFECT_MOVE;
    end;
  end;

var
  Attachmode: TVTNodeAttachMode;
  Nodes: TNodeArray;
  i: Integer;
begin
  Nodes := nil;
  // Определяем, куда добавлять узел в зависимости от того, куда была
  // брошена ветка.
  case Mode of
    dmAbove:
      Attachmode := amInsertBefore;
    dmOnNode:
      Attachmode := amAddChildLast;
    dmBelow:
      Attachmode := amInsertAfter;
  else
    Attachmode := amNowhere;
  end;
  if DataObject = nil then
  begin
    // Если не пришло интерфейса, то вставка проходит через VCL метод
    if Source is TVirtualStringTree then
    begin
      // Вставка из VT. Можем спокойно пользоваться его методами
      // копирования и перемещения.
      DetermineEffect;
      // Получаем список узлов, которые будут участвовать в Drag&Drop
      Nodes := VT2.GetSortedSelection(True);
      // И работаем с каждым
      if Effect = DROPEFFECT_COPY then
      begin
        for i := 0 to High(Nodes) do
          VT2.CopyTo(Nodes[i], Sender.DropTargetNode, Attachmode, false);
      end
      else
        for i := 0 to High(Nodes) do
          VT2.MoveTo(Nodes[i], Sender.DropTargetNode, Attachmode, false);
    end;
  end
  else
  begin
    // OLE drag&drop.
    // Effect нужен для передачи его источнику drag&drop, чтобы тот решил
    // что он будет делать со своими перетаскиваемыми данными.
    // Например, при DROPEFFECT_MOVE (перемещение) их нужно будет удалить,
    // при копировании - сохранить.
    if Source is TBaseVirtualTree then
      DetermineEffect
    else
    begin
      if Boolean(Effect and DROPEFFECT_COPY) then
        Effect := DROPEFFECT_COPY
      else
        Effect := DROPEFFECT_MOVE;
    end;
    InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect,
      Attachmode);
  end;
end;

procedure TForm1.VT2DragOver(Sender: TBaseVirtualTree; Source: TObject;
  Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
  var Effect: Integer; var Accept: Boolean);
// Возвращает True, если AParent - дочерний узел ANode.
  function IsNodeParent(AParent, ANode: PVirtualNode): Boolean;
  var
    NextParent: PVirtualNode;
  begin
    NextParent := AParent;
    repeat
      NextParent := NextParent.Parent;
    until (NextParent = Sender.RootNode) or (NextParent = nil) or
      (NextParent = ANode);
    Result := ANode = NextParent;
  end;

var
  i: Integer;
  Nodes: TNodeArray;
begin
  Accept := True;
  if (Assigned(Sender.DropTargetNode)) and
    (Sender.DropTargetNode <> Sender.RootNode) then
    Nodes := (Sender as TVirtualStringTree).GetSortedSelection(True);
  if Length(Nodes) > 0 then
  begin
    for i := 0 to Length(Nodes) - 1 do
    begin
      Accept :=
      // Узел не должен быть родителем ветки, в которую производится
      // вставка
        (not IsNodeParent(Sender.DropTargetNode, Nodes[i]))
      // Также, узел не должен равняться ветке-местоназначению вставки.
      // Т.е. мы должны запретить вставку узла в самого себя.
        and (not(Sender.DropTargetNode = Nodes[i]));
      // Отключаем вставку, если хотя бы одно из условий вернуло False
      if not Accept then
        Exit;
    end;
  end;
end;

procedure TForm1.VT2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  ItemNode: PItemNode2;

begin
  ItemNode := Sender.GetNodeData(Node);
  if Assigned(ItemNode) then
  begin
    case Column of
      0:
        CellText := ItemNode^.Name;
      1:
        CellText := ItemNode^.Order;
    end;
  end;
end;

procedure TForm1.VT2InitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  ItemNode: PItemNode2;
begin
  ItemNode := Sender.GetNodeData(Node);
  if Assigned(ItemNode) then
    if Length(ItemNode^.Name) = 0 then
      ItemNode^.Name := 'Node Index № ' + IntToStr(Node.Index);
  ItemNode^.Order := IntToStr(Node.Index);
end;

procedure TForm1.VT2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; NewText: string);
var
  ItemNode: PItemNode2;
begin
  { ItemNode := Sender.GetNodeData(Node);
    if Assigned(ItemNode) then
    begin
    case Column of
    0:
    ItemNode^.Name := NewText;
    1:
    ItemNode^.Order := NewText;
    end;
    Label1.Caption := ItemNode^.Order;
    end; }
end;

procedure TForm1.VTDragDrop(Sender: TBaseVirtualTree; Source: TObject;
  DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
  Pt: TPoint; var Effect: Integer; Mode: TDropMode);
{$REGION 'ЗАКОМЕНЧЕНА процедура DetermineEffect'}
// Определяем как поступать с данными. Перемещать, копировать или ссылаться
{ procedure DetermineEffect;
  begin
  // Нажаты ли какие-нибудь управляющие клавиши?
  if Shift = [] then
  begin
  // Неа, не нажаты
  // Тогда, если отправитель и получатель - одинаковые объекты (например,
  // если узлы перемещаются из одного и того же дерева), то
  // надо переместить узлы, в противном случае - копировать.
  if Source = Sender then
  Effect := DROPEFFECT_MOVE
  else
  Effect := DROPEFFECT_COPY;
  end
  else begin
  // Нажаты. В зависмости от комбинации решаем что делать
  if Shift = [ssCtrl] then
  Effect := DROPEFFECT_COPY
  else
  // Effect := DROPEFFECT_MOVE;
  end;
  end;
}
{$ENDREGION}
var
  Attachmode: TVTNodeAttachMode;
  Nodes: TNodeArray;
  i: Integer;
begin
  Nodes := nil;
  // Определяем, куда добавлять узел в зависимости от того, куда была
  // брошена ветка.
  case Mode of
    dmAbove:
      Attachmode := amInsertBefore;
    dmOnNode:
      Attachmode := amAddChildLast;
    dmBelow:
      Attachmode := amInsertAfter;
  else
    // AttachMode := amNowhere;
  end;
{$REGION 'ЗАКОМЕНЧЕНО'}
  { if DataObject = nil then
    begin
    // Если не пришло интерфейса, то вставка проходит через VCL метод
    if Source is TVirtualStringTree then
    begin
    // Вставка из VT. Можем спокойно пользоваться его методами
    // копирования и перемещения.
    DetermineEffect;
    // Получаем список узлов, которые будут участвовать в Drag&Drop
    Nodes := VT2.GetSortedSelection(True);
    // И работаем с каждым
    if Effect = DROPEFFECT_COPY then
    begin
    for i := 0 to High(Nodes) do
    VT2.CopyTo(Nodes[i], Sender.DropTargetNode, AttachMode, False);
    end
    else
    for i := 0 to High(Nodes) do
    VT2.MoveTo(Nodes[i], Sender.DropTargetNode, AttachMode, False);
    end;
    // else if Source is TListBox then
    // begin
    // Вставка из объекта какого-то другого класса
    //    AddVCLText(Sender as TVirtualStringTree,
    //      (Source as TListBox).Items.Strings[(Source as TListBox).ItemIndex],
    //      AttachMode);
    //  end;
    end
    else begin }
  // OLE drag&drop.
  // Effect нужен для передачи его источнику drag&drop, чтобы тот решил
  // что он будет делать со своими перетаскиваемыми данными.
  // Например, при DROPEFFECT_MOVE (перемещение) их нужно будет удалить,
  // при копировании - сохранить.
{$ENDREGION}
  if Source is TBaseVirtualTree then
{$REGION 'И еще вот тут закоменчено'}
    // DetermineEffect;
    { else begin
      if Boolean(Effect and DROPEFFECT_COPY) then
      Effect := DROPEFFECT_COPY
      else
      Effect := DROPEFFECT_MOVE;
      end; }
{$ENDREGION}
    InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect,
      Attachmode);
end;
// end;

// -----------------------------------------------------------------------------
// ---------------------------------------------------------------------------
// В этом событии мы должны проверить есть ли среди перетаскиваемых веток
// родитель ветки, в которую происходит перетаскивание. Ведь нельзя
// же ветку-родитель перетащить в ее дочерние элементы
// ---------------------------------------------------------------------------

procedure TForm1.VTDragOver(Sender: TBaseVirtualTree; Source: TObject;
  Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
  var Effect: Integer; var Accept: Boolean);

// Возвращает True, если AParent - дочерний узел ANode.
  function IsNodeParent(AParent, ANode: PVirtualNode): Boolean;
  var
    NextParent: PVirtualNode;
    ItemNode: PItemNode1;
  begin
    NextParent := AParent;
{$REGION 'определение иемения взятого узла'}
    ItemNode := Sender.GetNodeData(ANode);
    if Assigned(ItemNode) then
      if ItemNode^.Name = 'Node Index № 0' then
        Form1.Caption := 'МЫ ВЗЯЛИ УЗЕЛ под названием' + ItemNode^.Name;
{$ENDREGION}
    repeat
      NextParent := NextParent.Parent;
    until (NextParent = Sender.RootNode) or (NextParent = nil) or
      (NextParent = ANode);
    Result := ANode = NextParent;
  end;

var
  i: Integer;
  Nodes: TNodeArray;
begin
  Accept := True;
  if (Assigned(Sender.DropTargetNode)) and
    (Sender.DropTargetNode <> Sender.RootNode) then
    Nodes := (Sender as TVirtualStringTree).GetSortedSelection(True);
  if Length(Nodes) > 0 then
  begin
    for i := 0 to Length(Nodes) - 1 do
    begin
      Accept :=
      // Узел не должен быть родителем ветки, в которую производится
      // вставка
        (not IsNodeParent(Sender.DropTargetNode, Nodes[i]))
      // Также, узел не должен равняться ветке-местоназначению вставки.
      // Т.е. мы должны запретить вставку узла в самого себя.
        and (not(Sender.DropTargetNode = Nodes[i]));
      // Отключаем вставку, если хотя бы одно из условий вернуло False
      if not Accept then
        Exit;
    end;
  end;
end;

procedure TForm1.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  ItemNode: PItemNode1;
begin

  ItemNode := Sender.GetNodeData(Node);
  if Assigned(ItemNode) then

    case Column of
      0:
        CellText := ItemNode^.Name;
      1:
        begin
          // ItemNode^.Order:=111;
          CellText := ItemNode^.Order;
        end;
    end;
end;

procedure TForm1.VTInitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  ItemNode: PItemNode1;
begin
  ItemNode := Sender.GetNodeData(Node);
  if Assigned(ItemNode) then
    if Length(ItemNode^.Name) = 0 then
      ItemNode^.Name := 'VT1_Node № ' + IntToStr(Node.Index);
  ItemNode^.Order := IntToStr(Node.Index);
end;

procedure TForm1.VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; NewText: string);
var
  ItemNode: PItemNode1;
begin
  ItemNode := Sender.GetNodeData(Node);
  if Assigned(ItemNode) then
    ItemNode^.Name := NewText;
end;

// ---------------------------------------------------------------------------
// Метод для сохранения данных из строковой переменной в поток
// ---------------------------------------------------------------------------
procedure TForm1.StringToStream(const Astr: string; Stream: TStream);
var
  Bytes: TBytes;
  i: Integer;
begin
  Bytes := TEncoding.UTF8.GetBytes(Astr);
  i := Length(Bytes);
  Stream.Write(i, SizeOf(Integer));
  if i > 0 then
    Stream.WriteBuffer(Bytes[0], i);
end;

// ---------------------------------------------------------------------------
// Метод для сохранения данных потока в строковую переменную
// ---------------------------------------------------------------------------
procedure TForm1.StreamToString(var Astr: string; Stream: TStream);
var
  Bytes: TBytes;
  i: Integer;
begin
  Stream.Read(i, SizeOf(Integer));
  SetLength(Bytes, i);
  if i > 0 then
    Stream.ReadBuffer(Bytes[0], i);

  Astr := TEncoding.UTF8.GetString(Bytes);
end;

// ---------------------------------------------------------------------------
// Метод для сохранения данных из нашей структуры в XML
// ---------------------------------------------------------------------------
procedure TForm1.RecordToXML(const Rec: PItemNode1; RootNode: IXMLNode);
begin
  RootNode.AddChild('Name').Text := Rec^.Name; // вот здесь в отладчике возникает исключение.
                                               // Если ставлю вот так RootNode.AddChild('Name').Text := 'lalala';
                                               // то исключение не возникает, но возникает в методе XMLToRecord
  // RootNode.AddChild('Order').Text:=Rec^.Order;
end;

// ---------------------------------------------------------------------------
// Метод для сохранения данных из XML в нашу структуру
// ---------------------------------------------------------------------------
procedure TForm1.XMLToRecord(var Rec: PItemNode2; RootNode: IXMLNode);
begin
  Rec^.Name := RootNode.ChildNodes.FindNode('Name').Text;
  // Rec.Order:=RootNode.ChildNodes.FindNode('Order').Text;
end;

// ---------------------------------------------------------------------------
// Метод VT1_SaveNode ИСТОЧНИК
// ---------------------------------------------------------------------------
procedure TForm1.VTSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Stream: TStream);
var
  XML: IXMLDocument;
  XMLNode: IXMLNode;
  Rec: PItemNode1;
  s: string;
begin
  XML := NewXMLDocument;
  XMLNode := XML.AddChild('root');
  // тут получаем нужный record из Sender-а, и потом:
  RecordToXML(Rec, XMLNode); // записали в XML-контейнер

  XML.SaveToXML(s);
  StringToStream(s, Stream); // всё, наш контейнер с данными ушел блуждать
  // по внутренностям механизма Drag&Drop
end;

// ---------------------------------------------------------------------------
// Метод VT2_LoadNode    ПРИЕМНИК
// ---------------------------------------------------------------------------
procedure TForm1.VT2LoadNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Stream: TStream);
var
  Reader: TReader;
  NewNode: PItemNode2;

  XML: IXMLDocument;
  XMLNode: IXMLNode;
  Rec: PItemNode2;
  s: string;
begin
  {
    //загрузка дерева из файла. Сохранение см. VT2_SaveNode
    Reader := TReader.Create(Stream, 1024);
    NewNode := Sender.GetNodeData(Node);
    NewNode.Name := Reader.ReadString;
    NewNode.Order := Reader.ReadString;
    FreeAndNil(Reader); }

  // Stream.Position:=0;
  StreamToString(s, Stream);
  // возможно - перед этим стоит сделать Stream.Position:=0;
  XML := LoadXMLData(s);
  XMLNode := XML.DocumentElement;
  // получаем Rec и потом:
  XMLToRecord(Rec, XMLNode);

end;

// ---------------------------------------------------------------------------
// Метод VT2_SaveNode    Для сохранения дерева в файл
// ---------------------------------------------------------------------------
procedure TForm1.VT2SaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Stream: TStream);
var
  Writer: TWriter;
  NewNode: PItemNode2;
begin
{
  Writer := TWriter.Create(Stream, 8096);
  NewNode := Sender.GetNodeData(Node);
  Writer.WriteString(NewNode.Name);
  Writer.WriteString(NewNode.Order);
  FreeAndNil(Writer);

}
end;

end.