{ This unit demos how to add items onto a Treeview structure in Delphi
For the purposes of the demo the code recursively scans the disk for
folders and subfolders and adds them onto the treeview
It also gets the icons for the treeview and so their can be a long
delay if you try to scan to many subdirectories at once
and it might seem like your computer has crashed, but rather what is happening
is that the program is processing all those treeview graphics, which takes
time
normally what you would do is scan the current folder only which would
be a lot quicker, but this is a demo
treeviews are a lot quicker when they don't have associated graphics to
locate on disk and load etc and this code would be a lot quicker if
it had a cache of icons

hit the start button and choose a directory on your disk to save to the
treeview, keeping in mind that this code also saves all the subdirectories
and files under that directory
when the treeview is completed you can select an item and the code will
trace a path from that node back to the root which it returns as a path string

you will notice a stringlist in the code FileExtensions
The string list stores a file extension name and its position on the stringlist
corresponds to the position of the corresponding icon on the IMagelist, plus
15.  (the Imagelist is initialized with 15 system icons at startup so adding
15 onto the position of the extension in the Stringlist gives the position
of the icon on the IMagelist.  Remeber that both Stringlists and Imagelists are
indexed from 0, not 1.  )  The lists are kept in synch by adding the extension
onto the Stringlist (if it doesn't already exist) and then adding the icon
onto the ImageList at the same time, while the code also adds a 'place holder'
onto the list for ico files and exe files which have an icon that only
corresponds to that particular file and no other...this 'placeholder' is
required by the structure of the code in order to keep the lists in synch

http://www.awitness.org/delphi_pascal_tutorial/index.html

}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ImgList, ShlObj, ShellApi, FileCtrl, Registry,
  ExtCtrls;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    ImageList1: TImageList;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    function BrowseForFolder:string;
    function GetShellPath:string;
    procedure LoadImageListIcons(shellpath : string);
    Function FileLook(Filespec:string; Node : TTreeNode):boolean;
    procedure FindFilesIcon(Name:string; Node : TTreeNode);
    function RegistryIconExtraction(Extension : string):integer;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    function TracePath(Node : TTreeNode; DirName : string):string;
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  RootNode : TTreeNode;
  IconID : string='000304050607080910111215407302'; {ID num of icons to extract
                                             from shell32 dll}
  ThePath : string; {the treeview will begin at the user selected folder}
  FileExtensions : TStringList;

const    {ID num for accessing Icons for treeview from  imagelist}
   ISAUnknown = 0;
   ISAClosedFolder = 1;   {only the folders will be used for this example}
   ISAOpenFolder = 2;
   ISAFloppyEmpty = 3;
   ISAFloppyPresent = 4;
   ISARemovable = 5;
   ISAFixed = 6;
   ISANetwork = 7;
   ISAOffLineNetwork = 9;
   ISACDRom = 9;
   ISARamDisk = 10;
   ISAMyComputer = 11;
   ISAMusicCD = 12;
   ISAOpenCD = 13;
   ISACOM = 14;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin
      ThePath := BrowseForFolder; {find the starting point to load files
                                  and folders onto treeview}
      {initialize the root of the treeview
      with the selected path name}
      If ThePath = '' then exit;
      TreeView1.Items.Clear;


      RootNode := TreeView1.Items.Add(nil, ThePath); {parent of treeview}
      RootNode.ImageIndex := ISAClosedFolder; {how the image looks to start}
      RootNode.SelectedIndex := ISAOpenFolder; {image when item selected}

      FileLook(ThePath + '\' + '*.*', RootNode); {scan for folders and files from starting point
                         and insert them onto the tree}

end;

{locate a folder to begin the scan for folders and files using standard
Windows API Browse for Folder function}
function TForm1.BrowseForFolder:string;
var
   BrowseInfo  : TBrowseInfo; {browse info structure for the API function call}
   PIDL        : PItemIDList; {a PIDL, storage method for paths used by Shell}
   SelectedPath : array[0..MAX_PATH] of Char;  {the buffer where
                                            the result will be returned}
   begin
        Result := '';
        { initialize TBrowseInfo structure to nulls (0) }
        FillChar(BrowseInfo,SizeOf(BrowseInfo),#0);
        BrowseInfo.hwndOwner      := Handle;  {Form1.Handle, the default}
        BrowseInfo.pszDisplayName := @SelectedPath[0]; {buffer address for API
                                                            to store result}
        BrowseInfo.lpszTitle      := 'Select a folder';
        BrowseInfo.ulFlags        := BIF_RETURNONLYFSDIRS; {only file
                                                            system folders}

        { show the folder browser and  return the result to
              the PIDL itemlist }
        PIDL := SHBrowseForFolder(BrowseInfo);

        { get selected directory from the itemlist and include the full path}
        if Assigned(PIDL) then
              if SHGetPathFromIDList(PIDL, SelectedPath) then
                 Result := string(SelectedPath);
end;


function TForm1.GetShellPath:string; {folder icons are in Shell32.dll}
var   ShellDir : PChar;
begin
        Result := '';
        ShellDir := AllocMem(MAX_PATH);
        GetSystemDirectory(ShellDir, MAX_PATH);
        Result := ShellDir;
        Result := Result + '\' + 'SHELL32.DLL'
end;

{a list of numbers are encoded in an ID string as a constant
each two digit number represents the number position of an icon
in the Shell32.dll file, the only two of interest for this
demo being the open and the closed folder,
treeviews get their icons from an imagelist which is associated
with the treeview using the treeview image property on the VCL
which is in this case will be set to ImageList1
note that if the image property of the imagelist is not set
to Imagelist1 no images will show on the treeview}
procedure TForm1.LoadImageListIcons(shellpath : string);
var
   IconPos : Cardinal;
   PLargeIcon, PSmallIcon : HICON;
   SmallIcon : TIcon;
   i : integer;
begin
        If FileExists(shellpath) then begin
           i:=0;
           SmallIcon := TIcon.Create;
              {now get  small icons at icon pos}
           while (i div 2) <> 15 do begin {extract 15 system icons}
                                          {only two will be used in this demo}
              IconPos := StrToInt(copy(IconID, i + 1, 2)); {ID numbers string}
              ExtractIconEx(PChar(shellpath), IconPos,    {extract shell icon}
                               PLargeIcon, PSmallIcon, 1);
              If not (SmallIcon.Empty) then
                        SmallIcon.ReleaseHandle;
              SmallIcon.Handle := PSmallIcon; {assign handle to icon}
              ImageList1.AddIcon(SmallIcon);  {and then add icon to list}
              DeleteObject(PSmallIcon);    {free the memory}
              DeleteObject(PLargeIcon);
              i := i + 2;  {increment to next position in string constant}
           end;
           SmallIcon.Free;
        end; {if fileexists}
end;

{scan the directories and subdirectories for files
and folders and insert them onto the Treeview}
Function TForm1.FileLook(Filespec:string; Node : TTreeNode):boolean;
var
  TempNode : TTreeNode;
  validres:integer;
  SearchRec  : TSearchRec;
  DirPath, FullName, Flname : string;
begin

     DirPath:=ExtractFilePath(FileSpec);
     Result:= DirectoryExists(DirPath);
     If not Result then exit;
     Flname:=ExtractFileName(FileSpec);
     validres := FindFirst(FileSpec, faAnyFile, SearchRec);
     while validres=0 do begin
          If (SearchRec.Name[1] <> '.') then begin {not a dotted directory}
	      FullName:=DirPath + LowerCase(SearchRec.Name);

              {add folder/file as child of current Node}
              TempNode := TreeView1.Items.AddChild(Node, SearchRec.Name);
              If (SearchRec.Attr and faDirectory>0) then begin{is a folder}
                TempNode.ImageIndex := ISAClosedFolder;
                TempNode.SelectedIndex := ISAOpenFolder;
                {now recursively call the function to scan this
                folder for files and other subdirectories
                pass TempNode which will then become the new parent
                node which will inherit any children found in this folder}
                FileLook(FullName+'\'+Flname, TempNode);
              end
              else  {not a folder must be a file, get its icon}
                    FindFilesIcon(FullName, TempNode);
          end;
          validres:=FindNext(SearchRec);  {continue scanning current
                                           folder for files and other folders}
     end;
end;

{note a problem with the find icon code below
I have a file on my computer with the extension 'cnt'
cnt is not in the registry and has no icon of its own
yet it displays an icon in Explorer
this code gives it the default icon
just where is the 'cnt' icon located and how many
other icons are there that are not listed in the registry?}
procedure TForm1.FindFilesIcon(Name:string; Node : TTreeNode);
var Extension : string;  i : integer;
    PLargeIcon, PSmallIcon : HICON; {handle to icons returned by API}
    AnIcon : TIcon;
begin
       Extension := ExtractFileExt(Name);

       If Extension = '' then begin   {no extension = default icon}
          Node.ImageIndex := ISAUnknown;
          Node.SelectedIndex := ISAUnknown;
          Exit; {procedure}
       end;
       {Next find out if the File Extension is on the file extension stringlist}

       If FileExtensions.Count <> 0 then begin
          i := 0;
         If (lowercase(Extension) <> '.exe')
            and (lowercase(Extension) <> '.ico') then begin
          repeat
                If (lowercase(FileExtensions[i]) = lowercase(Extension))
                then begin

                   {there are 15 system icons on the ImageList and the
                   associated file extensions follow   therefore the
                   position on the image list of the corresponding icon
                   previously extracted can be calculated as follows
                   i indicates the current position in the extension stringlist}
                   i := i + 15;
                   Node.ImageIndex := I; {num image on Imagelist}
                   Node.SelectedIndex := I; {how it looks when it is
                                                   selected on the treeview}
                   exit; {procedure}
                end
                else i := i + 1; {didn't find it keep looking}
          until (i = FileExtensions.Count);
        end; {not an exe or ico}
       end; {file extension string count was not 0}

       {if extension was not on the string list then try to find the associated
       icon for that extension in the registry
       note that you look for exe icons in the exe file not the registry
       and the same is true for ico icon files}
         If (lowercase(Extension) <> '.exe')
            and (lowercase(Extension) <> '.ico') then begin
            i := RegistryIconExtraction(Extension);
      
            {Reg returns 0 for no associated app, or i for pos on imagelist}
            If i <> 0 then begin
               Node.ImageIndex := i;
               Node.SelectedIndex := i;
               FileExtensions.Append(Extension); {save extension for next time}
               exit; {procedure}
            end;  {i <>0 found icon in registry}
         end; {not an exe not an ico}

         {if extension was not on stringlist, and extension was not in registry
         then try to find the icon in the file itself}
         PSmallIcon := 0; {treeviews use the small icon}
         ExtractIconEx(PChar(Name), 0, PLargeIcon, PSmallIcon, 1);
         If PSmallIcon <> 0 then begin  {the file had an icon of its own}
            AnIcon := TIcon.Create;
            AnIcon.Handle := PSmallIcon;
            i := ImageList1.AddIcon(AnIcon);
            FileExtensions.Append('*'); {just a place holder to keep both lists
                                        lined up}
            Node.ImageIndex := i;
            Node.SelectedIndex := i;
            AnIcon.ReleaseHandle;
            AnIcon.Free;
            DeleteObject(PSmallicon);
            DeleteObject(PlargeIcon);
            Exit; {procedure}
         end;

         {if the extension was not on the list, not in the registry,
         and the file did not have an icon of its own then give it the
         Unknown Default icon on the treeview, unless it is an 'exe' file
         in which case it should get the 'com' icon from the registry
         which is already stored at load time as icon number 14 on the
         imagelist}
         If lowercase(Extension) = '.exe' then
            i := ISACOM
         else i := ISAUnknown;

         Node.ImageIndex := i;
         Node.SelectedIndex := i;

end;

{pass the file extension you want to look up in the Registry
to find the associated icon for that file type}
function TForm1.RegistryIconExtraction(Extension : string):integer;
var
    RegKey : TRegistry;
    IconPos : integer;
    AssocAppInfo : string;
    ExtractPath, FileName : string;
    IconHandle, PLargeIcon, PSmallIcon : HICON;
    AnIcon : TIcon;

begin
     Result := 0; {default icon}
     IconHandle := 0;  {init var}

     if Extension[1] <> '.' then Extension := '.' + Extension;
     If (Extension='.exe') then Extension := '.com';


     try
        RegKey := TRegistry.Create(KEY_QUERY_VALUE);
     except
          Exit;
     end;
        {     KEY_QUERY_VALUE	grants permission to query subkey data.   }
     RegKey.RootKey := HKEY_CLASSES_ROOT; {set folder for icon info lookup}
     if RegKey.OpenKeyReadOnly(Extension) then begin {extension key exists?}
        try
        AssocAppInfo := RegKey.ReadString('');  {read app key}
        RegKey.CloseKey;
        except
         RegKey.Free;
         Exit;
        end;
     end;
     if ((AssocAppInfo <> '') and  {app key and icon info exists?}
            (RegKey.OpenKeyReadOnly(AssocAppInfo + '\DefaultIcon'))) then begin
        try
         ExtractPath := RegKey.ReadString(''); {icon path}
         RegKey.CloseKey;
        except
         RegKey.Free;
         Exit;
        end;
     end;
     RegKey.Free;  {free memory}


     {IconPos after comma in key  ie: C:\Program Files\Winzip\Winzip.Exe,0}

     {did we get a key for icon, does IconPos exist after comma seperator?}
     If ((ExtractPath <> '') and (pos(',', ExtractPath) <> 0)) then begin

        {Filename in registry key is before the comma seperator}
        FileName := Copy(ExtractPath, 1, Pos(',', ExtractPath) - 1);
        {extract the icon Index from after the comma in the ExtractPath string}

        try
           IconPos := StrToInt(copy(ExtractPath, Pos(',', ExtractPath) + 1,
                           Length(ExtractPath) - Pos(',', ExtractPath) + 1));
        except
            Exit;
        end;
            {Filename : convert to Windows Api Pchar null terminated string
            IconPos : position icon in file - from registry key
            var Large and small HICON handles returned in PLarge/SmallIcon
            '1' = number of icons to retrieve}
        IconHandle := ExtractIconEx(PChar(FileName), IconPos,
                               PLargeIcon, PSmallIcon, 1);

        { IconHandle = 0 no icons  = 1 not exe dll or ico file-> default icon?
         note that according to the API Icon Handle is supposed to have these
         values when it does not succeed however I have found that it on rare
         occassions returns 4 billion or some other invalid number, the example
         that comes to mind on my computer being when it processes a file with
         the extension CNT ... therefore checking for a valid icon handler is
         safer and I have modified the code as follows, using in this example
         the value of the small icon handler as a check}}
        {otherwise IconHandle = handle to icon}
        If  (PSmallIcon <>0) then begin

                   AnIcon := TIcon.Create;
		   AnIcon.Handle := PSmallIcon;
                   Result := ImageList1.AddIcon(AnIcon);
{                   FileExtensions.Append(Extension); }
		   AnIcon.ReleaseHandle;
		   AnIcon.Free;
        end;
        DeleteObject(PLargeIcon);  DeleteObject(PSmallIcon); 
     end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
        {initialize the string list where the names of the file extensions
        will be saved   the position of the extension on the string list
        will be used to indicate the position of the corresponding icon
        on the ImageList which will then be displayed beside the filename
        on the TreeView}
        FileExtensions := TStringList.Create;
        LoadImageListIcons(GetShellPath); {load the image list system icons}
        Button1.Caption := 'Start';
        Button2.Caption := 'Trace Path';
        Button3.Caption := 'Expand Node';
        Button4.Caption := 'Expand tree';
        Button5.Caption := 'Collapse tree';
end;
{When an item has been selected on the treeview
click this button to trace the path in the treeview
for the selected item}
procedure TForm1.Button2Click(Sender: TObject); {trace path}
begin
     If TreeView1.Selected <> nil then
        ShowMessage(TracePath(TreeView1.Selected, TreeView1.Selected.Text));
end;

{iteratively assemble a path on the treeview for any selected node}
function TForm1.TracePath(Node : TTreeNode; DirName : string):string;
var s : string;
begin
     Result := '';
     If Node = RootNode then Result := Node.Text
     else begin
        {iteratively crawl backwards down tree}
        repeat
           s := Node.Parent.Text; {get parents text}

           Dirname := s + '\' + DirName; {add it to selected node's text}

           Node := Node.Parent; {now crawl backwards one step}
        until (Node.Parent.Text = RootNode.Text); {stop here}
        Result := RootNode.Text + '\' + DirName;  {add on the root text}
     end;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
    If TreeView1.Selected <> nil then
       TreeView1.Selected.Expand(false); {expand the node but do not
                            expand child nodes}
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
        TreeView1.FullExpand;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
        TreeView1.FullCollapse;
        TreeView1.Repaint;
end;

end.