Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Делфи _ treeview

Автор: Client 10.04.2010 22:39

Привет
Надо сделать дерево для директории.
основываясь на коде для поиска файлов с выводом в 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;

Добавил локальную переменную - все заработало.
Чудеса, а не рекурсия

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

Эскизы прикрепленных изображений

Автор: volvo 10.04.2010 23:25

Разбей на 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 10.04.2010 23:31

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

Автор: volvo 11.04.2010 0:07

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

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 11.04.2010 0:20

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

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

Цитата

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

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

И правда - двойная экономия тут.
volvo - ты гений.

Автор: volvo 11.04.2010 0:27

Цитата

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

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

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

Автор: Client 11.04.2010 0:39

Цитата

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

да, точно

Цитата

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

даже не знаю - если в самой папке соритовку сделать это точно не поможет

. FindLast/FindPrev нету?

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

Есть еще вопрос: как можно к элементам treeview добавть информацию? мне надо хотя бы число привязать к каждому элементу

Автор: volvo 11.04.2010 1:21

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

Автор: Client 11.04.2010 1:24

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

Автор: volvo 11.04.2010 1:50

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 11.04.2010 2:05

Цитата

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

Как раз то, что доктор прописал

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

)

Автор: Client 11.04.2010 3:21

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

Автор: Client 11.04.2010 18:56

Понадобилось вывести все элементы для выбранного узла. Написал так, но он обходит еще и все вложенные элементы, а надо без вхождения в подпапки.
У 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 11.04.2010 19:08

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

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 11.04.2010 20:32

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

Автор: Client 12.04.2010 0:21

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

Автор: volvo 12.04.2010 1:00

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

Автор: Client 12.04.2010 19:10

И снова Здравствуйте
В 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 12.04.2010 19:26

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

Автор: Client 12.04.2010 21:45

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

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');

Автор: volvo 12.04.2010 21:57

Стоп. Ну, удалил ты с диска папку вместе со всем ее содержимым (с диска-то она удаляется, надеюсь, к коду из DRKB претензий нет?). А как ты обновляешь содержимое TreeView? Или это у тебя MyRemoveDir так коверкает папки? (проверить не могу, Дельфи не установил еще)

Автор: Client 12.04.2010 22:03

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

Код

D:\my folder - копия

Папка в архиве (она только для теста, делал сам

)

Добавлено через 9 мин.
Сори, не тот архив (этот уже обработан программой)
Вот что надо

Прикрепленные файлы

my_folder___копия.rar ( 1.59 килобайт ) Кол-во скачиваний: 187

my_folder___копия.rar ( 2.88 килобайт ) Кол-во скачиваний: 183

Автор: volvo 12.04.2010 22:24

Ты будешь смеяться, но...
До удаления:

После удаления:

Только я не перезапускаю поиск файлов заново. Я делаю так:

procedure TForm1.deleteobject1Click(Sender: TObject);
var myPath: string;
begin
  myPath := ExcludeTrailingPathDelimiter(SrNodeTree(TreeView1.Selected));
  if DirectoryExists(myPath) then MyRemoveDir(myPath); // С файлами - надо будет просто удалить файл

  TreeView1.Selected.DeleteChildren; // Это вместо пересканирования: удаляем потомков
  TreeView1.Selected.Delete;  // и сам узел
end;

Так что все работает...

Автор: Client 12.04.2010 22:47

чудеса значит.
если просто удалить пустую - то все норм.
причем в выбранной папке и во всех подпапках нету ни 1 файла

Эскизы прикрепленных изображений

Автор: volvo 12.04.2010 23:11

Кстати, на форуме forums.embarcadero.com великий и могучий ( ) Remy Lebeau чуть-чуть поправил функцию MyRemoveDir:

function MyRemoveDir(sDir: string): Boolean;
var
  SearchRec: TSearchRec;
begin
  sDir := IncludeTrailingPathDelimiter(sDir);
  if FindFirst(sDir + '*.*', faAnyFile, SearchRec) = 0 then
  try
    repeat
      if (SearchRec.Attr and faDirectory) <> 0 then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          MyRemoveDir(sDir + SearchRec.Name);
      end;
    until FindNext(SearchRec) <> 0;
  finally
    FindClose(SearchRec);
  end;
  Result := RemoveDir(sDir);
end;

Попробуй может это у тебя сработает (если все подпапки пустые)... В любом случае, как только установлю все ПО на Win7 - погоняю этот код там тоже...

Автор: Client 12.04.2010 23:45

Проверенным методом трассировки выяснилось, что удаляются папки последнего уровня, в которых нет подкаталогов. Т.е. самый последний уровень удаляется и в системе он становится заблоченым, пока прогу не закроешь. Файлы удаляются свободно и в самой папке тоже обновляется, т.е. файл и для винды удаяется. Потом при попытке удалить надкаталог, функция возвращает результат false, т.е. надкаталок для последней папки уже не может удалиться, т.к. в нем все еще сидит "как бы уже удаленная" папка.
Воть
Воткнуть бы какую - нибудь процедрку для обновления папки...

Цитата

Попробуй может это у тебя сработает (если все подпапки пустые)...

Эффект точно такой же - удаляются только посление папки.
Видимо все дело в висте

Автор: volvo 13.04.2010 0:29

Цитата

Т.е. самый последний уровень удаляется и в системе он становится заблоченым, пока прогу не закроешь.

Хм... "Меня терзают смутные сомнения" (С). А у тебя, мил человек, эта папка, которая залочивается, случайно не текущая в твоем приложении? Тогда все так: пока приложение не закроешь - эту папку не удалишь с диска. Проверь это. И также проверь, какую ошибку возвращает GetLastError сразу после того, как RemoveDir вернула False (хотя подозреваю, что вернется 18: ERROR_NO_MORE_FILES, как результат того, что FindNext завершил обработку папки). Короче, проверяй, какая директория - текущая в приложении, или кто еще держит эту директорию, которая "как бы удаляется". Не помню, чтобы где-то всплывал разговор о подобном поведении Висты. Так что ошибка где-то в другом месте.

Автор: Client 13.04.2010 0:38

Да, папку нельзя удалить.
Выдает ошибку 18 и 145.
Хм, а как это исправить?

Автор: volvo 13.04.2010 1:59

Цитата

папка, которая залочивается, случайно не текущая в твоем приложении?

Это я что, просто так спросил? Перед попыткой вызова RemoveDir смотри, что за папка В ДАННЫЙ МОМЕНТ является текущей. Если она совпадает (или является ПОДпапкой) той, что ты хочешь удалять - то можешь даже и не пытаться. Перебрасывай текущую папку куда-нибудь в другое место, и тогда пробуй удалять.

Это все приколы Висты. (Показать/Скрыть)

Автор: Client 13.04.2010 2:10

Скорей всего это не из-за висты.
Вся работа с папкой - это заненесение в бд. т.е. связь с папкой остается в переменной типа TSearchRec если его не закрыть?
У меня код для этого, анологичен коду из 2 поста этой темы.
Именно после выполнения этого кода, папку нельзя удалить, пока не закрою прогу.
Буду править код.

Цитата

что за папка В ДАННЫЙ МОМЕНТ является текущей

хм, если бы я знал...

Цитата

Перебрасывай текущую папку куда-нибудь в другое место

А это как? сделать поиск в другом каталоге?

Автор: volvo 13.04.2010 2:42

Цитата

если бы я знал

http://msdn.microsoft.com/en-us/library/aa364934%28VS.85%29.aspx никто не отменял.

Цитата

А это как?

http://msdn.microsoft.com/en-us/library/aa365530%28v=VS.85%29.aspx тоже.

Автор: Client 13.04.2010 3:17

Все исправил, ошибка была при поиске файлов, видимо не все TSearchRec были закрыты.
Теперь файлы и папки удаляются
А GetCurrentDirectory постоянно указывает на каталог

Код

C:\Users\Alex\Documents\RAD Studio\Projects

но это не важно.
Спасибо volvo за помощь, в который раз уже выручаешь

Автор: Client 27.04.2010 0:37

понадобилось вывести все элементы выбранной ветки.

procedure fillmemo (node : TTreeNode; st : string);
var
  myNode : TTreeNode;
  s : string;
begin
  myNode :=node;
  s := myNode.Text;
  while myNode <> nil do
  begin
    if myNode.HasChildren then begin
      s := myNode.Text;
      ArchiveForm.Memo1.Lines.Add(st + s);
      fillmemo(myNode.getFirstChild, st + '   ');
    end
    else begin
      s := myNode.Text;
      ArchiveForm.Memo1.Lines.Add(st + s);
    end;
    myNode := myNode.getNextSibling;
  end;
end;

procedure TArchiveForm.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
  fillmemo(TreeView1.Selected, '');
end;

выводит элементы до конца (самого последнего) от выбранного пункта.

Автор: volvo 27.04.2010 1:27

Не совсем... Что именно требуется, расскажи?

Автор: Client 27.04.2010 1:33

УРААА
сделал так, почти твой код )

procedure fillmemo (node : TTreeNode; st : string);
var
  myNode : TTreeNode;
  s, s1 : string;
begin
  s := node.Text;
  ArchiveForm.Memo1.Lines.Add(st + s);
  myNode := node.getFirstChild;
  while mynode <> nil do
  begin
    s := myNode.Text;
    if myNode.HasChildren then
      fillmemo(myNode, st + '  ')
    else
      ArchiveForm.Memo1.Lines.Add(st + s);
    myNode := myNode.getNextSibling;
  end;
end;

Обожаю рекурсию

Цитата

Не совсем... Что именно требуется, расскажи?

В моем варианте выделялись все элементы после выбранного, а надо было только его потомков.

Эскизы прикрепленных изображений

Автор: volvo 27.04.2010 5:53

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

procedure FillMemo(node: TTreeNode; st : string);
var
  myNode : TTreeNode;
  s: string;
begin
  s := node.Text;
  ArchiveForm.Memo1.Lines.Add(st + s);

  myNode := node.getFirstChild;
  while mynode <> nil do
  begin
    FillMemo(myNode, st + '  ');
    myNode := myNode.getNextSibling;
  end;
end;

тоже выделяет только потомков, но не соседей...