DELPHI TreeView 文件目录树和 设置节点图标 完整

    DELPHI TreeView 文件目录树和 设置节点图标

下载地址 http://download.****.net/detail/teststudio/6448293

需要制作文档管理软件 这个非常有用的

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.

来自为知笔记(Wiz)

附件列表