tagCANDY CGI VBレスキュー(花ちゃん) - 白黒ビットマップ形式でpictureを保存する(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
白黒ビットマップ形式でpictureを保存する(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

白黒ビットマップ形式でpictureを保存する(VB6.0) [No.46の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2007/07/16 13:57
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[描画・画像][アルゴリズム][]                                        *
* キーワード:グラフィック,画像の2値化,減色,,,                                   *
***********************************************************************************

元質問:白黒ビットマップ形式でpictureを保存する.. - のぶ 2003/02/07-07:26 No.2628

-----------------------------------------------------------------------------------
Re^4: 白黒ビットマップ形式でpictureを保.. - k.k 203/02/11-10:19 No.2690
-----------------------------------------------------------------------------------

とりあえずサンプルを書いてみました。
ピクチャーボックスとコマンドボタンをひとつずつおいて、ピクチャーボックスのAutoRedrawをTrueにScaleModeをピクセルにしてください。
GetDibits関数を使って白黒ビットマップを取得します。
つまり、BITMAPINFOHEADER構造体のbiBitcountメンバでビット数を1にし、BITMAPINFO構造体でbmiColorsメンバをbmiColors(1)(要素数が2つ)にすればモノクロビットマップを取得することができます。
GetDibits関数を使用すれば、256色ビットマップ、16ビットカラービットマップなどのビットマップにも変換することができます。

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  '白黒ビットマップとして取得するため配列を2つにする
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 'ここでビット数(色数)を設定する。白黒なのでここでは1を設定。
End With

'まず、5番目の引数(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)
'再度改めて、5番目に確保したバッファを設定して、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

でも、この減色ほうほうだと、簡単なアルゴリズムを使用しているため、あまりきれいではありません。
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ