VirtualStringTree-Nachladen erst bei Bedarf

[hsbc]

So, ich habe deinen Vorschlag einmal versucht, jedoch erhalte ich viele Fehlermeldungen. Irgendetwas wichtiges muss ich hier noch vergessen haben, komme aber leider nicht dahinter. Vielleicht kannst du mir nochmals auf die Sprünge helfen. Auf der Form ist momentan nur ein VirtualStringTree mit dem Namen vstDirs. Hier mein Code:

Delphi-Quellcode:

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ContNrs, VirtualTrees;

type
  TDirList = class;
  TDirItem = class;

  TDirItem = class(TObject)
  private
    FSubDirs : TDirList;
    FName    : string;
    FFullPath: string;
  public
    procedure FillSubDirs;

    property Name: string read FName;
    property FullPath: string read FFullPath;
    property SubDirs: TDirList read FSubDirs;
  end;

  TDirList = class(TObject)
  private
    FItems: TObjectList; { of TDirItem }
  public
    procedure Add(AItem: TDirItem);
    procedure Clear;
    property Count: Integer read GetCount;
    property Items[Index: integer]: TDirItem read GetItem; default;
  end;

  PNodeData = ^TNodeData;
  TNodeData = record
    Item: TDirItem;
  end;

  TForm1 = class(TForm)
    vstDirs: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure vstDirsInitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure vstDirsInitChildren(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var ChildCount: Cardinal);
  private
    { Private-Deklarationen }
    FRoot: TDirItem;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FRoot := TDirItem.Create('D', 'D');
  FRoot.FillSubDirs;

  vstDirs.NodeDataSize := SizeOf(TNodeData);
  vstDirs.RootNodeCount := FRoot.SubDirs.Count;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FRoot.Free;
end;

procedure TForm1.vstDirsInitNode(Sender: TBaseVirtualTree; ParentNode,
  Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  Data: PNodeData;
  ParentData: PNodeData;
begin
  State := State + [isHasChildren];
  Data := Sender.GetNodeData(Node);
  if vstDirs.GetNodeLevel(Node) = 0 then
    Data.Item := FRoot.SubDirs[Node.Index]
    else begin
      ParentData := Sender.GetNodeData(ParentNode);
      Data.Item := ParentData.Item.SubDirs[Node.Index];
    end;
end;

procedure TForm1.vstDirsInitChildren(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var ChildCount: Cardinal);
var
  Data: PNodeData;
begin
  Data := Sender.GetNodeData(Node);
  Data.Item.FillSubDirs();
  ChildCount := Data.SubDirs.Count;
end;

procedure TDirItem.FillSubDirs;
var
  sr: TSearchRec;
begin
  SubDirs.Clear;
  if FindFirst(FullPath + '\*', faDirectory, sr) = 0 then
  try
    repeat
      if (sr.Name <> '.') and (sr.Name <> '..') then
        SubDirs.Add(TDirItem.Create(FullPath + '\' + sr.Name, sr.Name));
    until FindNext(sr) <> 0;
  finally
    FindClose(sr);
  end;
end;

procedure TDirList.Add(aItem: TDirItem);
begin
;
end;

procedure TDirList.Clear;
begin
;
end;

end.

mfg
Herbert