DELPHI TreeView file directory tree node icons and settings intact

Download  http://download.csdn.net/detail/teststudio/6448293

 

 

Document management software need to make this very useful

1 folder icon set 

2 file folder not the folder icon is not set 

3 .HTML document settings icon

4 has an attachment to the document settings icon 

 

DELPHI XE 5 by test

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 (the TreeView: TTreeView): String ; 
 
Implementation 
 
uses StrUtils;
 { $ R & lt *. Dfm } 
 
var 
  List: a TStringList; 
  the RootPath: String ; // = 'D: \ C ++ Builder Encyclopedia Chinese Language Learning'; 
  FileName: String ; 
 
  { the TreeView selected to obtain the full path 
    AAAA \ ssss \ bbbb 
  } 
function ExtractNodeFullPath (the TreeView: TTreeView): String ;
 var 
  the path: String ; 
  the Parent: TTreeNode; 
  // the Node: TTreeNode; 
the begin 
  the 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
  The Result: = '' ;
   IF TreeView.Selected = nil  the then 
    Exit; 
  FileName: = RootPath + ExtractNodeFullPath (the TreeView) + FileExt; // currently selected file name 
 
  IF  not the FileExists (FileName) the then 
    Exit; 
  the Result: = FileName;
 End ; 
 
{ 
  add a directory of all the files to TREEVIEW in 
  DirToTreeView (of TreeView1, 'D: \ the 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 ] <> ' . ' ) the then 
        the begin 
          IF (RightStr (SearchRec.Name, . 6 ) = ' _FILES ' ) or  // not added _file this folder 
            (RightStr (SearchRec.Name, 12 is ) = ' _Attachments ' ) the then 
            // do not add this folder _AttachMents 
            the Continue; 
 
          IF (SearchRec.Attr and faDirectory> 0 ) the 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 
  f:; 
 
{ 
Return to the Accessories folder 
"D: \ C ++ Builder learn Daquan Chinese version \ new text document .htm" 
 D: \ C ++ Builder learn Daquan Chinese version \ new text document _Attachments 
} 
function AttachmentsFolder (FileName: String) : String ;
 the begin 
  the Result: = ExtractFilePath (FileName) + ChangeFileExt (ExtractFileName (FileName),
     '' ) + ' _Attachments ' ;
 End ; 
 
function AttachMentsExists (FileName: String): Boolean;
 var 
  F: String ;
 the begin = 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.