TVirtualStringTree 树状结构 求助

cxczqfrx

想用TVirtualStringTree实现类似windows资源管理器的结构，碰到点问题，只能显示一层目录，第二级、第三级目录无法显示

这是我的程序运行的效果，
但实际目录中，F4目录下面还有文件和文件夹，如图


下面是源码，请帮忙查找，因为设计为多列显示，故选择了TVirtualStringTree控件而非treeview，源码如下：

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, VirtualTrees, Forms, Controls, Graphics, Dialogs;

type

  { TForm1 }

  TForm1 = class(TForm)
    VST_FILE: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);
    procedure VST_FILEGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: integer);
    procedure VST_FILEGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VST_FILEInitChildren(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var ChildCount: Cardinal);
    procedure VST_FILEInitNode(Sender: TBaseVirtualTree;
      ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  AppPath: string;

implementation

{$R *.lfm}


type
  PData = ^TData;

  TData = record
    s_name: string; // 文件名
    s_leng: string; // 文件大小
    s_type: string; // 文件类型
  end;

{ TForm1 }

function HasChildren(const Folder: string): boolean;
var
  SR: TSearchRec;
begin
  Result := FindFirst(IncludeTrailingBackslash(Folder) + '*.*',
    faReadOnly or faHidden or faSysFile or faArchive, SR) = 0;
  if Result then
    FindClose(SR);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Count: integer;
begin
  GetDir(0, AppPath);
  VST_FILE.NodeDataSize := SizeOf(TData);
  VST_FILE.Header.Columns[0].Text := '名称';
  VST_FILE.Header.Columns[0].Width := 320;
  VST_FILE.Header.Columns[1].Text := '大小';
  VST_FILE.Header.Columns[1].Width := 80;
  VST_FILE.Header.Columns[2].Text := '类型';
  VST_FILE.Header.Columns[2].Width := 80;
  VST_FILE.NodeDataSize := SizeOf(TData);
  Count := 1;
  VST_FILE.RootNodeCount := Count;
end;

procedure TForm1.VST_FILEGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: integer);
begin
  NodeDataSize := SizeOf(PData);
end;

procedure TForm1.VST_FILEGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  MyData: PData;
begin
  MyData := Sender.GetNodeData(Node);

  if Column = 0 then
    CellText := MyData^.s_name;
  if Column = 1 then
    CellText := MyData^.s_leng;
  if Column = 2 then
    CellText := MyData^.s_type;
end;

procedure TForm1.VST_FILEInitChildren(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var ChildCount: Cardinal);
var
  Data, ChildData: PData;
  SR: TSearchRec;
  ChildNode: PVirtualNode;
begin
  Data := Sender.GetNodeData(Node);
  if FindFirst(IncludeTrailingBackslash(Data^.s_name) + '*.*', faAnyFile, SR)
    = 0 then
  begin
    try
      repeat
        if (SR.Name <> '.') and (SR.Name <> '..') and
          (SR.Name <> ExtractFileName(Application.ExeName)) then
        begin
          ChildNode := Sender.AddChild(Node);
          ChildData := Sender.GetNodeData(ChildNode);
          ChildData^.s_name := strpas(strupper(pchar(SR.Name)));
          ChildData^.s_leng := inttostr(SR.Size);
          if (SR.Attr and faDirectory <> 0) then
          begin
            ChildData^.s_type := '文件夹';
          end
          else
          begin
            ChildData^.s_type := '文件';
          end;
          Sender.ValidateNode(Node, False);
        end;
      until FindNext(SR) <> 0;
      ChildCount := Sender.ChildCount[Node];
    finally
      FindClose(SR);
    end;
  end;
end;

procedure TForm1.VST_FILEInitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  Data: PData;
begin
  Data := Sender.GetNodeData(Node);
  if ParentNode = nil then
  begin
    Data^.s_name := strpas(strupper(pchar(AppPath)));
    Data^.s_leng := '0';
    Data^.s_type := '总目录';
  end;
  if (HasChildren(Data^.s_name)) then
    Include(InitialStates, ivsHasChildren);
end;

end.

请问上述代码哪里有问题造成只显示2层结构？
忘哪位大侠不吝赐教，谢谢