DELPHI TreeView 文件目录树和 设置节点图标
下载地址
需要制作文档管理软件 这个非常有用的
1 文件夹 设置图标为 
2 文件夹里没有文件的文件夹 设置图标为 没有
3 .HTML文档 设置图标为 
4 有附件的 文档设置图标为 
DELPHI XE 5测试通过
unit Unit1;interfaceuses 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;implementationuses 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.
附件列表