Private Declare Function ImageList_Draw Lib "comctl32" (ByVal himl As Long, ByVal i As Long, ByVal hDCDest As Long, ByVal X As Long, ByVal y As Long, ByVal Flags As Long) As Long
Private Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Private Const FILE_ATTRIBUTE_NORMAL    As Long = &H80
Private Const SHGFI_USEFILEATTRIBUTES  As Long = &H10
Private Const SHGFI_DISPLAYNAME        As Long = &H200
Private Const SHGFI_TYPENAME            As Long = &H400
Private Const SHGFI_SMALLICON          As Long = &H1
Private Const SHGFI_LARGEICON          As Long = &H0
Private Const SHGFI_ICON                As Long = &H100

Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000
Private Const SHGFI_SHELLICONSIZE = &H4
 
Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE

Private Type SHFILEINFO
    hIcon          As Long
    iIcon          As Long
    dwAttributes    As Long
    szDisplayName  As String * 260
    szTypeName      As String * 80
End Type



'---------------------------------------------------------------------------------------
' Procedure : PaintFileIcon16
' DateTime  : 10/04/2007 22:09
' Author    : Vb System Library
' Purpose  : Dessine l'icone d'un fichier en 16*16 dans l'objet pointé par le hDC
' Params    : FullPath : Chemin d'accès au fichier
'              hDC : hDC de l'objet dans lequel doit etre paint l'icone
'---------------------------------------------------------------------------------------
Public Function PaintFileIcon16(ByVal FullPath As String, ByVal hDC As Long)

    Dim vSHFI As SHFILEINFO
    Dim vAttr As Long
    Dim hImgSmall As Long
    Dim Ftype As String
    Dim pos As Long

    vAttr = BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON
    hImgSmall = SHGetFileInfo(FullPath, 0&, vSHFI, Len(vSHFI), vAttr)

    If vSHFI.iIcon = 0 Then
        vAttr = BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON Or SHGFI_USEFILEATTRIBUTES 'Or SHGFI_TYPENAME  'Or SHGFI_ICON 'SHGFI_LARGEICON
        hImgSmall = SHGetFileInfo(FullPath, 0&, vSHFI, Len(vSHFI), vAttr)
    End If
   
    Call ImageList_Draw(hImgSmall, vSHFI.iIcon, hDC, 0, 0, &H1)

End Function


'---------------------------------------------------------------------------------------
' Procedure : PaintFileIcon32
' DateTime  : 10/04/2007 22:09
' Author    : Vb System Library
' Purpose  : Dessine l'icone d'un fichier en 32*32 dans l'objet pointé par le hDC
' Params    : FullPath : Chemin d'accès au fichier
'              hDC : hDC de l'objet dans lequel doit etre paint l'icone
'---------------------------------------------------------------------------------------
Public Function PaintFileIcon32(ByVal FullPath As String, ByVal hDC As Long)

    Dim vSHFI As SHFILEINFO
    Dim vAttr As Long
    Dim hImgSmall As Long
    Dim Ftype As String
    Dim pos As Long

    vAttr = BASIC_SHGFI_FLAGS Or SHGFI_ICON
    hImgSmall = SHGetFileInfo(FullPath, 0&, vSHFI, Len(vSHFI), vAttr)

    If vSHFI.iIcon = 0 Then
        vAttr = BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_USEFILEATTRIBUTES 'Or SHGFI_TYPENAME  'Or SHGFI_ICON 'SHGFI_LARGEICON
        hImgSmall = SHGetFileInfo(FullPath, 0&, vSHFI, Len(vSHFI), vAttr)
    End If
   
    Call ImageList_Draw(hImgSmall, vSHFI.iIcon, hDC, 0, 0, &H1)

End Function