|
|
|
| Title | Create a bitmap in memory, draw on it, and save the result in a bitmap file |
|---|
| Keywords | memory bitmap, bitmap, CreateCompatibleDC, CreateCompatibleBitmap, pixels, save bitmap |
|---|
| Categories | Graphics, API |
|---|
|
|
|
The SaveMemoryBitmap subroutine opens a file for binary output. It writes a BITMAPFILEHEADER for the bitmap, then a BITMAPINFOHEADER, and finally the DIB pixel data.
|
|
' Save the memory bitmap into a bitmap file.
Private Sub SaveMemoryBitmap(memory_bitmap As MemoryBitmap, _
ByVal file_name As String)
Dim bitmap_file_header As BITMAPFILEHEADER
Dim fnum As Integer
Dim pixels() As Byte
' Fill in the BITMAPFILEHEADER.
With bitmap_file_header
.bfType = &H4D42 ' "BM"
.bfOffBits = Len(bitmap_file_header) + _
Len(memory_bitmap.bitmap_info.bmiHeader)
.bfSize = .bfOffBits + _
memory_bitmap.bitmap_info.bmiHeader.biSizeImage
End With
' Open the output bitmap file.
fnum = FreeFile
Open file_name For Binary As fnum
' Write the BITMAPFILEHEADER.
Put #fnum, , bitmap_file_header
' Write the BITMAPINFOHEADER.
' (Note that
' memory_bitmap.bitmap_info.bmiHeader.biHeight
' must be positive for this.)
Put #fnum, , memory_bitmap.bitmap_info
' Get the DIB bits.
ReDim pixels(1 To 4, _
1 To memory_bitmap.wid, _
1 To memory_bitmap.hgt)
GetDIBits memory_bitmap.hdc, memory_bitmap.hBM, _
0, memory_bitmap.hgt, pixels(1, 1, 1), _
memory_bitmap.bitmap_info, DIB_RGB_COLORS
' Write the DIB bits.
Put #fnum, , pixels
' Close the file.
Close fnum
End Sub
|
|
|
This program starts from Sub Main and has no visible components (so you know it isn't cheating somehow using a PictureBox). The Main subroutine makes the memory bitmap, draws on it, and calls SaveMemoryBitmap to save the bitmap file.
|
|
Private Sub Main()
Dim memory_bitmap As MemoryBitmap
Dim file_name As String
' Create the memory bitmap.
memory_bitmap = MakeMemoryBitmap(200, 200)
' Draw on the bitmap.
DrawOnMemoryBitmap memory_bitmap
' Save the picture.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = _
file_name & "\"
file_name = file_name & "memory_bitmap.bmp"
SaveMemoryBitmap memory_bitmap, file_name
' Delete the memory bitmap.
DeleteMemoryBitmap memory_bitmap
MsgBox "Done"
End Sub
|
| |
|
| |
|
|
