Make a *.bmp image from binary data

Question

How would I make a *.bmp image using 1 bit per pixel using VB6? Does an example project exist for something like this?

'#              # Image Data Info   :                                           #
'#              #               Each black dot are represented as binary 1(high)#
'#              #               and white are represented as binary 0(low) in   #
'#              #               form of hexadecimal character.                  #
'#              # Example       : (for this example assume the image width is 8)#
'#              #               Data        : 7E817E                            #
'#              #               Binary data : 7=0111, E=1110, 8=1000, 1=0001    #
'#              #                             7=0111, E=1110                    #
'#              #               Image data  : px1 px2 px3 px4 px5 px6 px7 px8   #
'#              #                         px1  w   b   b   b   b   b   b   w    #
'#              #                         px2  b   w   w   w   w   w   w   b    #
'#              #                         px3  w   b   b   b   b   b   b   w    #
'#              #                                                               #
'#              #                           w = white, b = black, px = pixel    #

Details:

Split text-hex data into pieces (rows), `width/8` character pairs per row. Allocate a `Byte` array `b` with number of rows and columns matching number of pieces and number of character pairs per piece, respectively. For each character pair in each piece, store its `val("&h" & pair)` value in the array at the respective position. Call `CreateCompatibleDC(0)`, select into it a `CreateBitmap(width, height, 1, 1, ByVal 0&)`, declare a `BITMAPINFO` structure `bi`, fill it with correct dimensions, and call `SetDIBits(hDC, hBitmap, 0, height, b(lbound(b)), bi, DIB_PAL_COLORS)`. — GSerg, Oct 08 '14 at 11:13
Or resize a `PictureBox` on the form, loop through the character pairs, loop through individual pixels inside each character pair (the eight powers of two within the `val("&h" & pair)`) to see which ones are `1`, and `Picture1.Pset` for each pixel with the respective color. — GSerg, Oct 08 '14 at 11:19

score 0 · Accepted Answer · answered Aug 14 '15 at 13:36

You may use the following code, please note that:

the image width must be a multiple of 8;
the rows start from the bottom;

If the requirements are not good for you, the code can be fixed accordingly.

Option Explicit

Private Type BITMAPFILEHEADER
    bfType As String * 2
    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 RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(1) As RGBQUAD
End Type

Public Function strToBmp(str As String, w As Integer, h As Integer, filename As String) As Boolean
Dim bmfh    As BITMAPFILEHEADER
Dim bmi     As BITMAPINFO
Dim r   As Boolean
Dim ff  As Integer
Dim i   As Integer
Dim x   As Integer
Dim rl  As Integer
Dim rw  As Integer
Dim s   As String
Dim b   As Byte
    rw = ((w + 31) \ 32 + 3) And &HFFFFFFFC
    With bmfh
        .bfType = "BM"
        .bfSize = Len(bmfh) + Len(bmi) + rw * h
        .bfOffBits = Len(bmfh) + Len(bmi)
    End With
    With bmi.bmiHeader
        .biSize = Len(bmi.bmiHeader)
        .biWidth = w
        .biHeight = h
        .biPlanes = 1
        .biBitCount = 1
        .biCompression = 0
        .biSizeImage = rw * h
        .biXPelsPerMeter = 72
        .biYPelsPerMeter = 72
        .biClrUsed = 0
        .biClrImportant = 0
    End With
    With bmi.bmiColors(0)
        .rgbRed = 255
        .rgbGreen = 255
        .rgbBlue = 255
    End With
    On Error Resume Next
    Call Kill(filename)
    On Error GoTo e2
    ff = FreeFile()
    Open filename For Binary Access Write As #ff
    On Error GoTo e1
    Put #ff, , bmfh
    Put #ff, , bmi
    For i = 1 To Len(str) Step 2
        b = CByte("&H" & Mid(str, i, 2))
        Put #ff, , b
        rl = rl + 1
        x = x + 8
        If x = w Then
            b = 0
            Do While rl < rw
               Put #ff, , b
               rl = rl + 1
            Loop
            x = 0
            rl = 0
        End If
    Next i
    r = True
e1:
    Close ff
e2:
    strToBmp = r
End Function

Public Sub test()
    Call strToBmp("7E817E", 8, 3, "out.bmp")
End Sub

This is the resulting image:

Please also note that Microsoft Paint seems to have a bug which affects monochromatic images resulting in the scrambling of some pixels.

Make a *.bmp image from binary data

1 Answers1