• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
    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.

 





附件列表

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
MATLAB顺序结构程序和switch实现选择结构发布时间:2022-07-18
下一篇:
8.MATLAB数据分析发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap