从二进制数据制作* .bmp图像

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 

这是得到的图像：

也请注意，微软画图似乎已经影响导致某些像素的扰单色图像的错误。