投稿時間：2003/02/11(Tue) 10:19
投稿者名：k.k
Ｅメール：
ＵＲＬ ：
タイトル：Re^4: 白黒ビットマップ形式でpictureを保存する方法
> カラービットマップの構造体は結構あるんですが、
> モノクロとなると見つかりません．．．（スイマセン私の探し方が悪いのかも知れません。）
カラーもモノクロも一緒ですよ。
パレットの数が違うだけ（ビット数もだけど）
> 1000
> 0001
> 0001
> 0001
> という4ラインのデータなら
> 0001
> 0001
> 0001
> 1000
> に直すと言うことでしょうか？
うん、こういうこと
> > つまり4*8=16ピクセルの倍数でないといけないので、足らないところは０で埋めなければなりません。
> > この処理部部分が結構大変です。
> なんとなく、これはラインごとに０で埋めるのでしょうか？
> ちょと、頑張って探してみます。
ＡＰＩではこの辺の計算などはやってくれるので、こんな難しいことを考えずにすみます。
で、とりあえずサンプルを書いてみました。
ピクチャーボックスとコマンドボタンをひとつずつおいて、
ピクチャーボックスのAutoRedrawをTrueにScaleModeをピクセルにしてください。
GetDibits関数を使って白黒ビットマップを取得します。
つまり、BITMAPINFOHEADER構造体のbiBitcountメンバでビット数を1にし、
BITMAPINFO構造体でbmiColorsメンバをbmiColors(1)（要素数が２つ）
にすればモノクロビットマップを取得することができます。
GetDibits関数を使用すれば、２５６色ビットマップ、１６ビットカラービットマップ
などのビットマップにも変換することができます。
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER
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
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(1) As RGBQUAD '白黒ビットマップとして取得するため配列を２つにする
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
Private Sub Command1_Click()
Dim rc As Long
Dim BmpInfo As BITMAPINFO
Dim PicData() As Byte
Dim BmpFileHeader As BITMAPFILEHEADER
With BmpInfo.bmiHeader
.biSize = 40
.biWidth = Picture1.ScaleWidth
.biHeight = Picture1.ScaleHeight
.biPlanes = 1
.biBitCount = 1 'ここでビット数（色数）を設定する。白黒なのでここでは１を設定。
End With
'まず、５番目の引数(lpBits)に0を設定して、GetDiBitsを実行するとバッファに必要なバイト数が戻ってくる
rc = GetDIBits(Picture1.hdc, Picture1.Picture, 0, Picture1.ScaleHeight - 1, ByVal 0&, BmpInfo, DIB_RGB_COLORS)
'バッファを確保する
ReDim PicData(BmpInfo.bmiHeader.biSizeImage - 1)
'再度改めて、５番目に確保したバッファを設定して、GetDibitsを実行して白黒ビットマップのデータを取得
rc = GetDIBits(Picture1.hdc, Picture1.Picture, 0, Picture1.ScaleHeight, PicData(0), BmpInfo, DIB_RGB_COLORS)
'パレットを設定
'黒 (すべて0なので省略してもかまわない)
With BmpInfo.bmiColors(0)
.rgbBlue = 0
.rgbGreen = 0
.rgbRed = 0
.rgbReserved = 0
End With
'白
With BmpInfo.bmiColors(1)
.rgbBlue = &HFF
.rgbGreen = &HFF
.rgbRed = &HFF
.rgbReserved = 0
End With
'確認のため描画する
rc = SetDIBits(Picture1.hdc, Picture1.Picture, 0, Picture1.ScaleHeight, PicData(0), BmpInfo, DIB_RGB_COLORS)
'リフレッシュして表示する
Picture1.Refresh
'ファイルヘッダーを設定
With BmpFileHeader
.bfType = &H4D42 '"BM"
.bfSize = Len(BmpFileHeader) + Len(BmpInfo) + BmpInfo.bmiHeader.biSizeImage
.bfOffBits = Len(BmpFileHeader) + Len(BmpInfo)
End With
'ファイルを開く（新規作成）
Open "c:\mono.bmp" For Binary As #1
'ファイルヘッダーを書き込む
Put #1, , BmpFileHeader
'ヘッダーを書き込み
Put #1, , BmpInfo
'画像データを書き込む
Put #1, , PicData
Close #1
End Sub
でも、この減色ほうほうだと、簡単なアルゴリズムを使用しているため、あまりきれいではありません。
|