VBDesigns
asked on
How do I get a hBMP into a Picture object without using hDC?
I guess I've been working on too many things for too long since I can't seem to remember (or figure out) the easiest way to get a bitmap (via hBMP) into a Picture object...
Anyone know how to do this?
Thanks!
Anyone know how to do this?
Thanks!
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
nType As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long
Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
' #VBIDEUtils#************** ********** ********** ********** ********** ******
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 13/10/98
' * Time : 09:18
' * Module Name : Capture_Module
' * Module Filename : Capture.bas
' * Procedure Name : CreateBitmapPicture
' * Parameters :
' * ByVal hBmp As Long
' * ByVal hPal As Long
' ************************** ********** ********** ********** ********** ****
' * Comments : Creates a bitmap type Picture object from a bitmap
' * and palette
' * hBmp
' * - Handle to a bitmap
' *
' * hPal
' * - Handle to a Palette
' * - Can be null if the bitmap doesn't use a palette
' *
' * Returns
' * - Returns a Picture object containing the bitmap
' *
' *
' ************************** ********** ********** ********** ********** ****
Dim r As Long
Dim Pic As PicBmp
' *** IPicture requires a reference to "Standard OLE Types"
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 Pic with necessary parts
With Pic
.Size = Len(Pic) ' Length of structure
.nType = vbPicTypeBitmap ' Type of Picture (bitmap)
.hBmp = hBmp ' Handle to bitmap
.hPal = hPal ' Handle to palette (may be null)
End With
' *** Create Picture object
r = OleCreatePictureIndirect(P ic, IID_IDispatch, 1, ipic)
' *** Return the new Picture object
Set CreateBitmapPicture = ipic
End Function
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
nType As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long
Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 13/10/98
' * Time : 09:18
' * Module Name : Capture_Module
' * Module Filename : Capture.bas
' * Procedure Name : CreateBitmapPicture
' * Parameters :
' * ByVal hBmp As Long
' * ByVal hPal As Long
' **************************
' * Comments : Creates a bitmap type Picture object from a bitmap
' * and palette
' * hBmp
' * - Handle to a bitmap
' *
' * hPal
' * - Handle to a Palette
' * - Can be null if the bitmap doesn't use a palette
' *
' * Returns
' * - Returns a Picture object containing the bitmap
' *
' *
' **************************
Dim r As Long
Dim Pic As PicBmp
' *** IPicture requires a reference to "Standard OLE Types"
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 Pic with necessary parts
With Pic
.Size = Len(Pic) ' Length of structure
.nType = vbPicTypeBitmap ' Type of Picture (bitmap)
.hBmp = hBmp ' Handle to bitmap
.hPal = hPal ' Handle to palette (may be null)
End With
' *** Create Picture object
r = OleCreatePictureIndirect(P
' *** Return the new Picture object
Set CreateBitmapPicture = ipic
End Function
ASKER
I am aware of this method, but it doesn't get the graphic into a picture object (remember, picture objects don't have DCs). I knew that I could use this method to BLT the graphic to the destination (via a hidden picture box if necessary), but the problem is that I have a number of image controls that size the image properly and I'm looking to pop the bitmaps in them without having to replace them as Picture boxes and do a StretchDIB or StretchBlt. I will use the afore mentioned method if necessary (even though it's an ugly hack), but I'd prefer to do it another way...
Is there any way to change the hBMP reference of a Picture object to another hBMP?
Is there any way to change the hBMP reference of a Picture object to another hBMP?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
That's exactly what I was looking for -- thank you very much!
Const IMAGE_BITMAP = &O0
Const LR_LOADFROMFILE = 16
Const LR_CREATEDIBSECTION = 8192
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'And use this code to load a bitmap and copy it to the form
Dim hBitmap As Long, lBMDC As Long, sBitmapInfo As BITMAP
'Load the bitmap
hBitmap = LoadImage(0, "C:\MyFile.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
'make sure the call succeeded
If (hBitmap = 0) Then
MsgBox "Error, Unable To Load Bitmap", vbOKOnly, "Bitmap Load Error"
Exit Sub
End If
'Create new Device Context
lBMDC = CreateCompatibleDC(0)
'make sure the call succeeded
If (lBMDC = 0) Then
MsgBox "Error, Unable To Create Device Context", vbOKOnly, "Device Context Error"
Exit Sub
End If
'attach the bitmap to the device context just created
SelectObject lBMDC, hBitmap
'get the information about this image
GetObject hBitmap, Len(sBitmapInfo), sBitmapInfo
'Copy the bitmap to the form
BitBlt Me.hdc, 0, 0, sBitmapInfo.bmWidth, sBitmapInfo.bmHeight, lBMDC, 0, 0, vbSrcCopy
'Just change the "C:\MyFile.bmp" to the file you want.
'Don't forget to DELETEDC and DELETEOBJECT after you
'are done with the picture.