Option Explicit
 
Const MAX_PATH = 260
 
Private Declare Function DrawIconEx Lib "user32.dll" (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 ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" _
(ByVal lpszFile As String, ByVal nIconIndex As Long, ByRef phiconLarge As Long, _
ByRef phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As _
Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
 
Private Type SHFILEINFO
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type
 
Private Sub Form_Load()
' Picture1 dient nur als Buffer
 Picture1.AutoRedraw = True
 Picture1.Visible = False
 Picture1.BorderStyle = 0
 Picture1.BackColor = Command1.BackColor
 Command1.Picture = PictureFromFile("C:\")
 Command2.Picture = PictureFromFile("C:\Windows\explorer.exe")
End Sub
 
Public Function PictureFromFile(ByVal vsFileName As String, Optional Small As _
  Boolean) As StdPicture
  Dim LIcon(0) As Long
  Dim SIcon(0) As Long
  Dim SHFI As SHFILEINFO
  SHGetFileInfo vsFileName, -1, SHFI, -1, IIf(Small = True, &H101, &H100)
 
  ' Wenn keine Icon ermittelt werden konnte...
  If SHFI.hIcon = 0 Then
   ExtractIconEx "shell32.dll", 0, LIcon(0), SIcon(0), 1
   SHFI.hIcon = IIf(Small = True, SIcon(0), LIcon(0))
  End If
 
  Picture1.Picture = LoadPicture()                  ' Picturebox zurücksetzen
  Picture1.Width = IIf(Small = True, 16 * Screen.TwipsPerPixelX, 32 * _
    Screen.TwipsPerPixelY) ' Breite der Picturebox anpassen
  Picture1.Height = Picture1.Width                   ' Höhe der Picturebox 
  ' anpassen
  DrawIconEx Picture1.hdc, 0, 0, SHFI.hIcon, 0, 0, 0, 0, 3  ' Das Icon auf die 
  ' Picturebox zeichnen
  Set PictureFromFile = Picture1.Image   ' Und den Rückgabewert für die 
  ' Funktion setzen
  DestroyIcon SHFI.hIcon
End Function