Kreslení asociovaných ikon pomocí API

Konkrétně se jedná o tři funkce: ExtractAssociatedIcon, DrawIconEx a DestroyIcon. Pomocí těchto funkcí můžete zobrazit ikonu v jakémkoliv ovládacím prvku, který má hdc.

Příklad - jednoduchá prohlížečku asociovaných ikon

Na formulář vložte:
1x PictureBox
1x DriveListBox
1x DirListBox
1x FileListBox

a následující kód:

Option Explicit

'Konstanty pro kresleni ikon
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE

'Deklarace API funkci
'Ulozi do pameti pridruzenou ikonu
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" _
  Alias "ExtractAssociatedIconA" (ByVal hInst As Long, _
  ByVal lpIconPath As String, lpiIcon As Long) As Long

'Vykresli ikonu
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

'Zrusi ikonu v pameti
Private Declare Function DestroyIcon Lib "user32" _
  (ByVal hIcon As Long) As Long

Private Sub DrawIconPic(ByVal sFile As String)
   Dim lIcon As Long
   'Extract asociovane ikony
   lIcon = ExtractAssociatedIcon(App.hInstance, sFile, 2)
   'Vykreslit ikonu do pictureboxu
   DrawIconEx Picture1.hdc, 0, 0, lIcon, 0, 0, 0, 0, DI_NORMAL
   'Vyprazdnit ikonu z pameti
   DestroyIcon lIcon
End Sub

Private Sub File1_Click()
   Dim strFile
   strFile = strFile = Dir1.Path & _
      IIf(Right(Dir1.Path, 1) = "", "", "") & _
      File1.FileName
   'Smazat PictureBox
   Picture1.Cls
   'Vykreslit ikonu
   DrawIconPic strFile
End Sub

Private Sub Dir1_Change()
   File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
   Dir1.Path = Drive1.Drive
End Sub