Tirando o ícone associado de uma extensão de arquivo

Este artigo apresenta uma função que você pode usar para obter o ícone associado a um arquivo ou documento baseado em sua extensão de arquivo (ou seja, não importa se o arquivo ou documento já exista no disco ou não).

ExtractAssociatedIcon

Para obter o ícone de um aplicativo ou documento, pode utilizar essa função API (relatada na unidade ShellAPI):

function ExtractAssociatedIcon(hInst: HINST; lpIconPath: PChar;

  var lpiIcon: Word): HICON; stdcall;

hInst: A alavanca do aplicativo. Este valor está contido na variável pre-definida HInstance.

lpIconPath: um indicador para um caractere em buffer que deverá conter uma corda terminada nula com o nome completo do caminho do aplicativo, biblioteca (DLL) ou documento. Se for um documento, a função vai colocar lá o caminho completo do aplicativo associado ao ícone de onde foi extraído, de modo que devemos alocar um buffer grande o suficiente.

lpiIcon: O index do ícone (o primeiro ícone do arquivo tem um index de 0). Se lpIconPath especifica um documento, então lpiIcon está definido através da função (é por isso que ele é passado por referência) para o a posição index do atual ícone retirado do associado executável (definido no arquivo de associação).

Valor de retorno: Se a função falhar, ela retorna a 0. Se for bem sucedida, ela volta como um ícone handle, que é um valor inteiro que o Windows usa para identificar os recursos alocados. Não é necessário chamar a API DestroyIcon para liberar o ícone, uma vez que vai ser desalocado automaticamente quando o aplicativo terminar, embora você possa fazê-lo se quiser.

AMOSTRA

Agora, o que fazemos com o ícone handle? Normalmente o que nós queremos é um ícone, com nome e instância da classe TIcon. Tudo o que temos que fazer é criar um objeto TIcon e atribuir à sua propriedade Handle. Se mais tarde vamos atribuir outro valor para a propriedade Handle, o ícone anterior será automaticamente liberado. O mesmo acontece se o objeto TIcon é liberado.

Aqui está um exemplo de que as alterações no ícone do formulário:

usa SysUtils, Windows, ShellAPI;



  procedimento TForm1.Button1Click(Sender: TObject);

  var

    IconIndex: word;

    Buffer: array[0..2048] of char;

    IconHandle: HIcon;

  começo

    StrCopy(@Buffer, 'C:\Windows\Help\Windows.hlp');

    IconIndex := 0;

    IconHandle := ExtractAssociatedIcon(HInstance, Buffer, IconIndex);

    if IconHandle <> 0 then

      Icon.Handle := IconHandle;

  fim;

GETASSOCIATEDICON

Infelizmente, ExtractAssociatedIcon falha se o arquivo não existir no disco, portanto, nós definimos um procedimento que pega o ícone de um arquivo, este existindo ou não, e também poderá pegar o ícone pequeno (ideal para um TListView que pode ser exibido em estilos de exibição vsIcon ou vsReport). O procedimento recebe três parâmetros: o nome do arquivo e dois indicadores para variáveis hicon (inteiro): uma para o ícone grande (32x32) e outra para o ícone pequeno (16x16). Qualquer um deles pode ser nulo se você não precisar de um desses ícones. Os ícones "devolvidos", pelo procedimento terão que ser liberados com o API DestroyIcon. Isso será feito automaticamente se você atribuir o ícone handle (hicon) à propriedade Handle de um objeto TIcon (o ícone será disponível quando esse objeto se libertar ou um novo valor for atribuído a ele).


usa SysUtils, Registry, Windows, ShellAPI;



  tipo

    PHICON = ^HICON;



  procedimento GetAssociatedIcon(FileName: TFilename;

      PLargeIcon, PSmallIcon: PHICON);

  // Pegar os ícones de um dado arquivo

  var

    IconIndex: word; // Posicionar o ícone no arquivo

    FileExt, FileType: string;

    Reg: TRegistry;

    p: integer;

    p1, p2: pchar;

  label

    noassoc;

  começo

    IconIndex := 0;

    // Pegar a extensão do arquivo

    FileExt := UpperCase(ExtractFileExt(FileName));

    se ((FileExt <> '.EXE') and (FileExt <> '.ICO')) ou

        not FileExists(FileName) então comece

      // Se o arquivo é um EXE ou ICO e existe, então

      // nós vamos extraír o ícone deste arquivo. Senão

      // aqui nós vamos tentar achar o ícone associado em

      // Windows Registry...

      Reg := nil;

      tente

        Reg := TRegistry.Create(KEY_QUERY_VALUE);

        Reg.RootKey := HKEY_CLASSES_ROOT;

        se FileExt = '.EXE' then FileExt := '.COM';

        se Reg.OpenKeyReadOnly(FileExt) então

          tente

            FileType := Reg.ReadString('');

          finalmente

            Reg.CloseKey;

          fim;

        se (FileType <> '') and Reg.OpenKeyReadOnly(

            FileType + '\DefaultIcon') então

          tente

            FileName := Reg.ReadString('');

          finalmente

            Reg.CloseKey;

          fim;

      finalmente

        Reg.Free;

      fim;



      // Se nós não conseguirmos achar a associação, nós vamos

      // tentar pegar os ícones padrão

      se FileName = '' then goto noassoc;



      // Pegue o nome do arquivo e o índice de ícones da

      // associação (do formulário '"filaname",index')

      p1 := PChar(FileName);

      p2 := StrRScan(p1, ',');

      se p2 <> nulo então comece

        p := p2 - p1 + 1; // Posição do comma

        IconIndex := StrToInt(Copy(FileName, p + 1,

          Length(FileName) - p));

        SetLength(FileName, p - 1);

      fim;

    fim;

    // Tentativa de pegar o ícone

    if ExtractIconEx(pchar(FileName), IconIndex,

        PLargeIcon^, PSmallIcon^, 1) <> 1 então

    comece

noassoc:

      // A operação falhou ou o arquivo não estava associado

      // ícone. Tente pegar os ícones padrão em SHELL32.DLL



      tente // para pegar a localização de SHELL32.DLL

        FileName := IncludeTrailingBackslash(GetSystemDir)

          + 'SHELL32.DLL';

      exceto

        FileName := 'C:\WINDOWS\SYSTEM\SHELL32.DLL';

      fim;

      // Determinar o ícone padrão para a extensão do arquivo

      se (FileExt = '.DOC') então IconIndex := 1

      também se (FileExt = '.EXE')

           ou (FileExt = '.COM') então IconIndex := 2

      também se (FileExt = '.HLP') então IconIndex := 23

      também se (FileExt = '.INI')

           ou (FileExt = '.INF') então IconIndex := 63

      também se (FileExt = '.TXT') então IconIndex := 64

      também se (FileExt = '.BAT') então IconIndex := 65

      também se (FileExt = '.DLL')

           ou (FileExt = '.SYS')

           ou (FileExt = '.VBX')

           ou (FileExt = '.OCX')

           ou (FileExt = '.VXD') então IconIndex := 66

     também se (FileExt = '.FON') então IconIndex := 67

      também se (FileExt = '.TTF') então IconIndex := 68

      também se (FileExt = '.FOT') then IconIndex := 69

      também IconIndex := 0;

      // Tentativa de pegar o ícone.

      se ExtractIconEx(pchar(FileName), IconIndex,

          PLargeIcon^, PSmallIcon^, 1) <> 1 então

      comece

        // Falha em pegar o ícone. Simplesmente "returne" zeros.

        se PLargeIcon <> nil then PLargeIcon^ := 0;

        se PSmallIcon <> nil then PSmallIcon^ := 0;

      fim;

    fim;

  fim;



AMOSTRA

Esse exemplo vai mudar o ícone no seu formulário:



procedimento TForm1.Button1Click(Sender: TObject);

  var

    SmallIcon: HICON;

  comece

    GetAssociatedIcon('file.doc', nil, @SmallIcon);

    se SmallIcon <> 0 então

      Icon.Handle := SmallIcon;

  fim;