Const MAX_PATH = 260
 Const DI_MASK = &H1
 Const DI_IMAGE = &H2
 Const DI_NORMAL = &H3
 Const DI_COMPAT = &H4
 Const DI_DEFAULTSIZE = &H8
 
 
 Private Declare Function SHChangeIconDialog Lib "shell32" Alias "#62" (ByVal owner As Long, ByVal pszFileName As String, pdwBufferSize As Long, pdwIndex As Long) As Boolean
 Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
 Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
 Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
 
 
 Private Sub ExtractIcone(Lechemin As String)
    Dim sFileName  As String
    Dim sUnicode   As String
    Dim nIconIdx   As Long
    Dim hSmallIcon As Long
    Dim hLargeIcon As Long
    Dim Pos        As Long
    
    sFileName = Lechemin & String$(MAX_PATH - Len(sFileName), 0)
    
    sUnicode = StrConv(sFileName, vbUnicode)
   
    If SHChangeIconDialog(Me.hWnd, sUnicode, 0, nIconIdx) Then
    
       sFileName = StrConv(sUnicode, vbFromUnicode)
       Pos = InStr(sFileName, vbNullChar)
       If Pos Then sFileName = Left$(sFileName, Pos - 1)
    
       If ExtractIconEx(sFileName, nIconIdx, hLargeIcon, hSmallIcon, 1) > 0 Then
          DrawIconEx Me.hdc, 0, 8, hSmallIcon, 0, 0, 0, 0, DI_NORMAL
          DrawIconEx Me.hdc, 32, 8, hLargeIcon, 0, 0, 0, 0, DI_NORMAL
          DestroyIcon hSmallIcon
          DestroyIcon hLargeIcon
          End If
       End If
 
 End Sub
 
 
 Rem utilisation
    ExtractIcone ("shell32.dll")
 
 
 

// à déclarer dans la partie Interface
Function PickIconDlgW(OwnerWnd: HWND; lpstrFile: PWideChar; var nMaxFile: LongInt; var lpdwIconIndex: LongInt): LongBool; stdcall; external
'SHELL32.DLL' index 62; 


Implementation
Uses ShellApi;  // pour  ExtractIconExW
 

// Utilisation :
Procedure TfrmMain.btn_ChangeIconeClick(Sender: TObject);
Var
  FileName :  array[0..MAX_PATH - 1] of WideChar;
  Size, Index: LongInt;
  hLargeIcon, hSmallIcon : HIcon;
Begin
  Size := MAX_PATH;
  StringToWideChar('%SystemRoot%\system32\Shell32.dll', FileName, MAX_PATH);
  // ouvre le Dialogue Changer d'Icône
  If PickIconDlgW(Self.Handle, FileName, Size, Index) Then
    If (Index <> -1) Then
    If ExtractIconExW( FileName, Index, hLargeIcon, hSmallIcon, 1) > 0 Then
    Begin
      // on change l'icône de la fiche principale
      Icon.Handle := hSmallIcon;
      // et on dessine le LargeIcone sur la fiche
      DrawIcon(Canvas.Handle, 10, 10, hLargeIcon);
      // Et on libère la mémoire
      DestroyIcon(hLargeIcon);
      DestroyIcon(hSmallIcon);
    End;
End;