Binaryworld - How to extract associated icon of a file and draw in various state (i. ... [ VB -> Graphics ]

This sample demonstrates how simple it is to draw disabled, colourised and dithered icons, image or string. This task can be accomplished by DrawState API. DrawState can draw string, image or icon in normal, disabled, colourised or dithered state.

Step-By-Step Example

- Create a standard exe project
- Add the following code in form1

Click here to copy the following block

Option Explicit

' Corrected Draw State function declarations:
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" _
    (ByVal hdc As Long, _
    ByVal hBrush As Long, _
    ByVal lpDrawStateProc As Long, _
    ByVal lParam As Long, _
    ByVal wParam As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cX As Long, _
    ByVal cY As Long, _
    ByVal fuFlags As Long) As Long

Private Declare Function DrawStateString Lib "user32" Alias "DrawStateA" _
    (ByVal hdc As Long, _
    ByVal hBrush As Long, _
    ByVal lpDrawStateProc As Long, _
    ByVal lpString As String, _
    ByVal cbStringLen As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cX As Long, _
    ByVal cY As Long, _
    ByVal fuFlags 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 Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" ( _
    ByVal crColor As Long) As Long

Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" ( _
    ByVal hInst As Long, _
    ByVal lpIconPath As String, _
    lpiIcon As Long) As Long

' Missing Draw State constants declarations:
'/* Image type */
Private Const DST_COMPLEX = &H0
Private Const DST_TEXT = &H1
Private Const DST_PREFIXTEXT = &H2
Private Const DST_ICON = &H3
Private Const DST_BITMAP = &H4

' /* State type */
Private Const DSS_NORMAL = &H0
Private Const DSS_UNION = &H10
Private Const DSS_DISABLED = &H20
Private Const DSS_MONO = &H80
Private Const DSS_RIGHT = &H8000

Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_NORMAL = DI_MASK Or DI_IMAGE

Const GAP = 65
Private Sub Form_Paint()
  Const S_TOP = 70
  Const S_LEFT = 5

  Dim hIcon As Long, hIconSmall As Long, hIconLarge As Long, hBr As Long
  Dim file As String
  Dim nTop As Integer, nLeft As Integer
  Dim sPath, i As Integer

  sPath = App.Path & "\"

  Me.ScaleMode = vbPixels
  Me.Font.Bold = True

  nTop = S_TOP
  nLeft = S_LEFT
  hBr = CreateSolidBrush(RGB(134, 0, 200))

  ' draw strings in various states
  Call DrawStateString(Me.hdc, 0, 0, "Extracted", Len("Extracted"), nLeft + GAP, nTop - 15, 0, 0, DST_TEXT)
  Call DrawStateString(Me.hdc, 0, 0, "Normal", Len("Normal"), nLeft + GAP * 2, nTop - 15, 0, 0, DST_TEXT Or DSS_NORMAL)
  Call DrawStateString(Me.hdc, 0, 0, "Disabled", Len("Disabled"), nLeft + GAP * 3, nTop - 15, 0, 0, DST_TEXT Or DSS_DISABLED)
  Call DrawStateString(Me.hdc, hBr, 0, "Coloured", Len("Coloured"), nLeft + GAP * 4, nTop - 15, 0, 0, DST_TEXT Or DSS_MONO)
  Call DrawStateString(Me.hdc, 0, 0, "Dithered", Len("Dithered"), nLeft + GAP * 5, nTop - 15, 0, 0, DST_TEXT Or DSS_UNION)

  ' start the search
  file = Dir$(sPath)
  Do While Len(file)
    ' we've found a new file
    file = sPath & file

    'Extract the associated icon
    hIcon = ExtractAssociatedIcon(App.hInstance, file, 0)

    'Draw the icon on the form
    DrawIconEx Me.hdc, nLeft + GAP, nTop, hIcon, 0, 0, 0, 0, DI_NORMAL

    ' draw the icon at the position indicated by nLeftPos, nTopPos
    Call DrawState(Me.hdc, 0, 0, hIcon, 0, nLeft + GAP * 2, nTop, 0, 0, DST_ICON)
    Call DrawState(Me.hdc, 0, 0, hIcon, 0, nLeft + GAP * 3, nTop, 0, 0, DST_ICON Or DSS_DISABLED)
    Call DrawState(Me.hdc, hBr, 0, hIcon, 0, nLeft + GAP * 4, nTop, 0, 0, DST_ICON Or DSS_MONO)
    Call DrawState(Me.hdc, 0, 0, hIcon, 0, nLeft + GAP * 5, nTop, 0, 0, DST_ICON Or DSS_UNION)  '//DSS_UNION (dithering) Seems ton work on only NT

    'remove the icon from the memory
    DestroyIcon hIcon
    DestroyIcon hIconSmall
    DestroyIcon hIconLarge

    nTop = nTop + 35

    ' get ready for the next iteration
    file = Dir$
    i = i + 1
    '//only show for 5 files then stop
    If i > 5 Then Exit Do
  Loop

  DeleteObject hBr
End Sub