Extraire l'icone associé au fichierRésolu

Question

Le titre ne correspond pas trop au problème car j'arrive à extraire l'icone qui est associé à un fichier avec ce code :

Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public 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
Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE

Public Function DrawFileIcon(Zone As Object, File As String) As Boolean
    Dim Icone As Long
    Zone.Cls
    Icone = ExtractAssociatedIcon(App.hInstance, File, -2)
    DrawIconEx Zone.hdc, 0, 0, Icone, 0, 0, 0, 0, DI_NORMAL
    DestroyIcon Icone
End Function

Mais le problème c'est que les icones que j'extrait sont en 32*32 et je les veux en 16*16. J'ai essayé de passer par une imagebox pour les redimensionner mais c'est trop moche... Donc j'aimerais savoir comment récupérer l'icone en 16*16... Merci

@ +
MadMatt

cs_Warning · Accepted Answer

Public Const DJM_SMALLICON = &H6605
Public Const MAX_PATH = 260

Public Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type

Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Public Declare Function ImageList_GetIcon Lib "comctl32.dll" (ByVal himl&, ByVal i&, ByVal flags&) As Long

Private Function PrintIco(StartImage As PictureBox, LstImage As ImageList, Filename As String) As Long      'Ajoute l'icône 16*16 d'un fichier à un contrôle ImageList en gérant la transparence...
    Dim hIcon As Long, hBitmap As Long
    Dim hIco As Long, Nicon As Long, FileLib As Long, SHFinfo As SHFILEINFO
    hIco = SHGetFileInfo(Filename, 0&, SHFinfo, Len(SHFinfo), DJM_SMALLICON)
    hIcon = ImageList_GetIcon(hIco, SHFinfo.iIcon, 0)
    LstImage.MaskColor = StartImage.BackColor
    StartImage.Cls
    DrawIcon StartImage.hdc, 0, 0, hIcon
    StartImage.Refresh
    Call LstImage.ListImages.Add(LstImage.ListImages.Count + 1, , StartImage.Image)
End Function

>Puis:

    Call PrintIco(imgIco, IconList, filename)
    Set CurrentFileAdd = lstResult.ListItems.Add(, , filename, IconList.ListImages.Count, IconList.ListImages.Count)

Mail:ASC.Warning@caramail.com
Website: http://www.hexorciser.fr.st/

Warning

cs_CanisLupus · Answer

Salut,

Essaie :

DrawIconEx Zone.hdc, 0, 0, Icone, 16, 16, 0, 0, DI_NORMAL

Cordialement, CanisLupus

MadM@tt · Answer

Oui mais la c'est comme si je redimensionne l'icone avec l'imagebox, c'est moche alors que l'icone en 16*16 est spécialement créé pour cette taille donc plus joli

cs_CanisLupus · Answer

Alors va voir cet exemple ça devrait t'aider :

http://www.vbaccelerator.com/home/VB/Code/Libraries/Graphics_and_GDI/DrawState_Function/Icon_and_ImageList_Drawing_Sample.asp

Cordialement, CanisLupus

MadM@tt · Answer

Pas mal mais ça ne répond pas a mon problème, moi je veux extraire du fichier en 16*16, pas le redimensionner en 16*16...

MadM@tt · Answer

Non de djeu trop BON !
Merci infiniment Warning...
Juste une question : Est ce qu'on est vraiment obligé de passer par une imagelist, je vais essayer ce soir sans mais ça sert a rien que j'essaye si c'est pas possible...

@ +
MadMatt

cs_Warning · Answer

Bah oui c possible:

Private Function PrintIco(StartImage As PictureBox,Filename As String) As Long 'Ajoute l'icône 16*16 d'un fichier à un contrôle ImageList en gérant la transparence...
Dim hIcon As Long, hBitmap As Long
Dim hIco As Long, Nicon As Long, FileLib As Long, SHFinfo As SHFILEINFO
hIco = SHGetFileInfo(Filename, 0&, SHFinfo, Len(SHFinfo), DJM_SMALLICON)
hIcon = ImageList_GetIcon(hIco, SHFinfo.iIcon, 0)
StartImage.Cls
DrawIcon StartImage.hdc, 0, 0, hIcon
StartImage.Refresh
End Function

ça met direct l'icone direct dans l'objet StartImage, une picturebox.

Voili

Mail:ASC.Warning@caramail.com
Website: http://www.hexorciser.fr.st/

Warning

MadM@tt · Answer

Ah génial c'est encore mieu, encore une fois merci !!

cs_Warning · Answer

Quand on peut aider ;)
Mail:ASC.Warning@caramail.com
Website: http://www.hexorciser.fr.st/

Warning

Extraire l'icone associé au fichier

9 réponses

Discussions similaires