Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 226
  • Last Modified:

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!
0
VBDesigns
Asked:
VBDesigns
  • 3
  • 2
1 Solution
 
watyCommented:
'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.



0
 
watyCommented:
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
0
 
VBDesignsAuthor Commented:
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?
0
 
watyCommented:


       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
0
 
VBDesignsAuthor Commented:
That's exactly what I was looking for -- thank you very much!
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now