4

我正在研究一个 VBA 类来创建 QR 码,但在将 QR 数据位写入实际 BMP 文件时,我感到很困惑。为了掌握 BMP 结构和代码,我一直在尝试使用下面的代码制作一个 21 x 21 像素的全白位图。这几乎可以工作,除了每行中最左边的列是黄色而不是白色。关于可能发生什么的任何想法?我猜我的标题定义有问题,但我不确定。我远不是 BMP 的专业人士。我的代码基于我在这里找到的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
4

4 回答 4

3

这是一个行字节对齐问题。用一个额外的字节填充每一行,您的问题应该会消失。

发布,以便您有一个要检查的答案。:)

另外,这里有一个很好的 bmp 工具。 https://50ab6472f92ea10153000096.openlearningapps.net/run/view

于 2013-03-05T22:31:16.707 回答
2

此 BMP 导出代码中有一个小错误。
说的那一行

lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4

实际上应该说

'old line:    lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4
 lngRowSize = WorksheetFunction.Ceiling_Precise(.bmfi.intBits * .bmfi.lngWidth / 32) * 4

之前,round 函数会阻止某些图像宽度正确导出,并且代码会引发错误。以前拒绝的宽度:(3,6,7,11,14,15,19,22,23,27,30,...)

我假设您不再需要此代码,但我从这里复制了它,我认为其他人也会。

于 2013-11-11T04:51:38.157 回答
1

我运行了你的代码来验证黄线。仔细查看后,我相信可以通过设置 bmpfile.bmpbits 字节数组的边界来解决问题。当您定义数组时,您将下限留空,因此默认情况下数组将从 0 开始。如果您像这样重新调暗数组

    ReDim .bmbits(1 To lngPixelArraySize)

您将获得一个纯白色的 sample.bmp。我运行它来验证它对我有用。

祝你好运。我可以看到让 k 从 -1 开始是如何工作的。剩下的唯一问题是您的数组大小将多出一个字节。

于 2015-02-22T21:44:06.673 回答
0

要使“天花板”功能正确(VBA / excel 2007),不需要“精确”语句。
宏在以下情况下正常工作:

lngRowSize = WorksheetFunction.Ceiling(.bmfi.intBits * .bmfi.lngWidth / 32, 0.5) * 4       
于 2015-02-11T16:49:38.623 回答