1 Attachment(s)
How to save an image to a BMP byte array with support for 32-bit BMP images on VB6
I have written a module that allows you to save any images to a byte array, represented as a BMP file, which can then, if desired, be saved to disk.
The BMP file is assembled manually, from scratch, with its own code, without using GDIPlusAPI, due to which it should work even in Windows 95.
When saving BMP files, all transparent pixels for 32-bit BMP are taken into account. However, not all viewers support displaying transparency in BMP.
In the test sample program, you can upload a PNG file with support for translucent pixels to a PictureBox and then save it to a 32-bit BMP file.
Also, the SavePictureAsBitmap function presented in this module allows you to convert images into 2-color, 16-color, 256-color files, as well as into 16-bit, 24-bit and 32-bit images.
Code:
Option Explicit
'//////////////////////////////////////////////////
'// Module for saving images to a BMP byte array //
'// Copyright (c) 2025-01-26 by HackerVlad //
'// e-mail: [email protected] //
'// Version 1.2 //
'//////////////////////////////////////////////////
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hbm As Long, ByVal nStartScan As Long, ByVal cLines As Long, lpvBits As Any, lpbmi As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(255) As Long
End Type
Private Type BITMAP
bmType As Long
bmWidth As Long ' the width of the bitmap
bmHeight As Long ' the height of the bitmap
bmWidthBytes As Long ' the number of bytes needed to store 1 scanline.
' = bmwidth*(bmBitsPixel/8)+padding bytes (if needed)
bmPlanes As Integer
bmBitsPixel As Integer ' the number of bits needed to store the color value of 1 pixel
bmBits As Long
End Type
Public Enum SetBPP
NoConvert = 0 ' Save the current picture bitrate
ConvertTo1bpp = 1 ' 2 colors
ConvertTo4bpp = 4 ' 16 colors
ConvertTo8bpp = 8 ' 256 colors
ConvertTo16bpp = 16
ConvertTo24bpp = 24
ConvertTo32bpp = 32
End Enum
' hBitmap is an StdPicture, that is, it can be, for example, Picture1.Picture or Picture1.Image or Image1.Picture
Public Function SavePictureAsBitmap(ByVal hBitmap As Long, BmpFileData() As Byte, Optional ByVal BitsPerPixel As SetBPP) As Boolean
Dim WidthArray As Long, hdc As Long, ret As Long, ret2 As Long
Dim bpp As Integer, i As Integer
Dim FileHeader As BITMAPFILEHEADER
Dim bInfo As BITMAPINFO
Dim hBmp As BITMAP
Dim nCol As Byte
Dim Palette() As Long
Dim bArray() As Byte
' Acceptable BitsPerPixel values: 0 (leave the image without bpp changes), 1 (2 colors), 4 (16 colors), 8 (256 colors), 16, 24, 32
If BitsPerPixel <> 0 And BitsPerPixel <> 1 And BitsPerPixel <> 4 And BitsPerPixel <> 8 And BitsPerPixel <> 16 And BitsPerPixel <> 24 And BitsPerPixel <> 32 Then Exit Function
bpp = BitsPerPixel
GetObject hBitmap, LenB(hBmp), hBmp ' We get all the necessary information about the image
If bpp = 0 Then
bpp = hBmp.bmBitsPixel ' Set the default bits per pixel value for the image
End If
bInfo.bmiHeader.biHeight = hBmp.bmHeight
bInfo.bmiHeader.biWidth = hBmp.bmWidth
bInfo.bmiHeader.biPlanes = hBmp.bmPlanes
bInfo.bmiHeader.biBitCount = bpp
bInfo.bmiHeader.biSize = Len(bInfo.bmiHeader)
hdc = GetDC(0) ' We are cheating a little by using the default monitor hDC here
ret = GetDIBits(hdc, hBitmap, 0, hBmp.bmHeight, ByVal 0&, bInfo, 0)
If ret Then
WidthArray = bInfo.bmiHeader.biSizeImage / bInfo.bmiHeader.biHeight
ReDim bArray((WidthArray * bInfo.bmiHeader.biHeight) - 1)
ret2 = GetDIBits(hdc, hBitmap, 0, hBmp.bmHeight, bArray(0), bInfo, 0)
If ret2 Then
Select Case bpp
Case 1
bInfo.bmiHeader.biClrUsed = 2
bInfo.bmiHeader.biClrImportant = 2
nCol = 1
Case 4
bInfo.bmiHeader.biClrUsed = 16
bInfo.bmiHeader.biClrImportant = 16
nCol = 15
Case 8
bInfo.bmiHeader.biClrUsed = 256
bInfo.bmiHeader.biClrImportant = 256
nCol = 255
Case 16, 24, 32
nCol = 0
End Select
If nCol > 0 Then ' If a palette is needed
ReDim Palette(nCol)
For i = 0 To nCol
Palette(i) = bInfo.bmiColors(i)
Next
End If
FileHeader.bfType = &H4D42 ' BM
FileHeader.bfOffBits = Len(FileHeader) + Len(bInfo.bmiHeader) + IIf(nCol, (nCol + 1) * 4, 0) ' + palette, if needed
FileHeader.bfSize = Len(FileHeader) + Len(bInfo.bmiHeader) + IIf(nCol, (nCol + 1) * 4, 0) ' + palette, if needed
FileHeader.bfSize = FileHeader.bfSize + UBound(bArray) + 1
ReDim BmpFileData(FileHeader.bfSize - 1) ' Allocate memory for a BMP file array
' We collect a BMP file from various structures
CopyMemory BmpFileData(0), FileHeader.bfType, 2 ' Write FileHeader (stage 1)
CopyMemory BmpFileData(2), FileHeader.bfSize, Len(FileHeader) - 2 ' Write FileHeader (stage 2)
CopyMemory BmpFileData(Len(FileHeader)), bInfo.bmiHeader, Len(bInfo.bmiHeader) ' Write BitmapInfoHeader
If nCol > 0 Then ' If a palette is needed
CopyMemory BmpFileData(Len(FileHeader) + Len(bInfo.bmiHeader)), Palette(0), (nCol + 1) * 4 ' Write Palette
End If
CopyMemory BmpFileData(FileHeader.bfOffBits), bArray(0), UBound(bArray) + 1 ' Write an array of a bitmap
SavePictureAsBitmap = True
End If
End If
ReleaseDC 0, hdc
End Function
Re: How to save an image to a BMP byte array with support for 32-bit BMP images on VB
Re: How to save an image to a BMP byte array with support for 32-bit BMP images on VB
Thanks for shareing usfull code 5 from me *****
Re: How to save an image to a BMP byte array with support for 32-bit BMP images on VB
Re: How to save an image to a BMP byte array with support for 32-bit BMP images on VB
Use it to your heart's content!
