Помощь - Поиск - Пользователи - Календарь
Полная версия: treeview
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Client
Привет 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
А можно сделать, чтобы файлы были упорядочены по алфавиту (это есть) и по типу - т.е. сначала были папки, а потом файлы ?
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
даже и не догадался бы smile.gif
Спасибо good.gif
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 мин.
ОПА! smile.gif
прочитал и понял lol.gif
Цитата
При возврате рекурсии стринглист записывается в treeview.
Еще застрял на этом месте, а ведь тут самое простое - для каждого подкаталога идет новая ветка.
Чудо рекурсия smile.gif
И правда - двойная экономия тут.
volvo - ты гений. give_rose.gif
volvo
Цитата
причем туда записывается сначала папки, потом файлы.
Это ты сейчас о чем? Я вообще не пишу папки в StringList. Они сразу уходят в TreeView... А вот те файлы, которые встретились при переборе FindNext-ом, да, пишутся в StringList... И потом, после окончания перебора, выводятся в TreeView...

А тебе вопрос на засыпку: что надо сделать в твоем коде, чтобы папки шли в начале, а потом - файлы, отсортированные по убыванию имен? Мне достаточно добавить функцию сортировки Стринглиста. А тебе?
Client
Цитата
Они сразу уходят в TreeView
да, точно smile.gif
Цитата
А тебе вопрос на засыпку
даже не знаю - если в самой папке соритовку сделать это точно не поможет smile.gif. FindLast/FindPrev нету? smile.gif
Можно попробовать так - проверять по названию, папка или файл, и от этого уже перемещать элементы treeview. но это очень коряво выйдет, хотя может и не очень smile.gif
Есть еще вопрос: как можно к элементам 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
Цитата
Тебе это надо было?
Как раз то, что доктор прописал smile.gif
Все работает, что сегодня хотел то сделал
Спасибо
(да блин, опять не могу еще 1 плюсик поставить. Ну ничего, "завтра" на форуме настанет через часик ... smile.gif )
Client
а форум хитрый... smile.gif видать ограничение на 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
Спасибо smile.gif
но думаю вопросы будут еще...
Client
Только заметил Update smile.gif
А почему нету "Сообщение отредактировано" (следовательно сообщение не появилось в списке непрочтенных)?
такая админская штучка? smile.gif
Update
Пробую через "Быстрое редактирование"...
volvo
Нет... Потому, что я редактировал через "Быстрое редактирование", а оно устроено таким образом, что если метка "Сообщение было отредактировано..." уже была, то она обновится. Но если ее не было вообще - то она и не появится.
Client
И снова Здравствуйте smile.gif
В 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');
volvo
Стоп. Ну, удалил ты с диска папку вместе со всем ее содержимым (с диска-то она удаляется, надеюсь, к коду из DRKB претензий нет?). А как ты обновляешь содержимое TreeView? Или это у тебя MyRemoveDir так коверкает папки? (проверить не могу, Дельфи не установил еще)
Client
Ок, стоп smile.gif
Дело как раз в том, что с диска не удаляется. (Почему-то сразу не сказал об этом )
Обновляю новым поиском файлов. Тут все нормально
Путь
Код
D:\my folder - копия

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

Добавлено через 9 мин.
Сори, не тот архив (этот уже обработан программой)
Вот что надо
volvo
Ты будешь смеяться, но...
До удаления:
Нажмите для просмотра прикрепленного файла

После удаления:
Нажмите для просмотра прикрепленного файла

Только я не перезапускаю поиск файлов заново. Я делаю так:
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
чудеса значит.
если просто удалить пустую - то все норм.
причем в выбранной папке и во всех подпапках нету ни 1 файла
volvo
Кстати, на форуме forums.embarcadero.com великий и могучий ( smile.gif ) 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
Проверенным методом трассировки выяснилось, что удаляются папки последнего уровня, в которых нет подкаталогов. Т.е. самый последний уровень удаляется и в системе он становится заблоченым, пока прогу не закроешь. Файлы удаляются свободно и в самой папке тоже обновляется, т.е. файл и для винды удаяется. Потом при попытке удалить надкаталог, функция возвращает результат false, т.е. надкаталок для последней папки уже не может удалиться, т.к. в нем все еще сидит "как бы уже удаленная" папка.
Воть smile.gif
Воткнуть бы какую - нибудь процедрку для обновления папки... smile.gif
Цитата
Попробуй может это у тебя сработает (если все подпапки пустые)...
Эффект точно такой же - удаляются только посление папки.
Видимо все дело в висте
volvo
Цитата
Т.е. самый последний уровень удаляется и в системе он становится заблоченым, пока прогу не закроешь.
Хм... "Меня терзают смутные сомнения" (С). А у тебя, мил человек, эта папка, которая залочивается, случайно не текущая в твоем приложении? Тогда все так: пока приложение не закроешь - эту папку не удалишь с диска. Проверь это. И также проверь, какую ошибку возвращает GetLastError сразу после того, как RemoveDir вернула False (хотя подозреваю, что вернется 18: ERROR_NO_MORE_FILES, как результат того, что FindNext завершил обработку папки). Короче, проверяй, какая директория - текущая в приложении, или кто еще держит эту директорию, которая "как бы удаляется". Не помню, чтобы где-то всплывал разговор о подобном поведении Висты. Так что ошибка где-то в другом месте.
Client
Да, папку нельзя удалить.
Выдает ошибку 18 и 145.
Хм, а как это исправить?
volvo
Цитата
папка, которая залочивается, случайно не текущая в твоем приложении?
Это я что, просто так спросил? Перед попыткой вызова RemoveDir смотри, что за папка В ДАННЫЙ МОМЕНТ является текущей. Если она совпадает (или является ПОДпапкой) той, что ты хочешь удалять - то можешь даже и не пытаться. Перебрасывай текущую папку куда-нибудь в другое место, и тогда пробуй удалять.

Это все приколы Висты. (Показать/Скрыть)
Client
Скорей всего это не из-за висты.
Вся работа с папкой - это заненесение в бд. т.е. связь с папкой остается в переменной типа TSearchRec если его не закрыть?
У меня код для этого, анологичен коду из 2 поста этой темы.
Именно после выполнения этого кода, папку нельзя удалить, пока не закрою прогу.
Буду править код.
Цитата
что за папка В ДАННЫЙ МОМЕНТ является текущей
хм, если бы я знал... smile.gif
Цитата
Перебрасывай текущую папку куда-нибудь в другое место
А это как? сделать поиск в другом каталоге?
volvo
Цитата
если бы я знал

GetCurrentDirectory никто не отменял.
Цитата
А это как?

SetCurrentDirectory тоже.
Client
Все исправил, ошибка была при поиске файлов, видимо не все TSearchRec были закрыты.
Теперь файлы и папки удаляются smile.gif
А GetCurrentDirectory постоянно указывает на каталог
Код
C:\Users\Alex\Documents\RAD Studio\Projects
но это не важно.
Спасибо volvo за помощь, в который раз уже выручаешь give_rose.gif
Client
понадобилось вывести все элементы выбранной ветки.
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
Не совсем... Что именно требуется, расскажи?
Client
УРААА smile.gif
сделал так, почти твой код )
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;
Обожаю рекурсию yes2.gif
Цитата
Не совсем... Что именно требуется, расскажи?
В моем варианте выделялись все элементы после выбранного, а надо было только его потомков.
volvo
Зачем лишние действия делать?

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;
тоже выделяет только потомков, но не соседей...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.