我正在研究VBA類來創建QR碼,並且我很難將QR數據位寫入實際BMP文件。爲了獲得BMP結構和代碼的懸掛,我可以使用下面的代碼嘗試製作全部爲白色的21 x 21像素位圖。這幾乎行得通,除了每行中最左邊的列是黃色而不是白色。關於可能發生什麼的任何想法?我猜測我的頭文件定義有問題,但我不確定。我離BMPs很遠。我的代碼是基於關閉什麼我發現這裏http://answers.microsoft.com/en-us/office/forum/office_2007-customize/how-can-i-create-a-bitmap-image-with-vba/4976480a-d20b-4b2a-8ecc-436428d9586bVBA手動創建BMP
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
您是否看到與24 x 24 bmp相同的效果?我懷疑每行字節對齊問題,並且24x24不應該受到它的影響。 – 2013-03-05 00:36:46
謝謝,我認爲這是問題所在。如果我在進入循環之前設置k = -1,則所有內容都正確排列。謝謝你的幫助。 – DasPete 2013-03-05 22:02:24