Getting the icon of an application, library or document

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:

procedure TForm1.Button1Click(Sender: TObject);
var
IconIndex: word;
Buffer: array[0..2048] of char;
IconHandle: HIcon;
begin
StrCopy(@Buffer, 'C:\Windows\Help\Windows.hlp');
IconIndex := 0;
IconHandle := ExtractAssociatedIcon(HInstance, Buffer, IconIndex);
if IconHandle <> 0 then
Icon.Handle := IconHandle;
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).

uses
Registry, ShellAPI;

type
PHICON = ^HICON;

procedure GetAssociatedIcon(FileName: TFilename;
PLargeIcon, PSmallIcon: PHICON);
// Gets the icons of a given file
var
IconIndex: word; // Position of the icon in the file
FileExt, FileType: string;
Reg: TRegistry;
p: integer;
p1, p2: pchar;
label
noassoc;
begin
IconIndex := 0;
// Get the extension of the file
FileExt := UpperCase(ExtractFileExt(FileName));
if ((FileExt <> '.EXE') and (FileExt <> '.ICO')) or
not FileExists(FileName) then begin
// If the file is an EXE or ICO and it exists, then
// we will extract the icon from this file. Otherwise
// here we will try to find the associated icon in the
// Windows Registry...
Reg := nil;
try
Reg := TRegistry.Create(KEY_QUERY_VALUE);
Reg.RootKey := HKEY_CLASSES_ROOT;
if FileExt = '.EXE' then FileExt := '.COM';
if Reg.OpenKeyReadOnly(FileExt) then
try
FileType := Reg.ReadString('');
finally
Reg.CloseKey;
end;
if (FileType <> '') and Reg.OpenKeyReadOnly(
FileType + '\DefaultIcon') then
try
FileName := Reg.ReadString('');
finally
Reg.CloseKey;
end;
finally
Reg.Free;
end;

// If we couldn't find the association, we will
// try to get the default icons
if FileName = '' then goto noassoc;

// Get the filename and icon index from the
// association (of form '"filaname",index')
p1 := PChar(FileName);
p2 := StrRScan(p1, ',');
if p2 <> nil then begin
p := p2 - p1 + 1; // Position of the comma
IconIndex := StrToInt(Copy(FileName, p + 1,
Length(FileName) - p));
SetLength(FileName, p - 1);
end;
end;
// Attempt to get the icon
if ExtractIconEx(pchar(FileName), IconIndex,
PLargeIcon^, PSmallIcon^, 1) <> 1 then
begin
noassoc:
// The operation failed or the file had no associated
// icon. Try to get the default icons from SHELL32.DLL

try // to get the location of SHELL32.DLL
FileName := IncludeTrailingBackslash(GetSystemDir)
+ 'SHELL32.DLL';
except
FileName := 'C:\WINDOWS\SYSTEM\SHELL32.DLL';
end;
// Determine the default icon for the file extension
if (FileExt = '.DOC') then IconIndex := 1
else if (FileExt = '.EXE')
or (FileExt = '.COM') then IconIndex := 2
else if (FileExt = '.HLP') then IconIndex := 23
else if (FileExt = '.INI')
or (FileExt = '.INF') then IconIndex := 63
else if (FileExt = '.TXT') then IconIndex := 64
else if (FileExt = '.BAT') then IconIndex := 65
else if (FileExt = '.DLL')
or (FileExt = '.SYS')
or (FileExt = '.VBX')
or (FileExt = '.OCX')
or (FileExt = '.VXD') then IconIndex := 66
else if (FileExt = '.FON') then IconIndex := 67
else if (FileExt = '.TTF') then IconIndex := 68
else if (FileExt = '.FOT') then IconIndex := 69
else IconIndex := 0;
// Attempt to get the icon.
if ExtractIconEx(pchar(FileName), IconIndex,
PLargeIcon^, PSmallIcon^, 1) <> 1 then
begin
// Failed to get the icon. Just "return" zeroes.
if PLargeIcon <> nil then PLargeIcon^ := 0;
if PSmallIcon <> nil then PSmallIcon^ := 0;
end;
end;
end;

Sample call
-----------
This example will change the icon of your form:

procedure TForm1.Button1Click(Sender: TObject);
var
SmallIcon: HICON;
begin
GetAssociatedIcon('file.doc', nil, @SmallIcon);
if SmallIcon <> 0 then
Icon.Handle := SmallIcon;
end;