32ビットマップの作成 (ID:102800)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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

←解決時は質問者本人がここをチェックしてください。

戻る