Dessiner l'icone d'un fichier en 16x16 ou en 32x32


Propriétés du code


Date de création : 10/04/2007 à 22:24:00
0 Commentaire(s)
  MadMatt

 

Présentation


Ces 2 fonctions permettent de récupérer et dessiner l'icone d'un fichier dans une picturebox, en 16x16 ou en 32x32.

 

Code


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


 
 

Modifier le code

Seul les admins et l'auteur du code lui même peuvent modifier ce code.

 

Commentaires


Ajouter un commentaire


Vous devez être connecté pour pouvoir poster un commentaire.

 
 

Valid HTML 4.01 Transitional Valid CSS

Site web de Vb System Library version 1.3
Developpement et design réalisé par : Matthieu Napoli (MadMatt)
© 2007 Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
Temps d'execution de la page : 0.006 s
www.mnapoli.fr