タイトル | : Re^7: GetDIbitsの使用方法について |
記事No | : 15874 |
投稿日 | : 2014/03/21(Fri) 18:48 |
投稿者 | : 還暦手習い |
魔界の仮面弁士様
随分時間がかかってしまいましたが、結果は得られました。 プログラムの記述は突っ込みどころ満載だとは思いますが期待通りの結果は 得られました。 手間隙のかかる、ど素人の初老に本当に親切に丁寧なご指導、心から感謝し ます。 ありがとうございました。
以下、私同様素人の方にも、何かのお役にたてば(お役に立たず誤った情報 となるやも?)と思い全文記載させていただきます。
ただ、記載中の★と★★の箇所が納得いかず、あつかましくも再々再度、質 問させていただきます。 よしくお願いいたします。
'========================================================================== 'PCの画面の指定した場所で指定した幅・高さの画像をフォームにコピーして 'その画像のピクセル単位の色情報を配列変数の形で取得する。
'◆Formモジュール ======================================================== ' Form と コマンドボタン1個
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, _ ByVal nXDest As Long, ByVal nYDest As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hDCSrc As Long, _ ByVal nXSrc As Long, ByVal nYSrc As Long, _ ByVal dwRop As Long) As Long 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 Type BITMAPINFO 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 Declare Function CreateCompatibleBitmap Lib "gdi32" _ (ByVal hdc As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _ ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _ (ByVal hdc As Long) As Long
Private pixel() As Long
'############################### Private Sub Command1_Click() '############################### Dim ScreenhDC As Long Dim bmpinfo As BITMAPINFO Dim hBmp As Long Dim hMemDC As Long Dim hOld As Long Dim B As Long Dim G As Long Dim R As Long Dim XX As Long Dim YY As Long
'スクリーン全体ののDCハンドル ScreenhDC = GetDC(0) '---------------------------------------------------------------- '処理の概要: ' 'デスクトップのX座標150 Y座標150のポイントから80×80(ピクセル)の '領域をFormにコピーX=150 Y=150 幅*高 80×80 は他の処理で '任意の指定できるものとします。 ' '実際には、X,Yはフォーム外のクリックを検知してその場所のデスク 'トップ上の座標を得ます。 'また幅*高さはフォーム上のテキストボックスから任意に指定してお 'くものとします。 '何れも処理は完成しておりますが、本件の件名とは無関係であります 'ので記載は省略させていただきます。 '---------------------------------------------------------------- BitBlt Me.hdc, 0, 0, 80, 80, ScreenhDC, 150, 150, SRCCOPY '---------------------------------------------------------------- '初期化 bmpinfo.biBitCount = 32 bmpinfo.biCompression = 0 bmpinfo.biHeight = 80 bmpinfo.biPlanes = 1 bmpinfo.biSize = 40 bmpinfo.biWidth = 80 'ビットマップ作成 hBmp = CreateCompatibleBitmap(Me.hdc, 80, 80) 'メモリデバイスコンテキストを作成 hMemDC = CreateCompatibleDC(Me.hdc) 'メモリデバイスコンテキストに適切なhBmpを選択し直す hOld = SelectObject(hMemDC, hBmp) 'hMemDCに描画処理を行う BitBlt hMemDC, 0, 0, 80, 80, Me.hdc, 0, 0, SRCCOPY '★bmpinfoが設定済みなので不要?コメント行にしても結果は同じでした。 GetDIBits hMemDC, hBmp, 0, bmpinfo.biHeight, ByVal 0&, bmpinfo, 0
'配列の宣言 ReDim pixel(80 - 1, 80 - 1) As Long '★★高さを−にするとビットマップが逆転する? bmpinfo.biHeight = -bmpinfo.biHeight '★★↑次STEPにAbsで絶対値を代入しているので不要のはずなのに 'この行が無い場合は結果が違う(無い場合、画像上下が逆) '色を取得,Pixel配列には画像の色が入る GetDIBits hMemDC, hBmp, 0, Abs(bmpinfo.biHeight), pixel(0, 0), bmpinfo, 0 'DCの解放 ReleaseDC 0, ScreenhDC SelectObject hMemDC, hOld DeleteObject hBmp DeleteObject hMemDC '***************** 結果検証のためファイルに保存 **************** 'かなりドロ臭い方法ですがあらためてファイルをExcelVBAで読んで 'セル(横幅0.5程度)に色づけして画像確認を行うためファイル保 '存します。取得したpixel(*,*)が正しいかを検証しました。 Open "C:\TEST.CSV" For Output As #1 For YY = 0 To 79 For XX = 0 To 79 B = CByte(pixel(XX, YY) And &HFF&) G = CByte((pixel(XX, YY) \ &H100&) And &HFF&) R = CByte((pixel(XX, YY) \ &H10000) And &HFF&) Print #1, Str(XX) & "," & Str(YY) & "," & _ Str(B) & "," & Str(G) & "," & Str(R) Next XX Next YY Close #1 End Sub '■■ここからはVBAで動作させて画像を検証するプログラム■■ 'Sub TEST() 'Dim FILE_DATA As String 'Dim PIX_DATA() As String '========================================= 'テスト環境はExcel2013(フルカラー)で実施 '========================================= 'セルの設定 'Rows(1).ColumnWidth = 0.5 'Columns(1).RowHeight = 5 'セルに描画 'Open "C:\TEST.CSV" For Input As #1 ' Do Until EOF(1) = True ' Line Input #1, FILE_DATA ' PIX_DATA = Split(FILE_DATA, ",") ' ' Cells(Val(PIX_DATA(1)) + 1, _ ' Val(PIX_DATA(0)) + 1).Interior.Color = _ ' RGB(Val(PIX_DATA(4)), Val(PIX_DATA(3)), Val(PIX_DATA(2))) ' Loop 'Close #1 'End Sub
|