treeview, содержимое папки Опции

[Client]

Привет
Надо сделать дерево для директории.
основываясь на коде для поиска файлов с выводом в memo, вот что получилось

procedure FindFiles(const Path, Mask: String; node: TTreeNode);
var
  SRec: TSearchRec;
  Dir: string;
begin
  Dir := IncludeTrailingPathDelimiter(Path);
  if FindFirst(Dir + '*.*', faAnyFile, SRec) <> 0 then Exit;
  try
    repeat
      if (SRec.Name = '.') or (SRec.Name = '..') then Continue;
      if (SRec.Attr and faDirectory) = faDirectory then begin // Вот проверка, папка или нет
        node := Form3.TreeView1.Items.AddChild(node, SRec.Name);

        FindFiles(Dir + SRec.Name, Mask, node)
      end
      else
      begin
        if MatchesMask(Dir + SRec.Name, Mask) then
        begin
          Form3.TreeView1.Items.AddChild(node, SRec.Name);
        end;
      end;
    until FindNext(SRec) <> 0;
  finally
    FindClose(SRec);
  end;
end;

но не правильно.

Добавлено через 10 мин.

procedure FindFiles(const Path, Mask: String; node: TTreeNode);
var
  SRec: TSearchRec;
  Dir: string;
  mynode : TTreeNode;
begin
  Dir := IncludeTrailingPathDelimiter(Path);
  if FindFirst(Dir + '*.*', faAnyFile, SRec) <> 0 then Exit;
  try
    repeat
      if (SRec.Name = '.') or (SRec.Name = '..') then Continue;
      if (SRec.Attr and faDirectory) = faDirectory then begin // Вот проверка, папка или нет
        mynode := Form3.TreeView1.Items.AddChildObject(node, SRec.Name, nil);

        FindFiles(Dir + SRec.Name, Mask, mynode)
      end
      else
      begin
        if MatchesMask(Dir + SRec.Name, Mask) then
        begin
          Form3.TreeView1.Items.AddChildObject(node, SRec.Name,nil);

        end;
      end;
    until FindNext(SRec) <> 0;
  finally
    FindClose(SRec);
  end;
end;

Добавил локальную переменную - все заработало.
Чудеса, а не рекурсия
А можно сделать, чтобы файлы были упорядочены по алфавиту (это есть) и по типу - т.е. сначала были папки, а потом файлы ?

Сообщение отредактировано: Client - 10.04.2010 18:53

[volvo]

Разбей на 2 части: поиск папок и поиск файлов...

procedure FindFiles(const Path, Mask: String; node: TTreeNode);
var
  SRec: TSearchRec;
  Dir: string;
  mynode : TTreeNode;
begin
  Dir := IncludeTrailingPathDelimiter(Path);
  if FindFirst(Dir + '*.*', faDirectory, SRec) <> 0 then Exit;
  try
    repeat
      if (SRec.Name = '.') or (SRec.Name = '..') then Continue;
      if (SRec.Attr and faDirectory) = faDirectory then begin // проверка, папка или нет
        mynode := Form1.TreeView1.Items.AddChildObject(node, SRec.Name, nil);

        FindFiles(Dir + SRec.Name, Mask, mynode);
      end
    until FindNext(srec) <> 0;

    if FindFirst(Dir + '*.*', faAnyFile, SRec) = 0 then
    try
      repeat
        if (SRec.Attr and faDirectory) <> faDirectory then
          if MatchesMask(Dir + SRec.Name, Mask) then
          begin
            Form1.TreeView1.Items.AddChildObject(node, SRec.Name,nil);
          end;
      until FindNext(SRec) <> 0;
    finally
      FindClose(SRec);
    end;

  finally
    FindClose(SRec);
  end;
end;

[Client]

даже и не догадался бы
Спасибо

[volvo]

Если не очень хочется делать двойную работу (проходить заново по всем файлам/папкам может быть накладно, если файлов много), то можно обойтись и без этого:

procedure FindFiles(const Path, Mask: String; node: TTreeNode);
var
  SRec: TSearchRec;
  Dir: string;
  mynode : TTreeNode;
  i: integer;
begin
  Dir := IncludeTrailingPathDelimiter(Path);

  with TStringList.Create do
  try

    if FindFirst(Dir + '*.*', faAnyFile, SRec) = 0 then
    try
      repeat

        if (SRec.Name = '.') or (SRec.Name = '..') then Continue;

        if (SRec.Attr and faDirectory) = faDirectory then begin // Папка
          mynode := Form1.TreeView1.Items.AddChildObject(node, SRec.Name, nil);
          FindFiles(Dir + SRec.Name, Mask, mynode);
        end
        else
          if MatchesMask(Dir + SRec.Name, Mask) then Add(SRec.Name);

      until FindNext(SRec) <> 0;

      // Закончили работу с FindFirst/FindNext? Теперь отображаем только файлы...
      for i := 0 to Count - 1 do
      begin
        Form1.TreeView1.Items.AddChildObject(node, Strings[i], nil);
      end;

    finally // if FindFirst = 0
      FindClose(SRec);
    end;

  finally // with TStringGrid.Create
    Free;
  end;
end;

[Client]

если честно - то не понял смысл всего этого. Рекурсивный вызов происходит только для папок, значит стринглист создается для каждой папки свой, причем туда записывается сначала папки, потом файлы.
При возврате рекурсии стринглист записывается в treeview.

Добавлено через 3 мин.
ОПА!
прочитал и понял

При возврате рекурсии стринглист записывается в treeview.

Еще застрял на этом месте, а ведь тут самое простое - для каждого подкаталога идет новая ветка.
Чудо рекурсия
И правда - двойная экономия тут.
volvo - ты гений.

[volvo]

причем туда записывается сначала папки, потом файлы.

Это ты сейчас о чем? Я вообще не пишу папки в StringList. Они сразу уходят в TreeView... А вот те файлы, которые встретились при переборе FindNext-ом, да, пишутся в StringList... И потом, после окончания перебора, выводятся в TreeView...

А тебе вопрос на засыпку: что надо сделать в твоем коде, чтобы папки шли в начале, а потом - файлы, отсортированные по убыванию имен? Мне достаточно добавить функцию сортировки Стринглиста. А тебе?

[Client]

Они сразу уходят в TreeView

да, точно

А тебе вопрос на засыпку

даже не знаю - если в самой папке соритовку сделать это точно не поможет . FindLast/FindPrev нету?
Можно попробовать так - проверять по названию, папка или файл, и от этого уже перемещать элементы treeview. но это очень коряво выйдет, хотя может и не очень
Есть еще вопрос: как можно к элементам treeview добавть информацию? мне надо хотя бы число привязать к каждому элементу

[volvo]

Что значит "привязать"? Допустим, привязал. Что дальше с этим числом будет происходить?

[Client]

значение - это ID поле в таблице. По нему буду обращаться к записи.
Это как бы графическое представление таблицы.

[volvo]

var
  Counter: Integer = 0;

procedure FindFiles(const Path, Mask: String; node: TTreeNode);
var
  SRec: TSearchRec;
  Dir: string;
  mynode : TTreeNode;
  i: integer;
begin
  Dir := IncludeTrailingPathDelimiter(Path);
  with TStringList.Create do
  try
    if FindFirst(Dir + '*.*', faAnyFile, SRec) = 0 then
    try
      repeat
        if (SRec.Name = '.') or (SRec.Name = '..') then Continue;
        if (SRec.Attr and faDirectory) = faDirectory then begin // Папка
          Inc(Counter);
          mynode := Form1.TreeView1.Items.AddChildObject(node, SRec.Name, Pointer(Counter)); // <--- !!!
          FindFiles(Dir + SRec.Name, Mask, mynode);
        end
        else
          if MatchesMask(Dir + SRec.Name, Mask) then Add(SRec.Name);
      until FindNext(SRec) <> 0;
      // Закончили работу с FindFirst/FindNext? Теперь отображаем только файлы...
      for i := 0 to Count - 1 do
      begin
        Inc(Counter);
        Form1.TreeView1.Items.AddChildObject(node, Strings[i], Pointer(Counter)); // <--- !!!
      end;
    finally // if FindFirst = 0
      FindClose(SRec);
    end;
  finally // with TStringGrid.Create
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //
  FindFiles('F:\TP70', '*.*', TreeView1.Items[0]);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage(IntToStr( Integer(TreeView1.Selected.Data) ));
end;

При клике на вторую кнопку показывает "индекс" данного элемента (Фактичесли - порядковый номер, под которым элемент был внесен в TreeView). Тебе это надо было?

[Client]

Тебе это надо было?

Как раз то, что доктор прописал
Все работает, что сегодня хотел то сделал
Спасибо
(да блин, опять не могу еще 1 плюсик поставить. Ну ничего, "завтра" на форуме настанет через часик ... )

Сообщение отредактировано: Client - 10.04.2010 22:07

[Client]

а форум хитрый... видать ограничение на 24 часа, а не по дням

[Client]

Понадобилось вывести все элементы для выбранного узла. Написал так, но он обходит еще и все вложенные элементы, а надо без вхождения в подпапки.
У GetNextChild что за параметр? указатель на предка?

procedure TForm3.Button3Click(Sender: TObject);
var
  node, myparent : TTreeNode;
begin
  Memo1.Clear;
  myparent := TreeView1.Selected;
  node := TreeView1.Selected.getFirstChild;
  if node <> nil then begin
    Memo1.Lines.Add(node.Text);
    node := node.GetNext;
    while  (node <> myparent.GetNextChild(myparent)) do begin
      Memo1.Lines.Add( node.Text );
      node := node.GetNext;
    end;
  end;
end;

[volvo]

Зачем лишние действия?

procedure TForm3.Button3Click(Sender: TObject);
var
  node, myparent : TTreeNode;
begin
  Memo1.Clear;
  myparent := TreeView1.Selected; // Оно тоже не надо ...
  node := TreeView1.Selected.getFirstChild;
  if node <> nil then
    repeat
      Memo1.Lines.Add(node.Text);
      node := node.getNextSibling; // Следующий элемент того же уровня
    until node = nil;
end;

Update:

procedure TForm1.Button2Click(Sender: TObject);
var
  node: TTreeNode;
begin
  Memo1.Clear;
  node := TreeView1.Selected.getFirstChild;

  while node <> nil do
  begin
    Memo1.Lines.Add(node.Text);
    node := node.getNextSibling;
  end;
end;

Так еще проще будет...

[Client]

Спасибо
но думаю вопросы будут еще...

[Client]

Только заметил Update
А почему нету "Сообщение отредактировано" (следовательно сообщение не появилось в списке непрочтенных)?
такая админская штучка?
Update
Пробую через "Быстрое редактирование"...

Сообщение отредактировано: Client - 11.04.2010 21:02

[volvo]

Нет... Потому, что я редактировал через "Быстрое редактирование", а оно устроено таким образом, что если метка "Сообщение было отредактировано..." уже была, то она обновится. Но если ее не было вообще - то она и не появится.

[Client]

И снова Здравствуйте
В DRKB нашел код для удаления папки вместе с содержимым.
В treeview щелкаю на "папку" правой кнопкой - появляестя меню (свое, там есть кнопка удалить), выбираю удалить. Если папка пустая или в ней только файлы - то проблем нету. А если в ней есть подпапки - то содержимое папок удаляется, а с папками непонятно что творится.

Function MyRemoveDir(sDir : String) : Boolean;
var
  iIndex : Integer;
  SearchRec : TSearchRec;
  sFileName : String;
begin
  Result := False;
  sDir := sDir + '\*.*';
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);
  while iIndex = 0 do
  begin
    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.Name;
    if SearchRec.Attr = faDirectory then
    begin
      if (SearchRec.Name <> '' ) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then MyRemoveDir(sFileName);
    end
    else
    begin
      if SearchRec.Attr <> faArchive then FileSetAttr(sFileName, faArchive);
    if NOT DeleteFile(sFileName) then ShowMessage('Could NOT delete ' + sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  sDir := ExtractFileDir(sDir);
  RemoveDir(sDir);
  Result := True;
end;

[volvo]

Как вызываешь эту MyRemoveDir, покажи? Какой путь передается туда?

[Client]

Этой функцией получаю путь

function SrNodeTree(pTreeNode: TTreeNode): string;               //full path
begin
if pTreeNode.Level = 0 then Result := pTreeNode.Text
else
   Result := SrNodeTree(pTreeNode.Parent) + '\' + pTreeNode.Text;
end;

Вызываю так. Также для теста в Edit копировал путь папки - результат такой же

s := SrNodeTree(TreeView1.Selected);
if MyRemoveDir(s) then ShowMessage('DELETED :D');

Сообщение отредактировано: Client - 12.04.2010 17:46