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