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

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

 

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

上一篇:在Windows操作系统的文件管理器中集成Azure DevOps Server (TFS)工具菜单


下一篇:DataGridView绑定DataTable的正确姿势