API - abrir dialogo para escolher icone do windows

uses ShellAPI;

function SelecionarIcone(IconeAtual: string = ''; IconeIndice: Integer = 0): string;

type

  SHChangeIconProcW = function(wnd: HWND; szFileName: PWideChar; reserved: integer; var lpIconIndex: integer): DWORD; stdcall;

  SHChangeIconProc  = function(wnd: HWND; szFileName: PChar; reserved: integer; var lpIconIndex: integer): DWORD; stdcall;

var

  buf : array[0..MAX_PATH] of char;

  bufW: array[0..MAX_PATH] of WideChar;

  SHChangeIconW: SHChangeIconProcW;

  SHChangeIcon : SHChangeIconProc;

  fIconIndex   : Integer;

  ShellHandle  : THandle;

begin

  Result      := '';

  fIconIndex  := IconeIndice;

  ShellHandle := Windows.LoadLibrary(PChar(shell32));

  if ShellHandle <> 0 then

  begin

    if Win32Platform = VER_PLATFORM_WIN32_NT then // NT, XP, etc

    begin

      SHChangeIconW := GetProcAddress(ShellHandle, PChar(62));

      StringToWideChar(IconeAtual, bufW, sizeof(bufW));

      if SHChangeIconW(Application.Handle, bufW, sizeof(bufW), fIconIndex) = 1 then Result := bufW;

    end

    else

    begin

      SHChangeIcon := GetProcAddress(ShellHandle, PChar(62));

      StrPCopy(buf, IconeAtual);

      if SHChangeIcon(Application.Handle, buf, sizeof(buf), fIconIndex) = 1 then Result := buf;

    end;

    Result := Result + ',' + IntToStr(fIconIndex);

  end

  else

    ShowMessage('Função não suportada por esta versão do Windows');

  if Shellhandle <> 0 then FreeLibrary(ShellHandle);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  Caption := SelecionarIcone('c:\frente\frente.exe', 0);

end;