Getting the icon of an application, library or document

Problem/Question/Abstract:

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:

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;

Copyright (c) 2001 Ernesto De Spirito
Visit: http://www.latiumsoftware.com/delphi-newsletter.php