VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[管理用]
| 投稿日 | ： 2004/08/27(Fri) 11:54 |
| 投稿者 | ： りっとっと |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re: 処理の早い色情報の獲得 |
前の状態の画像データを取得することについてですが、GetBitmapBits関数にPictureプロパティのハンドルを
設定しているのだと思われます。GetBitmapBits関数に設定するハンドルとして、Imageプロパティのハンドルを
設定して実行してみてください。また、Imageプロパティは、AutoRedorawプロパティがかかわってきますので
AutoRedrawプロパティをTrueにして、GetBitmapBits関数を実行する前にRefreshメソッドを実行してください。
こうしないと前回の状態が取得されてしまうようです。
と、GetBitmapBits関数の説明をしたのはいいのですが、
MSDNのヘルプにてGetBitmapBits関数は16ビット版のWindowsとの互換性のために残っている関数だそうで、
代わりにGetDIBits関数を使用してほしいとのことです。
(かといって、GetBitmapBits関数はビットマップハンドルだけでピクセルデータが取得できるという利点がありますけどね)
あと、先に回答したLESIAさんが紹介したGetPixel関数(API関数)ですが、Pointメソッドよりはるかに早いのですが、
画像全体を取得する場合はGetDIBits関数を使用したほうが、場合にもよりますが１０倍以上早いです。
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
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）