VBA手动创建BMPVBA、BMP
我工作的一个VBA类创建QR codeS，我得到难倒在那里我写的QR数据位为实际的BMP文件的地步。要获得BMP结构的窍门和code，我可以我一直在努力，使全白用下面的code 21×21像素的位图。这只是每一行最左边一列是黄色而不是白色几乎工程。什么可能会发生任何想法？我猜有什么错我的头定义，但我不知道。我远离亲的骨形成蛋白。我的code基于关我发现这里的http://answers.microsoft.com/en-us/office/forum/office_2007-customize/how-can-i-create-a-bitmap-image-with-vba/4976480a-d20b-4b2a-8ecc-436428d9586b
专用类型typHEADER
文件strType作为字符串* 2'签名=BM
lngSize只要'文件大小
intRes1作为整数'保留= 0
intRes2作为整数'保留= 0
lngOffset只要偏移位图数据（位）
结束类型
专用类型typINFOHEADER
lngSize只要'大小
lngWidth只要高度
lngHeight只要长
intPlanes作为图像平面的整数'号文件
intBits由于每个像素的位数的整数数
lngCom pression作为龙'的COM pression类型（设置为0）
lngImageSize只要图像大小（字节，设置为0）
lngxResolution只要设备分辨率（设置为0）
lngyResolution只要设备分辨率（设置为0）
lngColorCount作为颜色龙'数（设为零24比特）
lngImportantColors只要'重要的颜色（设置为0）
结束类型
专用类型typPIXEL
bytB为字节'蓝
bytG为字节'绿色
bytR为字节'红
结束类型
专用类型typBITMAPFILE
bmfh作为typHEADER
bmfi作为typINFOHEADER
bmbits（）作为字节
结束类型
================================================= =
公用Sub makeBMP（intQR（）作为整数）
昏暗bmpFile作为typBITMAPFILE
昏暗lngRowSize只要
昏暗lngPixelArraySize只要
昏暗lngFileSize只要
昏暗的J，K，L，X为整数
朦胧bytRed，bytGreen，bytBlue作为整数
昏暗lngRGBColoer（）只要
昏暗strBMP作为字符串
随着bmpFile
随着.bmfh
.strType =BM
.lngSize = 0
.intRes1 = 0
.intRes2 = 0
.lngOffset = 54
结束与
随着.bmfi
.lngSize = 40
.lngWidth = 21
.lngHeight = 21
.intPlanes = 1
.intBits = 24
.lngCom pression = 0
.lngImageSize = 0
.lngxResolution = 0
.lngyResolution = 0
.lngColorCount = 0
.lngImportantColors = 0
结束与
lngRowSize = ROUND（.bmfi.intBits * .bmfi.lngWidth / 32）* 4
lngPixelArraySize = lngRowSize * .bmfi.lngHeight
REDIM .bmbits（lngPixelArraySize）
REDIM lngRGBColor（21，21）
对于j = 1至21'对于每一行，从底部开始，工作起来......
'每列从左边开始
对于x = 1至21
K = K + 1
.bmbits（K）= 255
K = K + 1
.bmbits（K）= 255
K = K + 1
.bmbits（K）= 255
下一个x
如果（21 * .bmfi.intBits / 8示lngRowSize）然后添加填充如果需要的话
对于升= 21 * .bmfi.intBits / 8 + 1要lngRowSize
K = K + 1
.bmbits（K）= 0
下一I
结束如果
下面j
.bmfh.lngSize = 14 + 40 + lngPixelArraySize
结束与'定义bmpFile
strBMP =C：\桌面\ Sample.BMP
打开strBMP对于二进制访问写为1长度= 1
把1，1，bmpFile.bmfh
把1，bmpFile.bmfi
把1，bmpFile.bmbits
关闭
结束小组
解决方案
这是一个连续字节对齐的问题。垫每行有一个额外的字节，你的问题应该消失。
发布，让你有一个答案核对。 ：）
此外，这里是一个很好的BMP工具。 https://50ab6472f92ea10153000096.openlearningapps.net/run/view
I am working on a VBA class to create QR codes and I am getting stumped at the point where I write the QR data bits to an actual BMP file. To get the hang of the BMP structure and the code I could I have been trying to make a 21 x 21 pixel bitmap of all white using the code below. This almost works, except that the leftmost column in every row is yellow instead of white. Any ideas on what could be happening? I'm guessing there is something wrong with my header definition, but I'm not sure. I am far from a pro at BMPs. My code is based off what I found here http://answers.microsoft.com/en-us/office/forum/office_2007-customize/how-can-i-create-a-bitmap-image-with-vba/4976480a-d20b-4b2a-8ecc-436428d9586b
Private Type typHEADER
strType As String * 2 ' Signature of file = "BM"
lngSize As Long ' File size
intRes1 As Integer ' reserved = 0
intRes2 As Integer ' reserved = 0
lngOffset As Long ' offset to the bitmap data (bits)
End Type
Private Type typINFOHEADER
lngSize As Long ' Size
lngWidth As Long ' Height
lngHeight As Long ' Length
intPlanes As Integer ' Number of image planes in file
intBits As Integer ' Number of bits per pixel
lngCompression As Long ' Compression type (set to zero)
lngImageSize As Long ' Image size (bytes, set to zero)
lngxResolution As Long ' Device resolution (set to zero)
lngyResolution As Long ' Device resolution (set to zero)
lngColorCount As Long ' Number of colors (set to zero for 24 bits)
lngImportantColors As Long ' "Important" colors (set to zero)
End Type
Private Type typPIXEL
bytB As Byte ' Blue
bytG As Byte ' Green
bytR As Byte ' Red
End Type
Private Type typBITMAPFILE
bmfh As typHEADER
bmfi As typINFOHEADER
bmbits() As Byte
End Type
'==================================================
Public Sub makeBMP(intQR() As Integer)
Dim bmpFile As typBITMAPFILE
Dim lngRowSize As Long
Dim lngPixelArraySize As Long
Dim lngFileSize As Long
Dim j, k, l, x As Integer
Dim bytRed, bytGreen, bytBlue As Integer
Dim lngRGBColoer() As Long
Dim strBMP As String
With bmpFile
With .bmfh
.strType = "BM"
.lngSize = 0
.intRes1 = 0
.intRes2 = 0
.lngOffset = 54
End With
With .bmfi
.lngSize = 40
.lngWidth = 21
.lngHeight = 21
.intPlanes = 1
.intBits = 24
.lngCompression = 0
.lngImageSize = 0
.lngxResolution = 0
.lngyResolution = 0
.lngColorCount = 0
.lngImportantColors = 0
End With
lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4
lngPixelArraySize = lngRowSize * .bmfi.lngHeight
ReDim .bmbits(lngPixelArraySize)
ReDim lngRGBColor(21, 21)
For j = 1 To 21 ' For each row, starting at the bottom and working up...
'each column starting at the left
For x = 1 To 21
k = k + 1
.bmbits(k) = 255
k = k + 1
.bmbits(k) = 255
k = k + 1
.bmbits(k) = 255
Next x
If (21 * .bmfi.intBits / 8 < lngRowSize) Then ' Add padding if required
For l = 21 * .bmfi.intBits / 8 + 1 To lngRowSize
k = k + 1
.bmbits(k) = 0
Next l
End If
Next j
.bmfh.lngSize = 14 + 40 + lngPixelArraySize
End With ' Defining bmpFile
strBMP = "C:\Desktop\Sample.BMP"
Open strBMP For Binary Access Write As 1 Len = 1
Put 1, 1, bmpFile.bmfh
Put 1, , bmpFile.bmfi
Put 1, , bmpFile.bmbits
Close
End Sub
解决方案
It's a row byte-alignment problem. Pad each row with one extra byte and your problem should vanish.
Posted so that you have an answer to check off. :)
Also, here is a good bmp tool. https://50ab6472f92ea10153000096.openlearningapps.net/run/view
