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

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

 

下载地址 http://download.csdn.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)

附件列表