Group: Forum Members
Posts: 1,
Visits: 1
|
Try CreatePicture function from here:
Private Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" (Pic As PictDesc, _
RefIID As Guid, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long
Private Type PictDesc
Size As Long
Type As Long
hImage As Long
Data1 As Long
Data2 As Long
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
End Type
Private Type PicIcon
Size As Long
Type As Long
hIcon As Long
End Type
Private Type PicWmf
Size As Long
Type As Long
hMeta As Long
xExt As Long
yExt As Long
End Type
Private Type PicEmf
Size As Long
Type As Long
hEmf As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Const S_OK As Long = 0
Public Function CreatePicture(ByVal hImage As Long, _
Optional ByVal PicType As PictureTypeConstants = vbPicTypeBitmap, _
Optional Data1 As Long = 0, _
Optional Data2 As Long = 0) As IPicture
Dim Pic As PictDesc
Dim IPic As IPicture
Dim IID_IDispatch As Guid
' Fill in with IDispatch Interface ID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
' Fill PictDesc struct with necessary parts
With Pic
.Size = Len(Pic) ' Length of structure
.Type = PicType ' Type of Picture
.hImage = hImage ' Handle to image
.Data1 = Data1
.Data2 = Data2
End With
' Create and return Picture object
If OleCreatePictureIndirect(Pic, IID_IDispatch, False, IPic) = S_OK Then
Set CreatePicture = IPic
End If
End Function
Public Function CreateBitmapPicture(ByVal hBmp As Long, _
Optional hPal As Long = 0) As IPicture
Dim Pic As PictDesc
Dim IPic As IPicture
Dim IID_IDispatch As Guid
' Fill in with IDispatch Interface ID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
' Fill PicBmp struct with necessary parts
With Pic
.Size = Len(Pic) ' Length of structure
.Type = vbPicTypeBitmap ' Type of Picture
.hImage = hBmp ' Handle to bitmap
.Data1 = hPal ' Handle to palette (may be null)
End With
' Create and return Picture object
If OleCreatePictureIndirect(Pic, IID_IDispatch, True, IPic) = S_OK Then
Set CreateBitmapPicture = IPic
End If
End Function
|