Получить каталоги, расположенные на диске С:\

[Don Karleone]

Вот пытаючь получить иеррархию всех каталогов диска D:\
Не судите строго, я только учусь. . Делаю я это следующим образом:

procedure Dir(Patch: string; at: integer; F: TSearchRec; N: TTreeNode);
begin
  if FindFirst(Patch + '*.*', at, F) = 0
    then
      if ((F.Attr and faDirectory) = faDirectory)
         and (F.Name <> '.') and (F.Name <> '..')
        then
          begin
            ND:=Form1.TreeView1.Items.AddChild(ND,F.Name);
            Dir(Patch + '\', at, f, ND);
            ND:=ND.Parent;
          end;

  while FindNext(F) = 0 do Dir(Patch+F.Name, at, f, ND);
  FindClose(F);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  S: TSearchRec;
begin
  TreeView1.Items.Clear;
  ND:=TreeView1.Items.AddChild(nil,'D:\');
  if FindFirst('D:\*.*',faAnyFile,S) = 0
    then
        repeat
          if ((S.Attr and faDirectory) = faDirectory) and
             (S.Name <> '.') and (S.Name <> '..')
             then Dir('D:\' + S.Name, faAnyFile, S, ND);
        until FindNext(S) <> 0;
  FindClose(S);
end;

Вообщем, после клика button1 в TreeView1 получаем всю иерархию диска D:\. Правда работает это так доооооолго, что пропадает все желание пользоваться этим произведением искусства. . Может кто подскажет, как можно сократить время?

[veniside]

как можно сократить время

строить не всё дерево сразу, а по мере того, как юзер открывает в нем ветки. Так работает стандартный Explorer, кстати )

[Don Karleone]

Сообщение от veniside

> как можно сократить время

строить не всё дерево сразу, а по мере того, как юзер открывает в нем ветки. Так работает стандартный Explorer, кстати )

хм... надо подумать над этим

[veniside]

Можно по-простому, во все ветки добавлять детей-пустышек, которые при первом открытии ветки-родителя будут заменяться на реальные подкаталоги. Если подкаталогов нет, юзер будет немного озадачен исчезновением [+] у ветки.

А если делать красиво, то сканировать на 1 уровень глубже, чем текущая ветка, чтобы вместо пустышек добавлять реальные подкаталоги.

[Don Karleone]

Сообщение от veniside

А если делать красиво, то сканировать на 1 уровень глубже, чем текущая ветка, чтобы вместо пустышек добавлять реальные подкаталоги.

да, да, мысль мне понятна . Правда придется отказаться от возможности раскрыть все ветки сразу.

[veniside]

Почему отказаться. ExpandAll() никто не отменял. Если юзер захочет -- путь раскрывает хоть по-одной, хоть все сразу. Естественно во втором случае прийдётся обождать. А если по мере длительного сканирования периодически вызывать ProcessMessages(), то и юзер скучать не будет.

[artemavd]

А что, взять компонент ShellTreeView и настроить его уже не модно? И кода не надо никакого, и отобразится что и как надо.

[Don Karleone]

Сообщение от artemavd

А что, взять компонент ShellTreeView и настроить его уже не модно? И кода не надо никакого, и отобразится что и как надо.

Наверное модно. Просто я это делаю в целях самообразования.

[artemavd]

Это конечно полезно, но нет ничего плохого и в том, чтобы пользоваться уже готовым. Если у вас время на написание программы достаточно много, то можно и самому делать. В ином случае, думаю, что лучше было бы воспользоваться готовым компонентом.

[ArtGrek]

вот рабочии пример по вашеи теме

implementation

{$R *.dfm}
{$R FileCtrl}

procedure NextLevel(ParentNode: TTreeNode);
  function DirectoryName(name: string): boolean;
  begin
    result := (name <> '.') and (name <> '..');
  end;
var
  sr, srChild: TSearchRec;
  node: TTreeNode;
  path: string;
begin
  node := ParentNode;
  path := '';
  repeat
    path := node.Text + '\' + path;
    node := node.Parent;
  until node = nil;
  if FindFirst(path + '*.*', faDirectory, sr) = 0 then begin
    repeat
      if (sr.Attr and faDirectory <> 0) and DirectoryName(sr.Name) then begin
        node := Form1.TreeView1.Items.AddChild(ParentNode, sr.Name);
        node.ImageIndex := 0;
        node.SelectedIndex := 1;
        node.HasChildren := false;
        if FindFirst(path + sr.Name + '\*.*', faDirectory, srChild) = 0 then begin
          repeat
            if (srChild.Attr and faDirectory <> 0) and DirectoryName(srChild.Name)
              then node.HasChildren := true;
          until (FindNext(srChild) <> 0) or node.HasChildren;
        end;
        FindClose(srChild);
      end;
    until FindNext(sr) <> 0;
  end else ParentNode.HasChildren := false;
  FindClose(sr);
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  IconNames: array [0..6] of string = ('CLOSEDFOLDER', 'OPENFOLDER',
    'FLOPPY', 'HARD', 'NETWORK', 'CDROM', 'RAM');
var
  c: char;
  s: string;
  node: TTreeNode;
  DriveType: integer;
  bm, mask: TBitmap;
  i: integer;
begin
  TreeView1.Items.BeginUpdate;
  TreeView1.Images := TImageList.CreateSize(16, 16);
  bm := TBitmap.Create;
  mask := TBitmap.Create;
  for i := low(IconNames) to high(IconNames) do begin
    bm.Handle := LoadBitmap(HInstance, PChar(IconNames[i]));
    bm.Width := 16;
    bm.Height := 16;
    mask.Assign(bm);
    mask.Mask(clBlue);
    TreeView1.Images.Add(bm, mask);
  end;
  for c := 'A' to 'Z' do begin
    s := c + ':';
    DriveType := GetDriveType(PChar(s));
    if DriveType = 1 then continue;
    node := Form1.TreeView1.Items.AddChild(nil, s);
    case DriveType of
      DRIVE_REMOVABLE: node.ImageIndex := 2;
      DRIVE_FIXED: node.ImageIndex := 3;
      DRIVE_REMOTE: node.ImageIndex := 4;
      DRIVE_CDROM: node.ImageIndex := 5;
      else node.ImageIndex := 6;
    end;
    node.SelectedIndex := node.ImageIndex;
    node.HasChildren := true;
  end;
  TreeView1.Items.EndUpdate;
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
begin
  TreeView1.Items.BeginUpdate;
  node.DeleteChildren;
  NextLevel(node);
  TreeView1.Items.EndUpdate;
end;

end.