Private Function GetTypeIcon(filename As String, icon_size _
    As Long) As IPictureDisp
Dim index As Integer
Dim hIcon As Long
Dim item_num As Long
Dim icon_pic As IPictureDisp
Dim sh_info As SHFILEINFO

    SHGetFileInfo filename, FILE_ATTRIBUTE_NORMAL, sh_info, _
        Len(sh_info), SHGFI_USEFILEATTRIBUTES Or _
        (SHGFI_ICON + icon_size)

    hIcon = sh_info.hIcon
    Set icon_pic = IconToPicture(hIcon)
    Set GetTypeIcon = icon_pic
End Function

' Convert an icon handle into an IPictureDisp.
Private Function IconToPicture(hIcon As Long) As _
    IPictureDisp
Dim cls_id As CLSID
Dim hRes As Long
Dim new_icon As TypeIcon
Dim lpUnk As IUnknown

    With new_icon
        .cbSize = Len(new_icon)
        .picType = vbPicTypeIcon
        .hIcon = hIcon
    End With
    With cls_id
        .id(8) = &HC0
        .id(15) = &H46
    End With
    hRes = OleCreatePictureIndirect(new_icon, _
        cls_id, 1, lpUnk)
    If hRes = 0 Then Set IconToPicture = lpUnk
End Function

Private Sub cboFileTypes_Click()
    On Error GoTo LoadPictureError

    SmallIconPicture.Picture = _
        GetTypeIcon(cboFileTypes.Text, SHGFI_SMALLICON)
    SmallIconLabel.Caption = _
        Format$(SmallIconPicture.ScaleWidth) & _
        "x" & _
        Format$(SmallIconPicture.ScaleHeight)

    LargeIconPicture.Picture = _
        GetTypeIcon(cboFileTypes.Text, SHGFI_LARGEICON)
    LargeIconLabel.Caption = _
        Format$(LargeIconPicture.ScaleWidth) & _
        "x" & _
        Format$(LargeIconPicture.ScaleHeight)
    
    Exit Sub

LoadPictureError:
    Beep
    Caption = "TypeIcons [Invalid picture]"
    Exit Sub
End Sub