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
Seul les admins et l'auteur du code lui même peuvent modifier ce code.