Can I BitBlt() a bitmap to another .bmp file??

[Guest_imported]

What I have to do is change colors in a bitmap and then save it. I can use API functions to change the bits in memory , but I'm having trouble permanently saving the file to disk. Can I use the BitBlt() function to copy the memory bitmap into a file(by using the file's hDC) or is there a better way of saving changed bitmaps?

(I'm working in VBA so I can't use PictureBox's)

Please help!

 

[strongm]

Files don't have an hDC. However, you CAN trick an Image control into working with a DC.

If you are using the API to play with the bits is it safe to assume that you have a handle to a memory DC?

Here is a illustrative example. Note that there are several assumptions:
1) You have a handle to the DC with your bitmap
2) That you know the dimensions of your bitmap
3) You have an image control that ALREADY has a picture loaded that is the same size as yor bitmap (this can just be a blank BMP of the correct dimensions). The image control can be visible or not, as you please

Point 3 above is actually a shortcoming of the method - but I leave it as an exercise for the reader to figure out a way of avoiding this presizing issue...

(I also have a vague feeling at the back of my mind that there is an easier way to do this...)

Option Explicit

Const SRCCOPY = &HCC0020

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub SaveMemhDC(strFilename As String, ByVal MemhDC As Long, lWidth As Long, lHeight As Long, imgWorking As Image)
Dim hDC As Long
Dim CleverPic As IPicture
Dim myhDC As Long
Dim prevhDC As Long
Dim myhBmp As Long
Dim result As Long
Dim hgdi As Long



Set CleverPic = imgWorking.Picture ' Expose IPicture interface of StdPicture
' create a compatible DC in memory
myhDC = CreateCompatibleDC(MemhDC) 'CleverPic.CurDC)

' This is where we cheat by fooling the image control as to
' which DC it is using

' Switch the DC StdPicture is using to our memory DC
CleverPic.SelectPicture myhDC, prevhDC, hgdi

' Blit the source image to the destination
Call BitBlt(myhDC, 0, 0, 50, 50, MemhDC, 0, 0, SRCCOPY)

SavePicture CleverPic, strFilename

imgWorking.Refresh ' let the image control refresh itself; not really necessary

' Switch back to be nice and tidy
CleverPic.SelectPicture prevhDC, myhDC, hgdi



' Clean up
DeleteObject myhDC
End Sub

 

[strongm]

As I supected, there's a cleaner way of doing this - just took me a while to figure out. You still need to either have the handle of a DC containing the image, or a handle to the bitmap itself.

You can then call either:

SavePicture PictureFromhBmp(BitmapHandle), "yourfilename.bmp"

or

SavePicture PictureFromhBmp(GethBmpFromhDC(DCHandle,WidthInPixels,HeightInPixels)), "yourfilename.bmp"

Option Explicit

Private Type PICTDESC
lSize As Long
lType As Long
hImage As Long
hPal As Long
lReserved As Long
End Type

Private Type IID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type


Private Const S_OK = &H0
Private Const SRCCOPY = &HCC0020

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 SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (lpPictDesc As PICTDESC, RefIid As IID, ByVal fOwn As Boolean, IPict As IPicture) As Long


Public Function PictureFromhBmp(ByVal hBmp As Long) As IPicture
Dim IPict As IPicture
Dim lpPictDesc As PICTDESC
Dim iidIPict As IID

If hBmp Then

' Minimally initialise PICTDESC structure
With lpPictDesc
.lSize = Len(lpPictDesc)
.lType = vbPicTypeBitmap
.hImage = hBmp
End With

'GUID for IUnknown Interface
'{00000000-0000-0000-C000-000000000046}
iidIPict.Data4(0) = &HC0
iidIPict.Data4(7) = &H46

If OleCreatePictureIndirect(lpPictDesc, iidIPict, True, IPict) = S_OK Then
Set PictureFromhBmp = IPict
End If

End If
End Function

Public Function GethBmpFromhDC(ByVal hSrcDC As Long, ByVal lWidth As Long, ByVal lHeight As Long) As Long
Dim mybmp As Long
Dim myhdc As Long
Dim Oldbmp As Long
Dim lSuccess As Long

myhdc = CreateCompatibleDC(hSrcDC)
mybmp = CreateCompatibleBitmap(hSrcDC, lWidth, lHeight)
Oldbmp = SelectObject(myhdc, mybmp)

If BitBlt(myhdc, 0, 0, lWidth, lHeight, hSrcDC, 0, 0, SRCCOPY) Then

GethBmpFromhDC = mybmp
End If

' GDI clean up
mybmp = SelectObject(myhdc, Oldbmp)
DeleteObject myhdc
End Function