Obteniendo el icono de una aplicación o documento

Copyright © 2000 Ernesto De Spirito

ExtractAssociatedIcon

Para obtener el icono de una aplicación o documento podemos usar esta función API (declarada en la unidad ShellAPI):

function ExtractAssociatedIcon(hInst: HINST; lpIconPath: PChar; var lpiIcon: Word): HICON; stdcall;

hInst: El manejador de nuestra aplicación. Este valor está contenido en la variable predefinida HInstance.

lpIconPath: Un puntero a un buffer de caracteres que debería contener una cadena terminada en nulo con el nombre y camino de la aplicación, biblioteca (DLL) o documento. Si es un documento, la función colocará allí el nombre y camino completo de la aplicación asociada de la cual se extrajo el icono, así que debería asignar un buffer suficientemente grande.

lpiIcon: El índice del icono a extraer. El índice del primer icono en el archivo es 0. Si lpIconPath especifica un documento, entonces lpiIcon se establece por la función (por eso se pasa por referencia) al índice del verdadero icono que se tomó del ejecutable asociado (definido en las asociaciones de archivos).

Valor devuelto: Si la función falla, devuelve 0. Si tiene éxito, devuelve un manejador de icono, que es un valor entero que Windows usa para identificar el recurso asignado. No es necesario llamar a la API DestroyIcon para liberar el icono puesto que será liberado automáticamente cuando la aplicación termine, aunque puede hacerlo antes si quiere.

Llamada de ejemplo

Ahora, ¿qué hacemos con el manejador de icono? Normalmente lo que queremos es un icono, específicamente una instancia de la clase TIcon. Todo lo que tenemos que hacer es crear un objeto TIcon y asignar este manejador a la propiedad Handle. Si luego le asignamos otro valor a esta propiedad, el icono actual será liberado automáticamente. Lo mismo ocurre cuando el objeto TIcon se libera.

Aquí va un ejemplo de código fuente que cambia el icono de un formulario:

uses SysUtils, Windows, ShellAPI;

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

Desafortunadamente, ExtractAssociatedIcon fallará si el archivo no existe en el disco, así que hemos definido un procedimiento que obtendrá el icono de un archivo ya sea que éste exista o no, y también obtendrá el icono pequeño (ideal para un TListView que se pueda mostrar en las vistas vsIcon o vsReport). El procedimiento recibe tres parámetros: el nombre del archivo y dos punteros a variables HICON (integer), uno para el icono grande (32x32) y otro para el icono pequeño (16x16). Cualquiera de ellos puede ser nil si no necesita una de esos iconos. Los iconos "devueltos" por el procedimiento deben ser liberados con la API DestroyIcon. Esto se hará automáticamente si asigna el manejador del icono (HICON) a la propiedad Handle de un objeto TIcon (el icono será liberado cuando este objeto sea liberado o cuando se le asigne un nuevo valor).

uses SysUtils, Registry, Windows, ShellAPI;

type
  PHICON = ^HICON;

procedure GetAssociatedIcon(NomArch: TFilename;
    PIconazo, PIconito: PHICON);
// Obtiene los iconos de un archivo dado
var
  Indice: UINT;  // Posición del icono en el archivo
  Extension, TipoArch: string;
  Reg: TRegistry;
  p: integer;
  p1, p2: pchar;
label
  noassoc;
begin
  Indice := 0;
  // Obtiene la extensión del archivo
  Extension := UpperCase(ExtractFileExt(NomArch));
  if ((Extension <> '.EXE') and (Extension <> '.ICO')) or
      not FileExists(NomArch) then begin
    // Si el archivo es un EXE o un ICO y existe, entonces
    // extraeremos el icono de ese archivo. Caso contrario
    // trataremos aquí de hallar el icono asociado en el
    // Registro de Windows...
    Reg := nil;
    try
      Reg := TRegistry.Create(KEY_QUERY_VALUE);
      Reg.RootKey := HKEY_CLASSES_ROOT;
      if Extension = '.EXE' then Extension := '.COM';
      if Reg.OpenKeyReadOnly(Extension) then
        try
          TipoArch := Reg.ReadString('');
        finally
          Reg.CloseKey;
        end;
      if (TipoArch <> '') and Reg.OpenKeyReadOnly(
          TipoArch + '\DefaultIcon') then
        try
          NomArch := Reg.ReadString('');
        finally
          Reg.CloseKey;
        end;
    finally
      Reg.Free;
    end;

    // Si no se encontró la asociación, trataremos de
    // obtener los iconos predeterminados
    if NomArch = '' then goto noassoc;

    // Obtiene el nombre del archivo y el índice del icono
    // de la asociación (de la forma 'archivo,índice')
    p1 := PChar(NomArch);
    p2 := StrRScan(p1, ',');
    if p2 <> nil then begin
      p := p2 - p1 + 1;  // Posición de la coma
      Indice := StrToInt(Copy(NomArch, p + 1,
        Length(NomArch) - p));
      SetLength(NomArch, p - 1);
    end;
  end;
  // Intenta obtener el icono
  if ExtractIconEx(pchar(NomArch), Indice,
      PIconazo^, PIconito^, 1) <> 1 then
  begin
noassoc:
    // La operación falló o el archivo no tenía icono
    // asociado. Trataremos de obtener los iconos
    // predeterminados de SHELL32.DLL

    try // obtener la ubicación de SHELL32.DLL
      NomArch := IncludeTrailingBackslash(GetSystemDir)
        + 'SHELL32.DLL';
    except
      NomArch := 'C:\WINDOWS\SYSTEM\SHELL32.DLL';
    end;
    // Determinar el icono predeterminado
    // según la extensión del archivo
    if      (Extension = '.DOC') then Indice := 1
    else if (Extension = '.EXE')
         or (Extension = '.COM') then Indice := 2
    else if (Extension = '.HLP') then Indice := 23
    else if (Extension = '.INI')
         or (Extension = '.INF') then Indice := 63
    else if (Extension = '.TXT') then Indice := 64
    else if (Extension = '.BAT') then Indice := 65
    else if (Extension = '.DLL')
         or (Extension = '.SYS')
         or (Extension = '.VBX')
         or (Extension = '.OCX')
         or (Extension = '.VXD') then Indice := 66
    else if (Extension = '.FON') then Indice := 67
    else if (Extension = '.TTF') then Indice := 68
    else if (Extension = '.FOT') then Indice := 69
    else Indice := 0;
    // Intentamos obtener el icono
    if ExtractIconEx(pchar(NomArch), Indice,
        PIconazo^, PIconito^, 1) <> 1 then
    begin
      // Falló la obtención del icono. "Devolver" ceros.
      if PIconazo <> nil then PIconazo^ := 0;
      if PIconito <> nil then PIconito^ := 0;
    end;
  end;
end;

Llamada de ejemplo

Este ejemplo cambiará el icono de su formulario:

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