VirtualStringTree-Nachladen erst bei Bedarf

[hsbc]

Hallo allerseits,

ich lese ein Server-Verzeichnis mit FTP ein und lege die einzelnen Verzeichnisse in einem VST ab. Funktioniert auch einwandfrei, nur dass bei einer grösseren Anzahl an Verzeichnissen die Zeit sehr lange ist.

Gibt es beim VST eine Einstellungsmöglichkeit, wo man z.B. nur die erste Ebene einlesen kann und erst bei Bedarf (z.B. Klick auf ein + (Pluszeichen) diesen Zweig nachlesen kann, bzw. wie könnte man das Problem sonst noch lösen?

mfg
Herbert

[DeddyH]

Wieso Einstellungsmöglichkeit? Du liest die Verzeichnisse ja selbst ein, dann hol Dir halt zunächst nur die erste Ebene und füge zu jedem Knoten einen "Dummy"-Eintrag hinzu, damit das Plus-Zeichen erscheint. Ich hab gerade keinen VST zur Hand, aber dort gibt es AFAIR doch auch ein OnExpand-Ereignis. In diesem lädst Du nun dynamisch nach und entfernst den Dummy-Eintrag wieder.

[jbg]

Zitat:

Zitat von DeddyH

und füge zu jedem Knoten einen "Dummy"-Eintrag hinzu, damit das Plus-Zeichen erscheint.

Wenn man mit OnInitNode und OnInitChildren arbeitet, ist das gar nicht notwendig. Bei OnInitNode stetzt man einfach das "HasChildren" Flag in the "States" und hat das Plus-Symbol. Im OnInitChildren, das einmal für den Parent-Knoten aufgerufen wird, wenn der Benutzer den Knoten öffnet, ermittelt man dann die nächste Ebene und legt die in der eigenen Datenstruktur ab. Für jeden Child-Knoten wird dann wiederum OnInitNode aufgerufen, in dem die eigene Datenstruktur an den Knoten gebunden wird.

Pseudocode:

Delphi-Quellcode:

type
  TDirList = class;
  TDirItem = class;

  TDirItem = class(TObject)
  privtae
    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)
  ...
  private
    FRoot: TDirItem;
  end;

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

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

procedure TForm1.FormDestroy(...);
begin
  //vstDirs.RootNodeCount := 0;
  FRoot.Free;
end;

procedure TForm1.VstInitNode(...);
var
  Data: PNodeData;
  ParentData: PNodeData;
begin
  State := State + [isHasChildren]; // Damit OnInitChildren aufgerufen werden kann und [+] angezeigt wird

  Data := Sender.GetNodeData(Node);
  if GetNodeLevel(Node) = 0 then // erste Ebene
    Data.Item := FRoot.SubDirs[Node.Index] // die im OnCreate oder sonstwo gefüllte DirList nutzen
  else
  begin 
    // Die DirList
    ParentData := Sender.GetNodeData(ParentNode);
    Data.Item := ParentData.Item.SubDirs[Node.Index];
  end;
end;

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

{ TDirItem }

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;

[hsbc]

Vielen herzlichen Dank für die Vorschläge.
Werde mich gleich mal darüberstürzen ...

mfg
Herbert

[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

[jbg]

Zitat:

Zitat von hsbc

jedoch erhalte ich viele Fehlermeldungen

Das liegt wohl daran, dass ich weder Konstruktoren, Destruktoren und sonstigen Verwaltungscode hingeschrieben habe. Zudem habe ich den Code hier direkt im Forum geschrieben, womit er nicht mal "kompiliert" ist.

Zitat:

Delphi-Quellcode:

  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;

Du brauchst den Konstruktor und den Destruktor hier, der auch FSubDirs erstellt bzw. zerstört.
[quote]

Delphi-Quellcode:

  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;

Dito. Nur muss du hier FItems erstellen/zerstören. Und das Add und Clear solltest du natürlich auch programmieren. Einfach an FItems.Add bzw. FItems.Clear durchschleifen.