IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

> treeview, содержимое папки
сообщение
Сообщение #1


Профи
****

Группа: Пользователи
Сообщений: 865
Пол: Мужской
Реальное имя: Вячеслав

Репутация: -  20  +


Привет smile.gif
Надо сделать дерево для директории.
основываясь на коде для поиска файлов с выводом в 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;
Добавил локальную переменную - все заработало.
Чудеса, а не рекурсия smile.gif
А можно сделать, чтобы файлы были упорядочены по алфавиту (это есть) и по типу - т.е. сначала были папки, а потом файлы ?

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


Эскизы прикрепленных изображений
Прикрепленное изображение
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






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

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   treeview   10.04.2010 22:39
volvo   Разбей на 2 части: поиск папок и поиск файлов... p…   10.04.2010 23:25
Client   даже и не догадался бы :) Спасибо :good:   10.04.2010 23:31
volvo   Если не очень хочется делать двойную работу (прохо…   11.04.2010 0:07
Client   если честно - то не понял смысл всего этого. Рекур…   11.04.2010 0:20
volvo   Это ты сейчас о чем? Я вообще не пишу папки в Stri…   11.04.2010 0:27
Client   да, точно :) даже не знаю - если в самой папке с…   11.04.2010 0:39
volvo   Что значит "привязать"? Допустим, привяз…   11.04.2010 1:21
Client   значение - это ID поле в таблице. По нему буду обр…   11.04.2010 1:24
volvo   var Counter: Integer = 0; procedure FindFiles(c…   11.04.2010 1:50
Client   Как раз то, что доктор прописал :) Все работает, ч…   11.04.2010 2:05
Client   а форум хитрый... :) видать ограничение на 24 час…   11.04.2010 3:21
Client   Понадобилось вывести все элементы для выбранного у…   11.04.2010 18:56
volvo   Зачем лишние действия? procedure TForm3.Button3Cl…   11.04.2010 19:08
Client   Спасибо :) но думаю вопросы будут еще...   11.04.2010 20:32
Client   Только заметил Update :) А почему нету "Сообщ…   12.04.2010 0:21
volvo   Нет... Потому, что я редактировал через "Быст…   12.04.2010 1:00
Client   И снова Здравствуйте :) В DRKB нашел код для уда…   12.04.2010 19:10
volvo   Как вызываешь эту MyRemoveDir, покажи? Какой путь …   12.04.2010 19:26
Client   Этой функцией получаю путь function SrNodeTree(pTr…   12.04.2010 21:45
volvo   Стоп. Ну, удалил ты с диска папку вместе со всем е…   12.04.2010 21:57
Client   Ок, стоп :) Дело как раз в том, что с диска не уда…   12.04.2010 22:03
volvo   Ты будешь смеяться, но... До удаления: После уда…   12.04.2010 22:24
Client   чудеса значит. если просто удалить пустую - то все…   12.04.2010 22:47
volvo   Кстати, на форуме forums.embarcadero.com великий и…   12.04.2010 23:11
Client   Проверенным методом трассировки выяснилось, что уд…   12.04.2010 23:45
volvo   Хм... "Меня терзают смутные сомнения" (С…   13.04.2010 0:29
Client   Да, папку нельзя удалить. Выдает ошибку 18 и 145. …   13.04.2010 0:38
volvo   Это я что, просто так спросил? Перед попыткой вызо…   13.04.2010 1:59
Client   Скорей всего это не из-за висты. Вся работа с папк…   13.04.2010 2:10
volvo   GetCurrentDirectory никто не отменял. SetCurrent…   13.04.2010 2:42
Client   Все исправил, ошибка была при поиске файлов, видим…   13.04.2010 3:17
Client   понадобилось вывести все элементы выбранной ветки.…   27.04.2010 0:37
volvo   Не совсем... Что именно требуется, расскажи?   27.04.2010 1:27
Client   УРААА :) сделал так, почти твой код ) procedure fi…   27.04.2010 1:33
volvo   Зачем лишние действия делать? procedure FillMemo(…   27.04.2010 5:53


 Ответить  Открыть новую тему 
2 чел. читают эту тему (гостей: 2, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 1.05.2024 0:04
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name