CreateBitmap関数

Function CreateBMP _
( _
ByRef ImageData() As RGB, _
ByVal BMPFileName As String _
) As Long

'## BMPファイル番号
Dim FileNumber As Long

'## BMPファイルに書き込む画像データ
Dim ImageBinaryData(10000000) As Byte

'## BMPファイルヘッダデータ
Dim FileType As Integer
Dim FileSize As Long
Dim ReservedA As Integer
Dim ReservedB As Integer
Dim ImageDataOffSet As Long
Dim HeaderSize As Long
Dim ImageWidth As Long
Dim ImageHeight As Long
Dim NumberOfPlanes As Integer
Dim RGBBit As Integer
Dim CompressionFormat As Long
Dim ImageDataSize As Long
Dim ResolutionW As Long
Dim ResolutionH As Long
Dim NumberOfPalets As Long
Dim PaletIndex As Long

'## 繰り返し用
Dim i As Long
Dim j As Long


'## 画像の幅,高さを画像データ配列から取得
ImageWidth = UBound(ImageData, 1) + 1
ImageHeight = UBound(ImageData, 2) + 1


'## ファイル先頭から画像データまでのオフセット
ImageDataOffSet = 54

'## ファイルサイズ = ヘッダ + 画像データ
FileSize = ImageDataOffSet + ImageWidth * ImageHeight * 3


'## 画像データを書き込み用データに変換(BMPデータは天地逆)
For i = ImageHeight - 1 To 0 Step -1

For j = 0 To ImageWidth - 1

'## BMPフォーマットはB,G,Rの順に並ぶ
ImageBinaryData(((ImageHeight - i - 1) * ImageWidth + j) * 3) = ImageData(i, j).B
ImageBinaryData(((ImageHeight - i - 1) * ImageWidth + j) * 3 + 1) = ImageData(i, j).G
ImageBinaryData(((ImageHeight - i - 1) * ImageWidth + j) * 3 + 2) = ImageData(i, j).R

Next

Next


'## ヘッダデータ
FileType = &H4D42 '## "BM"ビットマップ(リトルエンディアン)
ReservedA = 0 '## 予約領域
ReservedB = 0 '## 予約領域
HeaderSize = 40 '## 情報ヘッダサイズ
NumberOfPlanes = 1 '## プレーン数
RGBBit = 24 '## RGB合計ビット数(8*3)
CompressionFormat = 0 '## 圧縮形式
ImageDataSize = 0 '## 画像データ部のサイズ(非圧縮の場合は0で可)
ResolutionW = 0 '## 横解像度(0で可)
ResolutionH = 0 '## 縦解像度(0で可)
NumberOfPalets = 0 '## 格納されているパレット数
PaletIndex = 0 '## 重要なパレットのインデックス


'## ファイル番号
FileNumber = FreeFile()

'## BMPファイル新規作成
Open BMPFileName For Binary As #FileNumber

'## BMPヘッダー書き込み
Put #FileNumber, , FileType
Put #FileNumber, , FileSize
Put #FileNumber, , ReservedA
Put #FileNumber, , ReservedB
Put #FileNumber, , ImageDataOffSet
Put #FileNumber, , HeaderSize
Put #FileNumber, , ImageWidth
Put #FileNumber, , ImageHeight
Put #FileNumber, , NumberOfPlanes
Put #FileNumber, , RGBBit
Put #FileNumber, , CompressionFormat
Put #FileNumber, , ImageDataSize
Put #FileNumber, , ResolutionW
Put #FileNumber, , ResolutionH
Put #FileNumber, , NumberOfPalets
Put #FileNumber, , PaletIndex

'## 画像データ書き込み
For i = 0 To ImageWidth * ImageHeight * 3 - 1
Put #FileNumber, , ImageBinaryData(i)
Next

'## BMPファイルクローズ
Close #FileNumber

End Function


この記事へのコメント

この記事へのトラックバック