Author: Ernesto De Spirito
How can I get the icon of an application or the icons in a DLL?
Answer:
ExtractAssociatedIcon
To get the icon of an application or document we can use this API function
(declared in the ShellAPI unit):
function ExtractAssociatedIcon(hInst: HINST; lpIconPath: PChar;
var lpiIcon: Word): HICON; stdcall;
hInst: The application handle. This value is contained in the predefined variable
HInstance.
lpIconPath: A pointer to a character buffer that should contain a null terminated
string with the full path name of the application, library (DLL) or document. If
it is a document, the function will place there the full pathname of the
associated application from where the icon was extracted, so we should allocate a
buffer large enough.
lpiIcon: The icon index (the first icon in the file has an index of 0). If
lpIconPath specifies a document, then lpiIcon is set by the function (that's why it
is passed by reference) to the index position of the actual icon taken from the
associated executable (defined in the file association).
Return value:
If the function fails, it returns 0. If it succeeds, it returns an icon handle,
which is an integer value Windows uses to identify the allocated resource. It is
not necessary to call the API DestroyIcon to release the icon since it'll be
deallocated automatically when the application finishes, although you can do it if
you want.
Sample call
Now, what do we do with the icon handle? Normally what we want is an icon, namely
and instance of the TIcon class. All we have to do is create a TIcon object and
assign this handle to its Handle property. If later we assign the Handle property
to another value, the previous icon will be automatically be released. The same
happens if the TIcon object is freed. Here is an example that changes the icon of
the form:
1 procedure TForm1.Button1Click(Sender: TObject);
2 var
3 IconIndex: word;
4 Buffer: array[0..2048] of char;
5 IconHandle: HIcon;
6 begin
7 StrCopy(@Buffer, 'C:\Windows\Help\Windows.hlp');
8 IconIndex := 0;
9 IconHandle := ExtractAssociatedIcon(HInstance, Buffer, IconIndex);
10 if IconHandle <> 0 then
11 Icon.Handle := IconHandle;
12 end;
GetAssociatedIcon
Unfortunately, ExtractAssociatedIcon fails if the file does not exists on disk, so
we defined a procedure that gets the icon of a file whether it exists or not, and
can also get the small icon (ideal for a TListView that can be shown in vsIcon or
vsReport view styles). The procedure receives three parameters: the filename and
two pointers to HICON (integer) variables: one for the large icon (32x32) and
another one for the small icon (16x16). Any of them can be nil if you don't need
one of these icons. The icons "returned" by the procedure must be freed with the
DestroyIcon API. This will be done automatically if you assign the icon handle
(HICON) to the Handle property of a TIcon object
(the icon will be released when this object gets freed or a new value is assigned
to it).
13 uses
14 Registry, ShellAPI;
15
16 type
17 PHICON = ^HICON;
18
19 procedure GetAssociatedIcon(FileName: TFilename;
20 PLargeIcon, PSmallIcon: PHICON);
21 // Gets the icons of a given file
22 var
23 IconIndex: word; // Position of the icon in the file
24 FileExt, FileType: string;
25 Reg: TRegistry;
26 p: integer;
27 p1, p2: pchar;
28 label
29 noassoc;
30 begin
31 IconIndex := 0;
32 // Get the extension of the file
33 FileExt := UpperCase(ExtractFileExt(FileName));
34 if ((FileExt <> '.EXE') and (FileExt <> '.ICO')) or
35 not FileExists(FileName) then
36 begin
37 // If the file is an EXE or ICO and it exists, then
38 // we will extract the icon from this file. Otherwise
39 // here we will try to find the associated icon in the
40 // Windows Registry...
41 Reg := nil;
42 try
43 Reg := TRegistry.Create(KEY_QUERY_VALUE);
44 Reg.RootKey := HKEY_CLASSES_ROOT;
45 if FileExt = '.EXE' then
46 FileExt := '.COM';
47 if Reg.OpenKeyReadOnly(FileExt) then
48 try
49 FileType := Reg.ReadString('');
50 finally
51 Reg.CloseKey;
52 end;
53 if (FileType <> '') and Reg.OpenKeyReadOnly(
54 FileType + '\DefaultIcon') then
55 try
56 FileName := Reg.ReadString('');
57 finally
58 Reg.CloseKey;
59 end;
60 finally
61 Reg.Free;
62 end;
63
64 // If we couldn't find the association, we will
65 // try to get the default icons
66 if FileName = '' then
67 goto noassoc;
68
69 // Get the filename and icon index from the
70 // association (of form '"filaname",index')
71 p1 := PChar(FileName);
72 p2 := StrRScan(p1, ',');
73 if p2 <> nil then
74 begin
75 p := p2 - p1 + 1; // Position of the comma
76 IconIndex := StrToInt(Copy(FileName, p + 1,
77 Length(FileName) - p));
78 SetLength(FileName, p - 1);
79 end;
80 end;
81 // Attempt to get the icon
82 if ExtractIconEx(pchar(FileName), IconIndex,
83 PLargeIcon^, PSmallIcon^, 1) <> 1 then
84 begin
85 noassoc:
86 // The operation failed or the file had no associated
87 // icon. Try to get the default icons from SHELL32.DLL
88
89 try // to get the location of SHELL32.DLL
90 FileName := IncludeTrailingBackslash(GetSystemDir)
91 + 'SHELL32.DLL';
92 except
93 FileName := 'C:\WINDOWS\SYSTEM\SHELL32.DLL';
94 end;
95 // Determine the default icon for the file extension
96 if (FileExt = '.DOC') then
97 IconIndex := 1
98 else if (FileExt = '.EXE')
99 or (FileExt = '.COM') then
100 IconIndex := 2
101 else if (FileExt = '.HLP') then
102 IconIndex := 23
103 else if (FileExt = '.INI')
104 or (FileExt = '.INF') then
105 IconIndex := 63
106 else if (FileExt = '.TXT') then
107 IconIndex := 64
108 else if (FileExt = '.BAT') then
109 IconIndex := 65
110 else if (FileExt = '.DLL')
111 or (FileExt = '.SYS')
112 or (FileExt = '.VBX')
113 or (FileExt = '.OCX')
114 or (FileExt = '.VXD') then
115 IconIndex := 66
116 else if (FileExt = '.FON') then
117 IconIndex := 67
118 else if (FileExt = '.TTF') then
119 IconIndex := 68
120 else if (FileExt = '.FOT') then
121 IconIndex := 69
122 else
123 IconIndex := 0;
124 // Attempt to get the icon.
125 if ExtractIconEx(pchar(FileName), IconIndex,
126 PLargeIcon^, PSmallIcon^, 1) <> 1 then
127 begin
128 // Failed to get the icon. Just "return" zeroes.
129 if PLargeIcon <> nil then
130 PLargeIcon^ := 0;
131 if PSmallIcon <> nil then
132 PSmallIcon^ := 0;
133 end;
134 end;
135 end;
Sample call
This example will change the icon of your form:
136
137 procedure TForm1.Button1Click(Sender: TObject);
138 var
139 SmallIcon: HICON;
140 begin
141 GetAssociatedIcon('file.doc', nil, @SmallIcon);
142 if SmallIcon <> 0 then
143 Icon.Handle := SmallIcon;
144 end;
Copyright (c) 2001 Ernesto De Spiritomailto:edspirito@latiumsoftware.com
Visit: http://www.latiumsoftware.com/delphi-newsletter.php
|
