Link to home
Start Free TrialLog in
Avatar of VBDesigns
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!
Avatar of waty
waty
Flag of Belgium image

'Declare this in the general section of your form
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.



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(Pic, IID_IDispatch, 1, ipic)

   ' *** Return the new Picture object
   Set CreateBitmapPicture = ipic

End Function
Avatar of VBDesigns
VBDesigns

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?
ASKER CERTIFIED SOLUTION
Avatar of waty
waty
Flag of Belgium image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
That's exactly what I was looking for -- thank you very much!