Solved

How do I get a hBMP into a Picture object without using hDC?

Posted on 1999-01-28
5
213 Views
Last Modified: 2012-06-22
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
Comment
Question by:VBDesigns
  • 3
  • 2
5 Comments
 
LVL 14

Expert Comment

by:waty
ID: 1471119
'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
 
LVL 14

Expert Comment

by:waty
ID: 1471120
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
 
LVL 2

Author Comment

by:VBDesigns
ID: 1471121
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
 
LVL 14

Accepted Solution

by:
waty earned 50 total points
ID: 1471122


       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
 
LVL 2

Author Comment

by:VBDesigns
ID: 1471123
That's exactly what I was looking for -- thank you very much!
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now