投稿時間:2004/08/27(Fri) 11:54 投稿者名:りっとっと
Eメール:
URL :
タイトル:Re: 処理の早い色情報の獲得
前の状態の画像データを取得することについてですが、GetBitmapBits関数にPictureプロパティのハンドルを 設定しているのだと思われます。GetBitmapBits関数に設定するハンドルとして、Imageプロパティのハンドルを 設定して実行してみてください。また、Imageプロパティは、AutoRedorawプロパティがかかわってきますので AutoRedrawプロパティをTrueにして、GetBitmapBits関数を実行する前にRefreshメソッドを実行してください。 こうしないと前回の状態が取得されてしまうようです。
と、GetBitmapBits関数の説明をしたのはいいのですが、 MSDNのヘルプにてGetBitmapBits関数は16ビット版のWindowsとの互換性のために残っている関数だそうで、 代わりにGetDIBits関数を使用してほしいとのことです。 (かといって、GetBitmapBits関数はビットマップハンドルだけでピクセルデータが取得できるという利点がありますけどね) あと、先に回答したLESIAさんが紹介したGetPixel関数(API関数)ですが、Pointメソッドよりはるかに早いのですが、 画像全体を取得する場合はGetDIBits関数を使用したほうが、場合にもよりますが10倍以上早いです。 GetPixel関数は、座標を設定するためFor文でループするという形となり、このループ処理が処理時間を遅くする原因と なっています。
サンプル
Private Type BITMAPFILEHEADER bfType As String * 2 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 '本来はパレットデータとしてRGBQUAD型構造体配列のメンバがあるがフルカラーデータ 'を取得するためパレットはない End Type
Private Declare Function GetDIBits 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 Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Const DIB_RGB_COLORS = 0
Private Sub Command1_Click() Dim t1 As Long, t2 As Long t1 = timeGetTime For cnt2 = 0 To 100 DoEvents BlackCount 2 Next t2 = timeGetTime 'かかった時間を表示 Debug.Print t2 - t1
End Sub
'黒のピクセル数を数える '引数に0,1,2をセットすることにより取得方法を変える '0 = GetDIBits関数 '1 = GetDIBits関数、カウント方法をちょっと変更 '2 = GetPixel関数 Private Function BlackCount(md As Long) As Long Dim Bmi As BITMAPINFO Dim Bmpfh As BITMAPFILEHEADER Dim Pixels() As Byte Dim ret As Long Dim cnt As Long Dim cnt2 As Long Dim BlackCnt As Long Dim tmData As Long Dim wPos As Long Dim hPos As Long Select Case md Case 0 '前もって、BmiColors構造体配列を定義しておかなければならない。 With Bmi.bmiHeader .biSize = Len(Bmi.bmiHeader) .biWidth = Picture1.ScaleWidth .biHeight = Picture1.ScaleHeight .biBitCount = 32 .biPlanes = 1 End With 'lpBitsに0を渡して、BITMAPINFO構造体への情報だけを取得 ret = GetDIBits(Picture1.hdc, _ Picture1.Image, _ 0, _ Picture1.ScaleHeight, _ ByVal 0, _ Bmi, _ DIB_RGB_COLORS) 'lpBitsにセットするバイト配列を確保 ReDim Pixels(Bmi.bmiHeader.biSizeImage - 1) 'lpBitsにバイト配列をセットして改めて実行し、バイト配列にピクセルデータを取得 ret = GetDIBits256(Picture1.hdc, _ Picture1.Image, _ 0, _ Picture1.ScaleHeight, _ Pixels(0), _ Bmi, _ DIB_RGB_COLORS)
'黒をカウント For cnt = 0 To Bmi.bmiHeader.biSizeImage - 1 If Pixels(cnt) = 0 Then BlackCnt = BlackCnt + 1 End If Next Case 1 With Bmi.bmiHeader .biSize = Len(Bmi.bmiHeader) .biWidth = Picture1.ScaleWidth .biHeight = Picture1.ScaleHeight .biBitCount = 8 'ここで色数のビット数をセットする .biPlanes = 1 End With ret = GetDIBits256(Picture1.hdc, _ Picture1.Image, _ 0, _ Picture1.ScaleHeight, _ ByVal 0, _ Bmi, _ DIB_RGB_COLORS) ReDim Pixels(Bmi.bmiHeader.biSizeImage - 1) ret = GetDIBits256(Picture1.hdc, _ Picture1.Image, _ 0, _ Picture1.ScaleHeight, _ Pixels(0), _ Bmi, _ DIB_RGB_COLORS)
'黒をカウント For cnt = 0 To Bmi.bmiHeader.biSizeImage - 1 BlackCnt = BlackCnt - (Pixels(cnt) = 0) Next Case 2 For wPos = 0 To Picture1.ScaleWidth - 1 For hPos = 0 To Picture1.ScaleHeight - 1 If Not GetPixel(Picture1.hdc, wPos, hPos) Then BlackCnt = BlackCnt + 1 '黒をカウント End If Next Next End Select BlackCount = BlackCnt End Function
|