Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create menus from directory tree (advanced) Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
28-Aug-03
Category
VCL-Menu
Language
Delphi 4.x
Views
139
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Christian Cristofori

The enhanced version of my CreateTreeMenus

Answer:

You nedd to create only a ImageList and a Menu. 
1   
2   procedure TfrmMain.CreateTreeMenus(Path: string; Root: TMenuItem; ListImage:
3     TImageList);
4   type
5     pHIcon = ^HIcon;
6   var
7     SR: TSearchRec;
8     Result: Integer;
9     Item: TMenuItem;
10    SmallIcon: HIcon;
11    IconA: TIcon;
12    BitMapA: TBitMap;
13    Indice: Integer;
14    procedure GetAssociatedIcon(FileName: TFilename; pLargeIcon, PSmallIcon: pHIcon);
15    var
16      IconIndex: Word;
17      FileExt: string;
18      FileType: string;
19      Reg: TRegistry;
20      p: Integer;
21      p1: pChar;
22      p2: pChar;
23      function GetSystemDir: TFileName;
24      var
25        SysDir: array[0..MAX_PATH - 1] of Char;
26      begin
27        SetString(Result, SysDir, GetSystemDirectory(SysDir, MAX_PATH));
28        if (Result = '') then
29          raise Exception.Create(SysErrorMessage(GetLastError));
30      end;
31    label
32      NoAssoc;
33    begin
34      IconIndex := 0;
35      FileExt := UpperCase(ExtractFileExt(FileName));
36      if (((FileExt <> '.EXE') and (FileExt <> '.ICO')) or (not 
37  (FileExists(FileName))))
38        then
39      begin
40        Reg := nil;
41        try
42          Reg := TRegistry.Create(KEY_QUERY_VALUE);
43          Reg.RootKey := HKEY_CLASSES_ROOT;
44          if (FileExt = '.EXE') then
45            FileExt := '.COM';
46          if (Reg.OpenKeyReadOnly(FileExt)) then
47          try
48            FileType := Reg.ReadString('');
49          finally
50            Reg.CloseKey;
51          end;
52          if ((FileType <> '') and Reg.OpenKeyReadOnly(FileType + '\DefaultIcon')) 
53  then
54          try
55            FileName := Reg.ReadString('');
56          finally
57            Reg.CloseKey;
58          end;
59        finally
60          Reg.Free;
61        end;
62        if (FileName = '') then
63          goto NoAssoc;
64        p1 := PChar(FileName);
65        p2 := StrRScan(p1, ',');
66        if (p2 <> nil) then
67        begin
68          p := p2 - p1 + 1;
69          IconIndex := StrToInt(Copy(FileName, p + 1, Length(FileName) - p));
70          SetLength(FileName, p - 1);
71        end;
72      end;
73      if (ExtractIconEx(PChar(FileName), IconIndex, PLargeIcon^, PSmallIcon^, 1) <> 1)
74        then
75      begin
76        NoAssoc:
77        try
78          FileName := IncludeTrailingBackslash(GetSystemDir) + 'SHELL32.DLL';
79        except
80          FileName := 'C:\WINDOWS\SYSTEM\SHELL32.DLL';
81        end;
82        if (FileExt = '.DOC') then
83          IconIndex := 1
84        else if ((FileExt = '.EXE') or (FileExt = '.COM')) then
85          IconIndex := 2
86        else if (FileExt = '.HLP') then
87          IconIndex := 23
88        else if ((FileExt = '.INI') or (FileExt = '.INF')) then
89          IconIndex := 63
90        else if (FileExt = '.TXT') then
91          IconIndex := 64
92        else if (FileExt = '.BAT') then
93          IconIndex := 65
94        else if ((FileExt = '.DLL') or (FileExt = '.SYS') or (FileExt = '.VBX') or
95          (FileExt = '.OCX') or (FileExt = '.VXD')) then
96          IconIndex := 66
97        else if (FileExt = '.FON') then
98          IconIndex := 67
99        else if (FileExt = '.TTF') then
100         IconIndex := 68
101       else if (FileExt = '.FOT') then
102         IconIndex := 69
103       else
104         IconIndex := 0;
105       if ((ExtractIconEx(PChar(FileName), IconIndex, PLargeIcon^, PSmallIcon^, 1) <>
106         1)) then
107       begin
108         if (PLargeIcon <> nil) then
109           PLargeIcon^ := 0;
110         if (PSmallIcon <> nil) then
111           PSmallIcon^ := 0;
112       end;
113     end;
114   end;
115 begin
116   Path := IncludeTrailingBackSlash(Path);
117   Result := FindFirst(Path + '*.*', faDirectory, SR);
118   while (Result = 0) do
119   begin
120     if (((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..'))
121       then
122     begin
123       Item := TMenuItem.Create(Self);
124       Item.Caption := SR.Name;
125       Item.ImageIndex := 0;
126       Root.Add(Item);
127       CreateTreeMenus(Path + SR.Name, Item, ListImage);
128     end;
129     if (((SR.Attr and faAnyFile) <> 0) and (SR.Name <> '.') and (SR.Name <> '..'))
130       then
131     begin
132       Item := TMenuItem.Create(Self);
133       Item.Caption := SR.Name;
134       GetAssociatedIcon(sr.Name, nil, @SmallIcon);
135       IconA := TIcon.Create;
136       IconA.Handle := SmallIcon;
137       BitMapA := TBitMap.Create;
138       BitMapA.Width := IconA.Width;
139       BitMapA.Height := IconA.Height;
140       BitMapA.Canvas.Draw(0, 0, IconA);
141       BitMapA.TransparentMode := tmAuto;
142       Indice := ListImage.Add(BitMapA, nil);
143       Item.ImageIndex := Indice;
144       Root.Add(Item);
145     end;
146     Result := FindNext(SR);
147   end;
148   SysUtils.FindClose(SR);
149 end;
150 
151 procedure TfrmMain.FormCreate(Sender: TObject);
152 begin
153   CreateTreeMenus('c:\projects\', directory1, ImageList1);
154 end;


You can also use shgetfileinfo with SHGFI_ICON parameter in the place of checking individual file extension. 

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC