從二進制數據製作* .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 

這是得到的圖像：

也請注意，微軟畫圖似乎已經影響導致某些像素的擾單色圖像的錯誤。