- ' Structure d'un GUID
- Public Type GUID
- Data1 As Long
- Data2 As Integer
- Data3 As Integer
- Data4(0 To 7) As Byte
- End Type
-
- ' Structure contenant des infos sur une image
- Public Type PICTDESC
- ' Normalement cette structure contient une union mais VB ne les gère pas
- cbSizeofStruct As Long ' Taille de cette structure
- picType As Long ' Type d'image : ICON, BITMAP, METAFILE, ENHMETAFILE
- ' Début union
- hImage As Long ' Handle de l'image
- xExt As Long ' Taille x de l'image pour une METAFILE
- yExt As Long ' Taille y de l'image pour une METAFILE
- End Type
-
- ' picType de PICTDESC pour une ICON
- Public Const PICTYPE_ICON = 3
-
- 'permet de convertir une structure PICTDESC (et donc un handle d'image) en un IPictureDisp (= StdPicture)
- Public Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp)
-
-
- ' Convertit un pointeur vers un icone en IPictureDisp utilisable dans VB
- ' hIcon : handle de l'icone à convertir
- ' Renvoie une interface IPictureDisp (ou StdPicture pour VB)
- Public Function GetIconFromHandle(hIcon As Long) As IPictureDisp
- ' Le REFIID de IPictureDisp (=GUID)
- Dim IID_IPictureDisp As GUID
- ' Infos sur l'icone
- Dim lpIcon As PICTDESC
- 'on met place l'IID de IPictureDisp
- IID_IPictureDisp.Data1 = &H7BF80981
- IID_IPictureDisp.Data2 = &HBF32
- IID_IPictureDisp.Data3 = &H101A
- IID_IPictureDisp.Data4(0) = &H8B
- IID_IPictureDisp.Data4(1) = &HBB
- IID_IPictureDisp.Data4(2) = &H0
- IID_IPictureDisp.Data4(3) = &HAA
- IID_IPictureDisp.Data4(4) = &H0
- IID_IPictureDisp.Data4(5) = &H30
- IID_IPictureDisp.Data4(6) = &HC
- IID_IPictureDisp.Data4(7) = &HAB
- ' On initialise les champs requis :
- lpIcon.cbSizeofStruct = Len(lpIcon)
- lpIcon.hImage = hIcon
- ' le type : ICON
- lpIcon.picType = PICTYPE_ICON
- 'on demande la création d'une interface de type IPictureDisp pour le handle d'icône
- 'et en indiquant de ne pas effacer le HICON quand l'interface est libéré
- OleCreatePictureIndirect lpIcon, IID_IPictureDisp, 0, GetIconFromHandle
- End Function
' Structure d'un GUID
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
' Structure contenant des infos sur une image
Public Type PICTDESC
' Normalement cette structure contient une union mais VB ne les gère pas
cbSizeofStruct As Long ' Taille de cette structure
picType As Long ' Type d'image : ICON, BITMAP, METAFILE, ENHMETAFILE
' Début union
hImage As Long ' Handle de l'image
xExt As Long ' Taille x de l'image pour une METAFILE
yExt As Long ' Taille y de l'image pour une METAFILE
End Type
' picType de PICTDESC pour une ICON
Public Const PICTYPE_ICON = 3
'permet de convertir une structure PICTDESC (et donc un handle d'image) en un IPictureDisp (= StdPicture)
Public Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp)
' Convertit un pointeur vers un icone en IPictureDisp utilisable dans VB
' hIcon : handle de l'icone à convertir
' Renvoie une interface IPictureDisp (ou StdPicture pour VB)
Public Function GetIconFromHandle(hIcon As Long) As IPictureDisp
' Le REFIID de IPictureDisp (=GUID)
Dim IID_IPictureDisp As GUID
' Infos sur l'icone
Dim lpIcon As PICTDESC
'on met place l'IID de IPictureDisp
IID_IPictureDisp.Data1 = &H7BF80981
IID_IPictureDisp.Data2 = &HBF32
IID_IPictureDisp.Data3 = &H101A
IID_IPictureDisp.Data4(0) = &H8B
IID_IPictureDisp.Data4(1) = &HBB
IID_IPictureDisp.Data4(2) = &H0
IID_IPictureDisp.Data4(3) = &HAA
IID_IPictureDisp.Data4(4) = &H0
IID_IPictureDisp.Data4(5) = &H30
IID_IPictureDisp.Data4(6) = &HC
IID_IPictureDisp.Data4(7) = &HAB
' On initialise les champs requis :
lpIcon.cbSizeofStruct = Len(lpIcon)
lpIcon.hImage = hIcon
' le type : ICON
lpIcon.picType = PICTYPE_ICON
'on demande la création d'une interface de type IPictureDisp pour le handle d'icône
'et en indiquant de ne pas effacer le HICON quand l'interface est libéré
OleCreatePictureIndirect lpIcon, IID_IPictureDisp, 0, GetIconFromHandle
End Function