DELPHI TreeView 文件目录树和 设置节点图标 完整
DELPHI TreeView 文件目录树和 设置节点图标
需要制作文档管理软件 这个非常有用的
1 文件夹 设置图标为 
2 文件夹里没有文件的文件夹 设置图标为 没有
3 .HTML文档 设置图标为
4 有附件的 文档设置图标为 
DELPHI XE 5测试通过
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ImgList, StdCtrls;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
ImageList1: TImageList;
Button1: TButton;
Memo1: TMemo;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function IsEmptyDir(sDir: String): Boolean;
function AttachMentsExists(FileName: String): Boolean;
procedure SetIcons(TreeView1: TTreeView; list: TStringList);
procedure EnumText(s: string; aItem: TTreeNode);
procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode;
IncludeFiles: Boolean; FileExt: string);
function ExtractTreeViewFileName(RootPath: string; TreeView: TTreeView;
FileExt: string): string;
function ExtractNodeFullPath(TreeView: TTreeView): string;
implementation
uses StrUtils;
{$R *.dfm}
var
list: TStringList;
RootPath: string;// = 'D:\C++Builder学习大全中文版';
FileName: string;
{ TreeView获得选中的完整路径
aaaa\ssss\bbbb
}
function ExtractNodeFullPath(TreeView: TTreeView): string;
var
Path: string;
Parent: TTreeNode;
// Node: TTreeNode;
begin
Path := TreeView.Selected.text;
Parent := TreeView.Selected.Parent;
while Parent <> nil do
begin
Path := Parent.text + '\' + Path;
Parent := Parent.Parent;
end;
Result := Path;
end;
function ExtractTreeViewFileName(RootPath: string; TreeView: TTreeView;
FileExt: string): string;
var
FileName: string;
begin
Result := '';
if TreeView.Selected = nil then
Exit;
FileName := RootPath + ExtractNodeFullPath(TreeView) + FileExt; // 当前选中的文件名
if not FileExists(FileName) then
Exit;
Result := FileName;
end;
{
将1个目录里面所有的文件添加到TREEVIEW中
DirToTreeView(TreeView1,'D:\Data\',nil,True,'.cpp');
}
procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode;
IncludeFiles: Boolean; FileExt: string);
var
SearchRec: TSearchRec;
ItemTemp: TTreeNode;
begin
with Tree.Items do
begin
BeginUpdate;
if Directory[Length(Directory)] <> '\' then
Directory := Directory + '\';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
Application.ProcessMessages;
repeat
{ 添加文件夹 }
if (SearchRec.Attr and faDirectory = faDirectory) and
(SearchRec.Name[1] <> '.') then
begin
if (RightStr(SearchRec.Name, 6) = '_files') or // 不添加 _file这个文件夹
(RightStr(SearchRec.Name, 12) = '_Attachments') then
// 不添加 _AttachMents这个文件夹
Continue;
if (SearchRec.Attr and faDirectory > 0) then
Root := AddChild(Root, SearchRec.Name);
ItemTemp := Root.Parent;
DirToTreeView(Tree, Directory + SearchRec.Name, Root,
IncludeFiles, FileExt);
Root := ItemTemp;
end
{ 添加文件 }
else if IncludeFiles then
if SearchRec.Name[1] <> '.' then
if (RightStr(SearchRec.Name, 4) = FileExt) (* or { 只添加 .CPP格式文件 }
(RightStr(SearchRec.Name, 4) <> '') *) then { 什么格式都添加 }
AddChild(Root, SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
EndUpdate;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
SetIcons(TreeView1, list);
list.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RootPath:=ExtractFilePath(Application.ExeName) + 'TestData';
Memo1.Clear;
TreeView1.Items.Clear;
DirToTreeView(TreeView1, RootPath, nil, true, '.htm');
list := TStringList.Create;
EnumText(RootPath, TreeView1.Items.GetFirstNode);
// Memo1.text := list.text;
SetIcons(TreeView1, list);
// list.Free;
end;
procedure EnumText(s: string; aItem: TTreeNode);
var
node: TTreeNode;
str: string;
begin
node := aItem;
while node <> nil do
begin
if s = '' then
str := node.text
else
str := s + '\' + node.text;
list.Add(str);
if node.HasChildren then
EnumText(str, node.getFirstChild);
node := node.getNextSibling;
end;
end;
function IsEmptyDir(sDir: String): Boolean;
var
sr: TSearchRec;
begin
Result := true;
if Copy(sDir, Length(sDir) - 1, 1) <> '\' then
sDir := sDir + '\';
if FindFirst(sDir + '*.*', faAnyFile, sr) = 0 then
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
begin
Result := False;
break;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
{
返回 附件文件夹
"D:\C++Builder学习大全中文版\新建文本文档.htm"
D:\C++Builder学习大全中文版\新建文本文档_Attachments
}
function AttachmentsFolder(FileName: String): string;
begin
Result := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(FileName),
'') + '_Attachments';
end;
function AttachMentsExists(FileName: String): Boolean;
var
f: string;
begin
f := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(FileName), '')
+ '_Attachments';
Result := DirectoryExists(f);
end;
procedure SetIcons(TreeView1: TTreeView; list: TStringList);
var
i: Integer;
begin
with TreeView1 do
begin
for i := 0 to Items.Count - 1 do
begin
if DirectoryExists(list.Strings[i]) then
begin
Items[i].ImageIndex := 0;
Items[i].SelectedIndex := 0;
Items[i].StateIndex := 0;
end;
if FileExists(list.Strings[i]) then
begin
Items[i].ImageIndex := 1;
Items[i].SelectedIndex := 1;
Items[i].StateIndex := 1;
end;
if (AttachMentsExists(list.Strings[i])) then
if not IsEmptyDir( AttachmentsFolder(list.Strings[i]) ) then
begin
// Form1.Memo1.LINES.Add( AttachmentsFolder(list.Strings[i]));
Items[i].ImageIndex := 2;
Items[i].SelectedIndex := 2;
Items[i].StateIndex := 2;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
with TreeView1 do
begin
for i := 0 to Items.Count - 1 do
begin
if Items[i].HasChildren then
begin
Items[i].ImageIndex := 0;
Items[i].SelectedIndex := 0;
Items[i].StateIndex := 0;
end
else
begin
Items[i].ImageIndex := 1;
Items[i].SelectedIndex := 1;
Items[i].StateIndex := 1;
end;
end;
end;
end;
end.
附件列表
