Question

如何使用VB6使用每像素1位制作* .bmp图像？是否存在类似这样的示例项目？

'#              # 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    #

详细说明：

Answer 1

您可以使用以下代码，请注意：

图像宽度必须是8的倍数;
行从底部开始;

如果要求不合适，可以相应修改代码。

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

这是结果图像：

请注意，Microsoft Paint似乎有一个影响单色图像的错误，导致某些像素的加扰。

从二进制数据生成* .bmp图像

1 个答案: