- это распространенная задача при разработке приложений с использованием компонента TTreeView в Lazarus и Delphi. В данной статье мы рассмотрим, как заполнить TTreeView каталогами и файлами с фильтром по типу, используя примеры кода на Object Pascal (Delphi).
Заполнение TTreeView каталогами
Для заполнения TTreeView каталогами мы будем использовать процедуру AddDirectories, которая рекурсивно добавляет все каталоги в TTreeView. Вот пример кода, который заполняет TTreeView каталогами начиная с корня диска C:
procedure TForm1.FormClick(Sender: TObject);
var
sr: TSearchRec;
FileAttrs: Integer;
theRootNode : tTreeNode;
theNode : tTreeNode;
begin
FileAttrs := faDirectory; // Только каталоги
theRootNode := DirTree.Items.AddFirst(nil, 'c:\');
if FindFirst('c:\*.*', FileAttrs, sr) = 0 then
begin
repeat
if (sr.Attr and FileAttrs) = FileAttrs then
begin
theNode := DirTree.Items.AddChild(theRootNode, sr.Name);
AddDirectories(theNode, 'c:\' + sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
DirTree.FullExpand;
end;
procedure TForm1.AddDirectories(theNode: tTreeNode; cPath: string);
var
sr: TSearchRec;
FileAttrs: Integer;
theNewNode : tTreeNode;
begin
FileAttrs := faDirectory; // Только каталоги
if FindFirst(cPath + '\*.*', FileAttrs, sr) = 0 then
begin
repeat
if (sr.Attr and FileAttrs) = FileAttrs then
begin
theNewNode := DirTree.Items.AddChild(theNode, sr.Name);
AddDirectories(theNewNode, cPath + '\' + sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
В данном примере мы используем процедуру FindFirst для перебора всех каталогов в корне диска C. Для каждого каталога мы создаем новый узел в TTreeView и рекурсивно вызываем процедуру AddDirectories для заполнения подкаталогов.
Заполнение TTreeView файлами с фильтром по типу
Для заполнения TTreeView файлами с фильтром по типу мы будем использовать процедуру FilteredTV, которая рекурсивно добавляет все файлы выбранного типа в TTreeView. Вот пример кода, который заполняет TTreeView файлами типа PDF в выбранном каталоге:
procedure TForm1.FilteredTV(theDir: string; ext: String; startNode: tTreeNode);
var
sr: TSearchRec;
FileAttrs: Integer;
theNode : tTreeNode;
begin
if copy(ext, 1, 1) <> '.' then
ext := '.' + ext;
FileAttrs := faAnyfile;
if startNode = nil then
startNode := FileTree.Items.AddFirst(nil, theDir);
if FindFirst(theDir + '\*.*', FileAttrs, sr) = 0 then
begin
repeat
if (sr.Attr = faDirectory) and (copy(sr.Name, 1, 1) <> '.') then
begin
theNode := FileTree.Items.AddChild(startNode, sr.Name);
theNode.ImageIndex := 0; // Использовать изображение папки для каталогов
FilteredTV(theDir + '\' + sr.Name, ext, theNode);
end
else
if ((sr.Attr and FileAttrs) = sr.Attr) and (ExtractFileExt(sr.Name) = ext)
then
begin
theNode := FileTree.Items.AddChild(startNode, sr.Name);
theNode.ImageIndex := -1; // Без изображения для файлов
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
FileTree.FullExpand;
end;
В данном примере мы используем процедуру FindFirst для перебора всех файлов в выбранном каталоге. Для каждого файла мы проверяем расширение файла и добавляем его в TTreeView, если оно соответствует выбранному типу. Если файл является каталогом, мы рекурсивно вызываем процедуру FilteredTV для заполнения подкаталогов.
Вызов процедуры FilteredTV
Для вызова процедуры FilteredTV при выборе узла в TTreeView каталогов мы можем добавить следующий код в обработчик события OnClick для TTreeView каталогов:
procedure TForm1.DirTreeClick(Sender: TObject);
var
cBuild: string;
theNode: tTreeNode;
begin
if DirTree.Selected <> nil then
begin
theNode := DirTree.Selected;
cBuild := theNode.Text;
while theNode.Parent <> nil do
begin
cBuild := theNode.Parent.Text + '\' + cBuild;
theNode := theNode.Parent;
end;
cBuild := StringReplace(cBuild, '\', '/', [rfReplaceAll]);
FilteredTV(cBuild, 'pdf', nil);
end;
end;
В данном примере мы получаем выбранный узел в TTreeView каталогов и строим абсолютный путь к нему. Затем мы вызываем процедуру FilteredTV, передавая ей путь к каталогу и тип файлов для фильтрации.
Добавление иконок для узлов TTreeView
Для добавления иконок для узлов TTreeView мы можем использовать ImageList. Сначала нам нужно добавить ImageList в форму и добавить в него иконки для папок и файлов. Затем мы можем назначить ImageList для TTreeView и указать индексы иконок для узлов папок и файлов в коде. Вот пример кода, который добавляет иконки для узлов TTreeView:
procedure TForm1.FormCreate(Sender: TObject);
begin
// Создание ImageList и добавление иконок
ImageList1 := TImageList.Create(self);
with ImageList1 do
begin
Handles := [0, 1]; // Индексы иконок для папок и файлов
Images := [TBitmap.Create, TBitmap.Create]; // Создание битмапов для иконок
// Загрузка иконок из файлов
Images[0].LoadFromFile('c:\windows\system32\imageres.dll', 'FOLDER', 0, 0, clFolders, 0, 0, 0, 0);
Images[1].LoadFromFile('c:\windows\system32\imageres.dll', 'FILE', 0, 0, clFiles, 0, 0, 0, 0);
end;
// Назначение ImageList для TTreeView
DirTree.ImageList := ImageList1;
FileTree.ImageList := ImageList1;
end;
В данном примере мы создаем ImageList и добавляем в него иконки для папок и файлов из файла imageres.dll. Затем мы назначаем ImageList для TTreeView каталогов и файлов. В коде, который добавляет узлы в TTreeView, мы можем указать индексы иконок для узлов папок и файлов, используя свойство ImageIndex узла.
Заключение
В данной статье мы рассмотрели, как заполнить TTreeView каталогами и файлами с фильтром по типу в Lazarus и Delphi. Мы использовали процедуры AddDirectories и FilteredTV для рекурсивного заполнения TTreeView каталогами и файлами, а также добавили примеры кода для вызова процедуры FilteredTV и добавления иконок для узлов TTreeView. Используя эти примеры кода, вы можете создать приложение с TTreeView, которое заполняется каталогами и файлами с фильтром по типу.
В данном тексте рассматривается распространенная задача по заполнению компонента TTreeView каталогами и файлами с фильтром по типу в средах Lazarus и Delphi. Для этого используются процедуры `AddDirectories` и `FilteredTV`, которые рекурсивно добавляют ка
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал