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

如何使用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    #

详情：

---

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

• 图像宽度必须是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

选项显式
私有类型BITMAPFILEHEADER
bfType作为字符串*2
大小与长度相同
bReserved1为整数
bReserved2为整数
B和B一样长
端型
私有类型BitMapInfo标头
一分为二
宽度与长度相同
双倍高度
作为整数的双平面
双比特计数为整数
双压缩等长
比斯泽姆年龄一样长
倍径渗透计
双渗透计等长
长时间使用
这一点同样重要
端型
私有类型RGBQUAD
rgbBlue作为字节
rgbGreen作为字节
RGA作为字节
RGB用作字节
端型
私有类型BITMAPINFO
bmiHeader作为BitMapInfo标头
BMI颜色（1）为RGBQUAD
端型
作为布尔值的公共函数strToBmp（str为字符串，w为整数，h为整数，文件名为字符串）
作为BITMAPFILEHEADER的Dim bmfh
将bmi设置为位图信息
Dim r为布尔型
将ff设置为整数
作为整数的Dim i
作为整数的Dim x
作为整数的Dim rl
作为整数的Dim rw
像线一样变暗
作为字节的Dim b
rw=（（w+31）\32+3）和&hfffffc
与bmfh
.bfType=“BM”
.bfSize=Len（bmfh）+Len（bmi）+rw*h
.bOffBits=Len（bmfh）+Len（bmi）
以
使用bmi.bmi标头
.biSize=Len（bmi.bmiHeader）
.白车身宽度=w
.biHeight=h
.双翼飞机=1
.bibibitcount=1
.biCompression=0
.biSizeImage=rw*h
.biXPelsPerMeter=72
.biYPelsPerMeter=72
.BICLRUSE=0
.BICLR=0
以
使用bmi.bmi颜色（0）
.RGR=255
.rgbGreen=255
.rgbBlue=255
以
出错时继续下一步
调用Kill（文件名）
关于错误转到e2
ff=FreeFile（）
打开二进制访问的文件名写入为#ff
关于错误转到e1
放#ff，bmfh
Put#ff，体重指数
对于i=1到Len（str）步骤2
b=CByte（“&H”和Mid（str，i，2））
放#ff，b
rl=rl+1
x=x+8
如果x=w，则
b=0
当rl

这是生成的图像：

---

还请注意，Microsoft Paint似乎存在一个影响单色图像的错误，导致某些像素出现混乱。

将文本十六进制数据拆分为若干个（行），

宽度/8

字符对/行。分配一个

Byte

数组

b

，其行数和列数分别与片段数和每个片段的字符对数相匹配。对于每个片段中的每个字符对，将其

val（“&h”&pair）

值存储在相应位置的数组中。调用

CreateCompatibleDC（0）

，在其中选择一个

CreateBitmap（宽度、高度、1、ByVal 0&）

，声明一个

BITMAPINFO

结构

bi

，用正确的尺寸填充它，然后调用

SetDIBits（hDC、hBitmap、0、height、b（lbound（b））、bi、DIB\u PAL\u颜色）

。或者在表单上调整

PictureBox

的大小，在字符对中循环，在每个字符对中循环各个像素（在

val（“&h”&pair）

）中循环两个的八次幂），查看每个像素的

1

，以及

Picture1.Pset

。