http://www.umekkii.jp/data/computer/file_format/bitmap.cgi
上記のサイトを参考に32ビットマップの作成を勉強していますがなかなかうまくいきません。
どこでつまづいているかご教示下さいませ。
Private Type tagBITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type tagBITMAPINFOHEADER
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
Const BI_RGB = 0&
'------------------------------------------------------------------------------
'API宣言
'------------------------------------------------------------------------------
Private Declare Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, _
ByVal Length As Long)
Sub 実験()
' 256x256 ピクセル
ReDim myData(0 To 255, 0 To 255) As Long
Dim X As Long, Y As Long
Dim BITMAPINFOHEADER As tagBITMAPINFOHEADER
Dim BITMAPFILEHEADER As tagBITMAPFILEHEADER
Dim c() As Byte
Dim lngHeadSize As Long
Dim lngBitsSize As Long
' グラデーションを作図
For Y = 0 To 255: For X = 0 To 255
myData(X, Y) = RGB(0, Y, X)
Next: Next
' BITMAPINFOHEADERのセット
If Not FillHeader(myData, BITMAPINFOHEADER) Then Exit Sub
With BITMAPINFOHEADER
lngHeadSize = .biSize
lngBitsSize = 4 * .biWidth * Abs(.biHeight)
End With
' BITMAPFILEHEADERのセット
With BITMAPFILEHEADER
.bfType = &H4D42
.bfOffBits = Len(BITMAPFILEHEADER) _
+ lngHeadSize
.bfSize = .bfOffBits + lngBitsSize
.bfReserved1 = 0
.bfReserved2 = 0
End With
ReDim c(0 To BITMAPFILEHEADER.bfSize - 1)
' データのコピー
MoveMemory c(0), BITMAPFILEHEADER, Len(BITMAPFILEHEADER)
MoveMemory c(Len(BITMAPFILEHEADER)), BITMAPINFOHEADER, lngHeadSize
MoveMemory c(BITMAPFILEHEADER.bfOffBits), _
myData(LBound(myData), LBound(myData, 2)), lngBitsSize
bmpFilename = "F:\sample\sample.bmp"
fn = FreeFile
Open bmpFilename For Binary As fn
Put fn, , c
Close fn
End Sub
'------------------------------------------------------------------------------
' BITMAPINFOHEADERの設定
'------------------------------------------------------------------------------
Private Function FillHeader(Data() As Long, _
BITMAPINFOHEADER As tagBITMAPINFOHEADER) As Boolean
Dim lngWidth As Long
Dim lngHeight As Long
' 配列の要素数(＝ビットマップの幅と高さ)を取得
On Error Resume Next
lngWidth = UBound(Data) - LBound(Data) + 1
lngHeight = UBound(Data, 2) - LBound(Data, 2) + 1
On Error GoTo 0
If lngWidth = 0 Or lngHeight = 0 Then
Exit Function
End If
With BITMAPINFOHEADER
.biSize = Len(BITMAPINFOHEADER)
.biWidth = lngWidth
.biHeight = -lngHeight ' トップダウン形式
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
FillHeader = True
End Function
Len(BITMAPINFOHEADER) と LenB(BITMAPINFOHEADER) は共に「40」ですが、
Len(BITMAPFILEHEADER) と LenB(BITMAPFILEHEADER) は「14」「16」という
異なる値を返すことに注意してください。
Len と LenB が異なる値を返すようなユーザー定義型を扱う場合、
RtlMoveMemory するには、その分のアライメントを考慮する必要があります。
で。今回の場合はそもそも RtlMoveMemory 関連がゴッソリ不要で、
Open bmpFilename For Binary As fn
Put fn, , BITMAPFILEHEADER
Put fn, , BITMAPINFOHEADER
Put fn, , myData
Close fn
だけで良いかと思います。
今回の 256x256 な 32bit カラーなファイルの場合、ファイルサイズを計算すると、
縦 256 × 横 256 × 4(ピクセルあたりのバイト数) で 262,144 バイト。
それに、BITMAPINFOHEADER の 40 バイトと、BITMAPFILEHEADER の 14 バイトで、
合計『262,198』バイトになるはずです。つまり完成後に
FileLen(bmpFilename)
を得た場合、262198 (=&H00040036) という値になるかと思います。
また、それと同じ情報が BITMAPFILEHEADER.bfSize にセットされますから、
作成されたファイルヘッダの先頭 6 バイトは、
42,4D … "BM"
36,00,04,00 … 262198
になるはずです。しかしプログラムはじめさんのコードでは、違う値になってしまうでしょう。
(出力されたファイルのバイナリを比較してみてください)
魔界の仮面弁士様ありがとうございます。
本当に勉強になりました。
＞Len と LenB が異なる値を返すようなユーザー定義型を扱う場合、
＞RtlMoveMemory するには、その分のアライメントを考慮する必要がありま＞す。
BITMAPFILEHEADERのbfTypeがinteger型なので2byte分パディングが入っているのですね。なるほど。
＞Open bmpFilename For Binary As fn
＞ Put fn, , BITMAPFILEHEADER
＞ Put fn, , BITMAPINFOHEADER
＞ Put fn, , myData
＞ Close fn
構造体や数値型配列を直接指定できるのはしりませんでした。
＞ 42,4D … "BM"
＞ 36,00,04,00 … 262198
たしかにおっしゃるとおりです。
とてもすっきりしました。ありがとうございました。
魔界の仮面弁士様本当に為になりました。
解決です。