tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトルGetDIbitsの使用方法について
記事No15851
投稿日: 2014/03/09(Sun) 19:51
投稿者還暦手習い
ディスクトップの特定エリアのピクセル単位の色情報を取得したいと
思っています。最終的にはVBAでの利用を意識していますので、VBAで
は利用できないPictuteBoxは避けて、Frameを介した方法で挑戦して
います。
@ディスクトップの任意のエリアをFrame1にBitBltで表示する。
AFrame1に表示された画像をGetpixelでピクセル単位の情報を配列変
 数に代入する。

@Aは完成したのですが任意の範囲の大きさによってはBitBltはかな
り遅く実用的ではありませんでした。

そこで見つけたのがGetDIbitsですが、PictuteBoxでは問題なく動作し
ますがFrame1では配列変数に代入できません。

具体的には
'ビットマップ作成
    hbm = CreateCompatibleBitmap(Frame1DC, 200, 200)
    Debug.Print hbm   '←数値がPrintされる OK?

'空のビットマップをセット
    ohbm = SelectObject(Frame1DC, hbm)
    Debug.Print ohbm  '← 0 がPrintされる = Error?

'配列の再宣言
    ReDim pixel(200, 200) As Long

'色を取得,Pixel配列には画像の色情報を代入
    GetDIBits Frame1DC, ohbm, 0, 200, pixel(0, 0), bmpinfo, 0

Frameの代わりにPictureBoxを使用するとうまくいきますが
VBAでの使用ができません。
SelectObjectを理解せず見よう見まねで利用させてもらって
るのが、なぜ?がわからない原因だとは思いますが、よろし
くご指導お願いいたします。

環境:WndowsXP SP3 VB6

[ツリー表示へ]
タイトルRe: GetDIbitsの使用方法について
記事No15852
投稿日: 2014/03/11(Tue) 10:45
投稿者VBレスキュー(花ちゃん)
> 'ビットマップ作成
>     hbm = CreateCompatibleBitmap(Frame1DC, 200, 200)
>     Debug.Print hbm   '←数値がPrintされる OK?

どなたからもレスがないようなので、少しだけ。(パソコンの引っ越しで忙しいので)

Frame1DC は何の変数をあてているのでしょうか?
Win 32 API 関数を使用するなら引数の意味を理解して割り当てないと当然の事ながら動作しません。
又、戻り値が期待しているものが返ってきているかを必ず調べるようにしないとエラー等も
調べる事もできないかと思いますよ。

Frame1DC がどのようなものかを理解すれば原因が解りますよ。

[ツリー表示へ]
タイトルRe^2: GetDIbitsの使用方法について
記事No15853
投稿日: 2014/03/11(Tue) 19:40
投稿者還暦手習い
お忙しいところご指導いただきありがとうございます。
ご指摘のFrame1DCについては、Frame1のデバイスコンテキストの認識でおります。
ソースコードを長々と書くと見づらくなると思い省略しておりました。

申し訳ありません。

先ほどの投稿内容の前段として次のように記載しております。
Frame1にディスクトップの一部画像が表示されるところまでは成功しております
のでBitBltで使用する引数は、正しく取得できていたと解釈しておりました。


Dim F_Hnd     as Long
Dim Frame1DC  as Long
Dim D_Hnd     as long
Dim D_hDC     as long

'Frame1のウインドハンドルを取得
    F_Hnd = Me.Frame1.hWnd
'Frame1のDCを取得
    Frame1DC = GetDC(F_Hnd)
    
'ディスクトップのウィンドハンドルを取得
    D_Hnd = GetDesktopWindow

'ディスクトップのDCを取得
    D_hDC = GetDC(D_Hnd)
    
'Frame1にディスクトップの一部の画像を表示
    BitBlt Frame1DC, 0, 0, 200, 200, D_hDC, 400, 400, SRCCOPY

Frame1DCの取得方法に問題があるのでしょうか。
よろしくご指導お願いいたします。

[ツリー表示へ]
タイトルRe^3: GetDIbitsの使用方法について
記事No15854
投稿日: 2014/03/11(Tue) 20:43
投稿者VBレスキュー(花ちゃん)
>ご指摘のFrame1DCについては、Frame1のデバイスコンテキストの認識でおります。

ところが
> 'Frame1のウインドハンドルを取得
>     F_Hnd = Me.Frame1.hWnd

Frame1のウインドハンドルを取得しておられますよね


> 'Frame1のDCを取得
>     Frame1DC = GetDC(F_Hnd)
ここでは、デバイスコンテキストのハンドルに変わっている。

ウィンドウ(hWnd)のハンドルとデバイスコンテキスト(hDC)は別物ですよ。

Form や PictuteBox には、hWnd プロパティと hDC プロパティの両方がありますが、
Frame に hDC プロパティがありましたか? と言ったつもりでしたが。

解らないプロパティやメソッド等は、MSDN で調べるようにして下さい。



[ツリー表示へ]
タイトルRe^4: GetDIbitsの使用方法について
記事No15855
投稿日: 2014/03/11(Tue) 22:21
投稿者還暦手習い
さっそくのご指導ありがとうございます。

>Form や PictuteBox には、hWnd プロパティと hDC プロパティの両方がありますが、
>Frame に hDC プロパティがありましたか?

確かにme.Frme1. ここまで打って次に続く候補にhdcが現れないのにme.では次に続く
候補にhdcが現れました。
これは即ちFrame1にはhdcはなく、Form1にはhdcがあるって事ですよね。

Frame1のありもしないDCをGetDCで無理やり取得できたと勘違いしてたことがわかり
ました。

なぜ間違った方法でFrame1に画像がBitBltできたのか不思議ですが、この際忘れて先
に進むことにしました。

Form1のデバイスコンテキストはme.hdcという解釈でいいのでしょうか?

Frame1を削除してForm1に直接BitBltで画像を表示できました。
BitBlt Me.hdc, 0, 0, 200, 200, D_hDC, 400, 400, SRCCOPY

さらに先に進むとして

hbm = CreateCompatibleBitmap(Me.hdc, 200, 200)
    Debug.Print hbm    ←数値が表示される OK?

ohbm = SelectObject(Me.hdc, hbm)
    Debug.Print ohbm    ←0が表示される  ERROR?

結局最初に戻ってしましました。

出来の悪い生徒ですが、懲りずにご指導お願いいたします。

[ツリー表示へ]
タイトルRe^5: GetDIbitsの使用方法について
記事No15856
投稿日: 2014/03/11(Tue) 22:54
投稿者VBレスキュー(花ちゃん)
hDC の根本的な使い方が間違っています。
MSDN で調べてある程度理解できなければこの辺の関数は扱いが難しいですよ。
1行書く毎に聞くことになり...。

[ツリー表示へ]
タイトルRe^6: GetDIbitsの使用方法について
記事No15857
投稿日: 2014/03/13(Thu) 20:10
投稿者還暦手習い
お世話になります。

> hDC の根本的な使い方が間違っています。
> MSDN で調べてある程度理解できなければこの辺の関数は扱いが難しいですよ。
> 1行書く毎に聞くことになり...。

MSDNで調べました。結果はチンプンカンプンでした。やっぱ還暦過ぎには無理が
あるようです。

>1行書く毎に聞くことになる

どころか、何行も後戻りする必要がありそうです。
本題のGetDIBits以前にBitBltでのhDCの使い方さえ疑問が出てきました。

>Frame に hDC プロパティがありましたか

とういことですが

  F_Hnd = Me.Frame1.hWnd
    F_hDC = GetDC(F_Hnd)   ←Frame1のhDCを取得しようとしている 誤り?
    D_Hnd = GetDesktopWindow
    D_hDC = GetDC(D_Hnd)
    BitBlt F_hDC, 0, 0, 200, 200, D_hDC, 400, 400, SRCCOPY
     ~~~↑~~
            Frame1のhDC(Frame に hDC プロパティがありましたか)を使ってる?

これでなぜディスクトップの画面がFrame1に狙い通り表示されるのか?
ここまで戻ってしまいました。
GetDIBits以前に、ここのところのご指導をいただけたら、糸口になるやもわかりま
せんので、何卒よろしくお願いいたします。

[ツリー表示へ]
タイトルRe^7: GetDIbitsの使用方法について
記事No15859
投稿日: 2014/03/15(Sat) 14:25
投稿者魔界の仮面弁士
> ディスクトップ
ディスクトップ(disctop:盤上)ではなく
デスクトップ(desktop:卓上)です。

> ウインドハンドル
ウィンドハンドル(wind-handle:風のハンドル)ではなく、
ウィンドウハンドル(window-handle:窓のハンドル)です。


> > > > ウィンドウ(hWnd)のハンドルとデバイスコンテキスト(hDC)は別物ですよ。
その説明も微妙に違っていそう。

ウィンドウのハンドルが hWnd、
デバイスコンテキスト(DC)のハンドルが hDC なので。


> MSDNで調べました。
ところで、取得したリソースは使用後に解放していますよね?


> 結果はチンプンカンプンでした。
どこまで分かっていて、どこからチンプンカンプンなのか分からないので、ざっくり書くと:


デバイスコンテキストというのは、いわば描画ツールの総称です。
フォント、ペン、色、ブラシ、リージョンなど。

その描画ツールセット一式ごとに与えられた識別番号が、hDC と呼ばれるハンドルです。


DC での描画先となる「キャンバス」としては、ウィンドウのほか、プリンター出力にも使われます。
オンメモリでビットマップを生成する際にも使われますね。いわゆるメモリ DC というヤツです。


DC の取得方法/生成方法はいろいろとあります。

通常の描画処理(WM_PAINT)で使われるのは、BeginPaint/EndPaint による DC。
(WM_PAINT メッセージというのは、VB でいうとことの Paint イベントのことです)

GetDC/ReleseDC  は、WM_PAINT 以外によるウィンドウ描画に用いられるもの。
(今回利用しようとしているのはこれですね)

このほか、CreateDC/DeleteDC とか CreateCompatibleDC/DeleteDC などもあります。


注意する必要があるのは、PictureBox や Form の AutoRedraw プロパティですね。
これについては、下記で説明されています。(今回は VBA なので関係無いですが)
http://www016.upp.so-net.ne.jp/garger-studio/gameprog/vb0152.html



> ohbm = SelectObject(Frame1DC, hbm)
> Debug.Print ohbm  '← 0 がPrintされる = Error?
SelectObjct は、直前に設定されていたオブジェクトを返します。
非互換のオブジェクトを渡した場合は、失敗を表すゼロが返されます。

なお、新しいオブジェクトでの描画処理が終わったら、その戻り値を渡して
元のオブジェクトをSelectObjectしなおしておく必要があります。

[ツリー表示へ]
タイトルRe^8: GetDIbitsの使用方法について
記事No15861
投稿日: 2014/03/16(Sun) 08:59
投稿者還暦手習い
魔界の仮面弁士様、ご指導ありがとうございます。

>> ディスクトップ
>ディスクトップ(disctop:盤上)ではなく
>デスクトップ(desktop:卓上)です。
>> ウインドハンドル
>ウィンドハンドル(wind-handle:風のハンドル)ではなく、
>ウィンドウハンドル(window-handle:窓のハンドル)です。

・申し訳ありませんでした。記載ミスです。理解できております。

>ところで、取得したリソースは使用後に解放していますよね?

・記載は省略しておりましたが、DeleteDCやReleaseDCはそれなりに理解して使用
 しております。


>> MSDNで調べました。
>> 結果はチンプンカンプンでした。
>どこまで分かっていて、どこからチンプンカンプンなのか分からないので、ざっ
くり書くと:

・hdc
 デバイスコンテキストのハンドルを指定します。
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          ↑Frame1のデバイスコンテキストのハンドルではないのですよね。
      なにのデバイスコンテキストのハンドルかがわかりません。

 hgdiobj
 選択対象のオブジェクトのハンドルを指定します。選択対象のオブジェクトは、
 次の関数のいずれかを 使って作成しておかなければなりません。

 ビットマップ CreateBitmap、CreateBitmapIndirect、CreateCompatibleBitmap、
 CreateDIBitmap、CreateDIBSection (メモリデバイスコンテキストでのみビット
                  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
                   ↑意味がわかりません。調べる必要有り!

 マップを選択できます。また、一度に1つのデバイスコンテキストでのみ選択でき
 ます。)

 ・・ひとつ調べるとまた意味不明の語句あり、自分にとってはまるで「無間地獄」
   の状態になっています。

・魔界の仮面弁士や花ちゃんのようにすべてを理解した上で、使用できれはいいので
 しょうが、今の自分にとっては、「良くわからないけど、やってみたら狙い通りに
 できた=うれしい!」ってのがさらに次ステップへ進めるモチベーションになるの
 です。理解より達成感が、次の階段を踏み出す大きな動機付けなのです。

>>SelectObjct は、直前に設定されていたオブジェクトを返します。
  非互換のオブジェクトを渡した場合は、失敗を表すゼロが返されます。

>>>> ohbm = SelectObject(Frame1DC, hbm)
>>>> Debug.Print ohbm  '← 0 がPrintされる = Error?

・つまりFrame1DCは「非互換のオブジェクト」ということなんでしょうか。
  ここで指定するデバイスコンテキストのハンドルは、何を使用したらいいのでしょ
  うか?

●それとも、そもそもFrame1に表示された画像のピクセル単位の色情報をGetDIBitsを
 使って取得することは不可能なのでしょうか。
 時間のかかるGetpixelでしか対応できないのでしょうか?

[ツリー表示へ]
タイトルRe^9: GetDIbitsの使用方法について
記事No15865
投稿日: 2014/03/16(Sun) 22:59
投稿者魔界の仮面弁士
> ・申し訳ありませんでした。記載ミスです。理解できております。
一回や二回の間違いではなく、すべての箇所で記載ミスしているので、
typo(書き損じ)ではなく、間違えて記憶されているのかと思っていました。



>  CreateDIBitmap、CreateDIBSection (メモリデバイスコンテキストでのみビット
>                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~
>                    ↑意味がわかりません。調べる必要有り!

これについては、No15863 、No15864 を参照してください。


> ・魔界の仮面弁士や花ちゃんのようにすべてを理解した上で、使用できれはいいので
すべて理解はしていません。調べながら回答しているぐらいですし。
どちらかといえば、描画系は苦手な分野です。通信系よりはマシですが。


>  今の自分にとっては、「良くわからないけど、やってみたら狙い通りに
>  できた=うれしい!」ってのがさらに次ステップへ進めるモチベーションになるの
>  です。理解より達成感が、次の階段を踏み出す大きな動機付けなのです。
VB の標準命令だけでやりくりする分には、それでも良いかもしれません。
ただ、API に手を出そうとするのであれば、その背景となる理論は知っておいた方が良いでしょう。
既存のサンプルを使いまわすだけであれば、そうした知識なしでも使えるとは思いますが、
それを使いこなすには、最低限の知識が必要ということです。


>  ・つまりFrame1DCは「非互換のオブジェクト」ということなんでしょうか。
>   ここで指定するデバイスコンテキストのハンドルは、何を使用したらいいのでしょ
>   うか?

こんな感じで如何でしょうか。API 宣言は既出なので省略。


'描画の元となるDC
hFrameDC = GetDC(Frame1.hWnd)

'描画結果の色数・サイズを決めるためのメモリビットマップ
hBmp = CreateCompatibleBitmap(hFrameDC, Frame1.Width, Frame1.Height)  'ScaleMode = ピクセル

'実際の描画処理は、メモリデバイスコンテキストに対して行う
hMemDC = CreateCompatibleDC(hFrameDC)

'メモリデバイスコンテキストのサーファイスは、作成直後は
'1x1サイズのモノクロ画像が選択されているので、適切な hBmp を選択しなおす
hOld = SelectObject(hMemDC, hBmp)

'★★★★★
'★ここに、hMemDC への描画処理を記述する
'★(DrawIcon とか BitBlt とか)
'★★★★★

'ビットマップ情報の取得
Dim bmpinfo As BITMAPINFO
bmpinfo.bmiHeader.biSize = Len(bmpinfo.bmiHeader)   '40

'lpvBits に ヌルポインタ を渡して、BITMAPINFO からデータサイズを調べる
GetDIBits hMemDC, hBmp, 0, bmpinfo.bmiHeader.biHeight, ByVal 0&, bmpinfo, DIB.RGB_COLORS

'上記は、モニタ設定の画像情報をそのまま取得する場合の処理手順です。
'(biBitCount = 0 にしておくと、現在のビットマップ属性が取得されます)
'
'ビットマップのサイズ、色数などが事前に分かっている場合や、
'他の形式(モニタの色数と異なる画像にしたい場合など)を
'得たい場合などは、BITMAPINFOHEADER の先頭 6 項目を自前で組み立てください。

'あらためて、ビットマップ情報を取得しなおす
ReDim pixel(bmpinfo.bmiHeader.biSizeImage - 1) As Byte
GetDIBits hMemDC, hBmp, 0, Abs(bmpinfo.bmiHeader.biHeight), pixel(0), bmpinfo, DIB.RGB_COLORS

'ビットマップの走査方向(トップダウン/ボトムアップ)を変更したい場合は、
'biHeightの符号を逆転させてください。
'また、pixel() のデータの並びは、ビットマップの色数・幅によって異なります。

'後始末
SelectObject hMemDC, hOld   '既存のオブジェクトを選択しなおす
DeleteObject hBmp           'サイズ指定に使っていたビットマップ
DeleteObject hMemDC         '描画に用いたメモリデバイスコンテキスト
ReleaseDC Frame1.hWnd, hFrameDC    '元となったデバイスコンテキスト



上記では Frame1 を GetDC してデバイスコンテキストを得ていますが、
「GetDIBits を使うこと」だけが目的なのであれば、デバイスコンテキストの取得は
CreateDC("DISPLAY", ByVal vbNullString, ByVal vbNullString, ByVal 0&)
でも良いかも知れません(CreateDC の結果は未検証)。

[ツリー表示へ]
タイトルRe: GetDIbitsの使用方法について
記事No15860
投稿日: 2014/03/15(Sat) 18:23
投稿者魔界の仮面弁士
スレッドが深くなってきたので、仕切りなおして:

> 環境:WndowsXP SP3 VB6
> Frameの代わりにPictureBoxを使用するとうまくいきますが

上記について、現象を再現可能なコードを提示できますか?


WinXP 環境が無く、Win7 で検証したためなのかもしれませんが、
当方では相手が PictureBox であろうと Frame であろうと、
GetDC に対して SelectObject した場合にはゼロが返されました。


GetDC API で得た hDC を使うのではなく、PictureBox1.hDC に対して SelectObject するのなら、
(AutoRedraw = True なときのみ)非ゼロを返してきましたが…。



Option Explicit

Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long) As OLE_HANDLE

Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal hObject As OLE_HANDLE) As OLE_HANDLE

Private Enum DIB
    RGB_COLORS = 0
    PAL_COLORS = 1
    PAL_INDICES = 2
End Enum

Private Declare Function GetDIBits Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal hBmp As OLE_HANDLE, _
    ByVal uStartScan As Long, _
    ByVal cScanLines As Long, _
    ByRef lpvBits As Any, _
    ByRef lpbi As Any, _
    ByVal wUsage As DIB) As Long

Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As OLE_HANDLE) As Long

Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE) As OLE_HANDLE

Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE, _
    ByVal hDC As OLE_HANDLE) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As OLE_HANDLE

Private Declare Function BitBlt Lib "gdi32" _
    (ByVal hdcDest As OLE_HANDLE, _
    ByVal nXDest As Long, _
    ByVal nYDest As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hdcSrc As OLE_HANDLE, _
    ByVal nXSrc As Long, _
    ByVal nYSrc As Long, _
    ByVal dwRop As RasterOpConstants) As Long


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(255) As RGBQUAD
End Type

Private Sub Command1_Click()
    Dim F_Hnd     As OLE_HANDLE
    Dim Frame1DC  As OLE_HANDLE
    Dim D_Hnd     As OLE_HANDLE
    Dim D_hDC     As OLE_HANDLE

    F_Hnd = Me.Frame1.hWnd
    Frame1DC = GetDC(F_Hnd)

    D_Hnd = GetDesktopWindow()
    D_hDC = GetDC(D_Hnd)

    BitBlt Frame1DC, 0, 0, Me.Frame1.Width, Me.Frame1.Height, D_hDC, 400, 400, vbSrcCopy

    ReleaseDC D_Hnd, D_hDC
    ReleaseDC F_Hnd, Frame1DC
End Sub

Private Sub Command2_Click()
    Me.ScaleMode = vbPixels

    '32ビットカラーの場合
    Dim bmpinfo As BITMAPINFO
    With bmpinfo.bmiHeader
        .biSize = Len(bmpinfo.bmiHeader)
        .biWidth = Me.Frame1.Width
        .biHeight = Me.Frame1.Height
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = 0
        .biSizeImage = .biWidth * .biHeight * 4
        .biClrUsed = 0
    End With

    Dim pixel() As RGBQUAD

    Dim F_Hnd As OLE_HANDLE
    F_Hnd = Me.Frame1.hWnd

    Dim Frame1DC As OLE_HANDLE
    Frame1DC = GetDC(F_Hnd)

    Dim hbm As OLE_HANDLE
    hbm = CreateCompatibleBitmap(Frame1DC, bmpinfo.bmiHeader.biWidth, bmpinfo.bmiHeader.biHeight)
    Debug.Print hbm

    Dim ohbm As OLE_HANDLE
    ohbm = SelectObject(Frame1DC, hbm)
    Debug.Print ohbm

    ReDim pixel(Me.Frame1.Width * Me.Frame1.Height)
    GetDIBits Frame1DC, ohbm, 0, bmpinfo.bmiHeader.biHeight, pixel(0), bmpinfo, DIB.RGB_COLORS

    SelectObject Frame1DC, ohbm

    DeleteObject hbm
    ReleaseDC F_Hnd, Frame1DC
End Sub

[ツリー表示へ]
タイトルRe^2: GetDIbitsの使用方法について
記事No15862
投稿日: 2014/03/16(Sun) 14:18
投稿者還暦手習い
魔界の仮面弁士様 ご指導ありがとうございます。

この掲示板は時系列的に表示順がおかしくなっていますね。
昨日いただいたNo.15860が今日私が送信したNo.15861より後に表示されています。
私が送信する際、魔界の仮面弁士様のNo.15860がなかったため、ちぐはぐな投稿
になったことをお詫びします。

Picture1でGetDIBitsが成功できている?こちらでのSAMPLEを記載させていただ
ます。

Sub DETECT_PIC(PIC As String)

'※「PIC」は"Picture1"や"Picture2"を都度送っています。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim bmpinfo As BITMAPINFO
Dim hbm     As Long, ohbm As Long
                            
With Me
'初期化
    bmpinfo.biBitCount = 32
    bmpinfo.biHeight = .Controls(PIC).ScaleHeight
    bmpinfo.biPlanes = 1
    bmpinfo.biSize = 40
    bmpinfo.biWidth = .Controls(PIC).ScaleWidth

'ビットマップ作成
hbm = CreateCompatibleBitmap(.Controls(PIC).hdc, .Controls(PIC).ScaleWidth, _
      .Controls(PIC).ScaleHeight)
        
'選択中のビットマップにはGetDIBitsが使えない
'ので空のビットマップをセット
ohbm = SelectObject(.Controls(PIC).hdc, hbm)

Debug.Print ohbm  ←※ゼロ以外の数値が表示されます
         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

'配列の宣言
ReDim pixel(.Controls(PIC).ScaleWidth - 1, .Controls(PIC).ScaleHeight - 1) As Long

'高さを−にするとビットマップが逆転する
bmpinfo.biHeight = -bmpinfo.biHeight

'色を取得,Pixel配列には画像の色が入る
GetDIBits .Controls(PIC).hdc, ohbm, 0, .Controls(PIC).ScaleHeight, _
            pixel(0, 0), bmpinfo, 0    '※その他の処理でpixel()が利用できています。
                                           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[ツリー表示へ]
タイトルRe^3: GetDIbitsの使用方法について
記事No15863
投稿日: 2014/03/16(Sun) 18:22
投稿者魔界の仮面弁士
こういう場合は、API 宣言も含めて記述するようにしていただけるとありがたいです。

その方が、API 宣言そのものに問題があったときにも指摘できますし(今回は大丈夫だと思いますが)、
何より今のままだと、回答者は自分で API 宣言を用意しないと実行できないことになってしまいます。
それでは、『現象を再現可能なコード』の提示にはなりませんので…。


> Dim bmpinfo As BITMAPINFO
>     bmpinfo.biBitCount = 32
>     bmpinfo.biHeight = .Controls(PIC).ScaleHeight
>     bmpinfo.biPlanes = 1
>     bmpinfo.biSize = 40
>     bmpinfo.biWidth = .Controls(PIC).ScaleWidth

このユーザー定義型は、正確には「BITMAPINFO 構造体」では無いですね。
内包する BITMAPINFOHEADER 構造体が展開して宣言されているので。



>> GetDC API で得た hDC を使うのではなく、PictureBox1.hDC に対して SelectObject するのなら、
>> (AutoRedraw = True なときのみ)非ゼロを返してきましたが…。
> hbm = CreateCompatibleBitmap(.Controls(PIC).hdc, .Controls(PIC).ScaleWidth, _
>       .Controls(PIC).ScaleHeight)

やはり、PictureBox の hDC プロパティを使っておられたのですね。
これでは、デバイスコンテキストの意味が変わってきますよ。
(ちなみに、AutoRedraw プロパティは何にセットされていますか?)


No15857 では、「GetDC」で得た DC に処理しようとしていたのに、
今回の No15862 では、「hDC プロパティ」で得た DC に対して
処理しようとしています。そもそもの描画対象が異なっているわけです。

GetDC 関数から得られる値が、何のデバイスコンテキストハンドルなのかを確認してみましょう。


ということで、Frame に対する描画の件の前に、まずはそのために重要となる
DC に関する認識について確認していきます。

まずは、PictureBox.hDC についてです。
AutoRedraw = True の場合は、メモリデバイスコンテキストのハンドルですし、
AutoRedraw = False の場合は、ディスプレイデバイスコンテキストのハンドルです。
この違いは認識されていますか?


AutoRedraw = False の場合は、WM_PAINT への応答として Paint イベントが発生します。
AutoRedraw = True の場合は、WM_PAINT への応答は自動的に行われるため、
Paint イベントは発生しません。

なので下記の場合、Picture2 のみに描画が行われます。

'=======================
' Sample 1:Paint イベントでの描画処理
'-----------------------
Option Explicit
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub
Private Sub Picture1_Paint()
    Picture1.PaintPicture Me.Icon, 0, 0
End Sub
Private Sub Picture2_Paint()
    Picture2.PaintPicture Me.Icon, 0, 0
End Sub
' Picture1: 再描画×
' Picture2: 再描画○
'-----------------------

ここまでは宜しいでしょうか。


このように、Paint イベントでの再描画の機会は与えられませんが、
いずれも「VB の標準命令」での描画はどちらも可能です。

たとえば下記のコードでは、両方の PictureBox に描画されます。

'=======================
' Sample 2:標準命令での描画処理
'-----------------------
Option Explicit
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    Picture1.PaintPicture Me.Icon, 0, 0
    Picture2.PaintPicture Me.Icon, 0, 0
End Sub
' Picture1: 描画○ 再描画○
' Picture2: 描画○ 再描画×
'-----------------------

ただし Picture2 は継続表示属性を持たないため、
フォームを最小化してから元に戻すなどした場合には
再描画の機会が無いために、描画結果が失われることになります。


さて、VB の標準命令(Line、PaintPicture、Print、Circle、PSet…)を
使うのではなく、API での描画になると、また動作が異なってきます。

それでは、hDC プロパティに対する描画をみてみましょう。

'=======================
' Sample 3:API による hDC プロパティへの描画処理
'-----------------------
Option Explicit
Private Declare Function DrawIcon Lib "user32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As OLE_HANDLE) As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    DrawIcon Picture1.hDC, 0, 0, Me.Icon.Handle
    DrawIcon Picture2.hDC, 0, 0, Me.Icon.Handle
End Sub
' Picture1: 描画× 再描画○
' Picture2: 描画○ 再描画×
'-----------------------

ボタンを押した直後は、Picture2 にしか描画されません。
しかし、再描画が発生したタイミングでは、
Picture1 の方は消えて、Picture2 の方のみ描画されます。
(PictureBox の Refresh メソッドを呼び出した場合や、
 PictureBox の Image プロパティにアクセスした場合も再描画されます)


これの動作の違いの理由は分かりますか?

Picture1 のほうは、メモリDC への描画です。
Picture2 のほうは、画面DC への描画です。

API で描画した場合、VBの標準命令を使った場合とは異なり
VB自身は、メモリDC への描画結果を画面に反映させねばならないことを
知りません。その結果、Picture1 への描画が遅れてしまいます。

Picture2 については、メモリDCに対してではなく、画面に直接
描画していますので、VB 側が認識しているかどうかに関係なく、
直ちに描画されます。しかし、AutoRedraw による自動再描画属性を
与えておらず、また、Paint イベントも未実装のため、再描画はなされません。



長くなりましたが、ここまでが前提知識。ここから本題です。

hDC プロパティではなく、GetDC API を使った場合はどうでしょうか?

'=======================
' Sample 4:GetDC で得たハンドルへの描画処理
'-----------------------
Option Explicit
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE) As OLE_HANDLE
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE, _
    ByVal hDC As OLE_HANDLE) As Long
Private Declare Function DrawIcon Lib "user32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As OLE_HANDLE) As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    Dim h1 As OLE_HANDLE, h2 As OLE_HANDLE
    h1 = GetDC(Picture1.hWnd)
    h2 = GetDC(Picture2.hWnd)

    DrawIcon h1, 0, 0, Me.Icon.Handle
    DrawIcon h2, 0, 0, Me.Icon.Handle

    ReleaseDC Picture1.hWnd, h1
    ReleaseDC Picture2.hWnd, h2
End Sub
' Picture1: 描画○ 再描画×
' Picture2: 描画○ 再描画×
'-----------------------

どちらも、Sample3 の Picture2 と同じ動きになりますよね?

GetDC が返すのは、画面に直結したキャンバスである、
「ディスプレイデバイスコンテキストのハンドル」だからです。
http://msdn.microsoft.com/ja-jp/library/cc428664.aspx

Picture1 が管理しているメモリデバイスコンテキストのハンドルに対しては
描画していませんので、再描画の機会は与えられません。


ここまでの段階で、認識にズレはありますか?

[ツリー表示へ]
タイトルRe^4: GetDIbitsの使用方法について
記事No15864
投稿日: 2014/03/16(Sun) 21:31
投稿者魔界の仮面弁士
> ここまでの段階で、認識にズレはありますか?
続き:


では、AutoRedraw を使わずにメモリデバイスコンテキストを
用意するにはどうすれば良いでしょうか。
それには CreateCompatibleDC 関数を使います。

CreateCompatibleDC を使うと、指定されたデバイスと互換性のある
メモリデバイスコンテキストを作成することができます。

'=======================
' Sample 5:CreateCompatibleDC の生成
'-----------------------
Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE) As OLE_HANDLE
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE) As OLE_HANDLE
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE, _
    ByVal hDC As OLE_HANDLE) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As OLE_HANDLE) As Long
Private Declare Function DrawIcon Lib "user32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As OLE_HANDLE) As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    Dim h1 As OLE_HANDLE, h2 As OLE_HANDLE
    h1 = GetDC(Picture1.hWnd)
    h2 = GetDC(Picture2.hWnd)

    Dim h3 As OLE_HANDLE, h4 As OLE_HANDLE
    h3 = CreateCompatibleDC(h1)
    h4 = CreateCompatibleDC(h2)

    DrawIcon h3, 0, 0, Me.Icon.Handle
    DrawIcon h4, 0, 0, Me.Icon.Handle

    DeleteObject h3
    DeleteObject h4

    ReleaseDC Picture1.hWnd, h1
    ReleaseDC Picture2.hWnd, h2
End Sub
' Picture1: 描画× 再描画×
' Picture2: 描画× 再描画×
'-----------------------

ちなみに、上記を実行しても何も表示されません。

なぜ表示されないのかを理解するには、
「AutoRedraw で管理されているメモリデバイスコンテキスト」

「CreateCompatibleDC で生成したメモリデバイスコンテキスト」
の違いを認識する必要があります。


まずひとつは、ここで生成したメモリデバイスコンテキストは、
画面描画とは無関係ということです。新たに生成したものだから当然ですね。


もうひとつは、作成されたばかりのメモリデバイスコンテキストは、
横×縦=1×1ドットの、モノクロ(1bit)ビットマップが『選択』された
状態であり、そのままでは使いものにならないということです。


このため、必要な幅、高さ、色の編成方法を指定してビットマップを作成し、
それを選択し直す必要があります。
その選択方法とは、既に御存知の SelectObjct API です。


問題となるのは、どうやってそのビットマップを用意するのか、という点ですが、
その方法の一つが、こちらも御存知の CreateCompatibleBitmap です。
これにより、PictureBox と互換性のあるビットマップを簡単に用意できます。

 メモリDC = CreateCompatibleDC(元のhDC)
 メモリBmp = CreateCompatibleBitmap(元のhDC, x, y)
 直前に選択されていたオブジェクト = SelectObject(メモリDC, メモリBmp)

上記 3 行目の SelectObject が、「元のhDC」に対してではなく、
「メモリDC」に対して行われていることに注意してください。



'=======================
' Sample 6:SelectObject での選択
'-----------------------
Option Explicit
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal hObject As OLE_HANDLE) As OLE_HANDLE
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
   (ByVal hDC As OLE_HANDLE, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long) As OLE_HANDLE
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE) As OLE_HANDLE
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE) As OLE_HANDLE
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE, _
    ByVal hDC As OLE_HANDLE) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As OLE_HANDLE) As Long
Private Declare Function DrawIcon Lib "user32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As OLE_HANDLE) As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    Dim h1 As OLE_HANDLE, h2 As OLE_HANDLE
    h1 = GetDC(Picture1.hWnd)
    h2 = GetDC(Picture2.hWnd)

    Dim h3 As OLE_HANDLE, h4 As OLE_HANDLE
    h3 = CreateCompatibleDC(h1)
    h4 = CreateCompatibleDC(h2)

    Dim hBmp1 As OLE_HANDLE, hBmp2 As OLE_HANDLE
    hBmp1 = CreateCompatibleBitmap(h3, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hBmp2 = CreateCompatibleBitmap(h4, Picture2.ScaleWidth, Picture2.ScaleHeight)

    Dim hObj1 As OLE_HANDLE, hObj2 As OLE_HANDLE
    hObj1 = SelectObject(h3, hBmp1)   'hObj1 は 非ゼロ となるべき
    hObj2 = SelectObject(h4, hBmp2)   'hObj1 は 非ゼロ となるべき

    DrawIcon h3, 0, 0, Me.Icon.Handle
    DrawIcon h4, 0, 0, Me.Icon.Handle

    Dim hObj3 As OLE_HANDLE, hObj4 As OLE_HANDLE
    hObj3 = SelectObject(h3, hObj1)   'hObj3 は hBmp1 と同じ値になるはず
    hObj4 = SelectObject(h4, hObj2)   'hObj4 は hBmp2 と同じ値になるはず

    DeleteObject hBmp1
    DeleteObject hBmp2

    DeleteObject h3
    DeleteObject h4

    ReleaseDC Picture1.hWnd, h1
    ReleaseDC Picture2.hWnd, h2
End Sub
' Picture1: 描画× 再描画×
' Picture2: 描画× 再描画×
'-----------------------

だんだん長くなってきて大変ですが、重要なのはこの点。
 hObj1 = SelectObject(h3, hBmp1)
 hObj2 = SelectObject(h4, hBmp2)

これをもし、
 hObj1 = SelectObject(h3, hBmp1)
 hObj2 = SelectObject(h4, hBmp1)
としてしまうと、hObj2 は 0 になります。
既に hBmp1 は h3 で使用中だからです。

また、上記を
 hObj1 = SelectObject(h1, hBmp1)
 hObj2 = SelectObject(h2, hBmp1)
とすることもできません。これだと、ともに 0 になってしまいます。


この違いが、
 ' No15862
 ohbm = SelectObject(.Controls("Picture1").hdc, hbm)
 Debug.Print ohbm  ←※ゼロ以外の数値が表示されます
の結果と、
 ' No15851
 ohbm = SelectObject(Frame1DC, hbm)
 Debug.Print ohbm  '← 0 がPrintされる = Error?
の結果に現れてきていますね。

[ツリー表示へ]
タイトルRe^5: GetDIbitsの使用方法について
記事No15870
投稿日: 2014/03/17(Mon) 21:26
投稿者還暦手習い
魔界の仮面弁士様

非常に詳しく、丁寧にご指導いただき大変ありがとうございます。
感謝。感謝です。
まだまだすべてを理解するにいたっておりませんが、週末からの3連休はしっかり勉強させていただ
きます。

取り急ぎお礼を申し上げたく、中途半端な内容ですが投稿させていただきました。
本当にありがとうございます。

-------------------------------------------------------------------------------------------
No.15865
本件をExcel2013のVBAで試しました。

>'あらためて、ビットマップ情報を取得しなおす
>ReDim pixel(bmpinfo.bmiHeader.biSizeImage - 1) As Byte
>GetDIBits hMemDC, hBmp, 0, Abs(bmpinfo.bmiHeader.biHeight), pixel(0), bmpinfo, DIB.RGB_COLORS

こちらではpixel()は2次元配列を使用したいので、またDIB.RGB_COLORSを改めて宣言していないので
GetDIBits hMemDC, hBmp, 0, Abs(bmpinfo.bmiHeader.biHeight), pixel(0, 0), bmpinfo, 0
としてやってみました。

>'ビットマップの走査方向(トップダウン/ボトムアップ)を変更したい場合は、
>'biHeightの符号を逆転させてください。

正しくGetDIBitsできたかを検証するため
  px = UBound(pixel, 1)
    py = UBound(pixel, 2)
  For i = 0 To px
        For j = 0 To py
            Sheets("WORK").Cells(j + 1, i + 1).Interior.Color = pixel(i, j)
        Next
    Next

結果は@上下逆になって表示される。
   A色がおかしい。(青系統と茶系統が逆に表示される)

   @は>biHeightの符号を逆転させてください。で解決するかと思い
    ReDim pixel(Me.Frame1.Width - 1, Me.Frame1.Height - 1) As Long
  
      '高さを−にするとビットマップが逆転する
      bmpinfo.biHeight = -bmpinfo.biHeight
      GetDIBits hMemDC, hBmp, 0, bmpinfo.biHeight, pixel(0, 0), bmpinfo, 0

    としてみましたが、今度はExcelのSheetsは真っ黒になってしまいました。

★もう少しじっくり取り組んでみます。それでもダメな場合はAPIの宣言やプログラムの詳細
まで含めて明示した投稿として質問させていただきます。
-----------------------------------------------------------------------------------
No.15863
>やはり、PictureBox の hDC プロパティを使っておられたのですね。
>これでは、デバイスコンテキストの意味が変わってきますよ。
>(ちなみに、AutoRedraw プロパティは何にセットされていますか?)

    AutoRedrawはFalseに設定しています。

>No15857 では、「GetDC」で得た DC に処理しようとしていたのに、
>今回の No15862 では、「hDC プロパティ」で得た DC に対して
>処理しようとしています。そもそもの描画対象が異なっているわけです

    VB6で過去作成した例を示させていただきましたが、今回はVBAを意識した
    ためhDCプロパティを使用せず、GetDCを意識して使用したつもりでしたが
    いつの間にか混同していたようです。

[ツリー表示へ]
タイトルRe^6: GetDIbitsの使用方法について
記事No15871
投稿日: 2014/03/17(Mon) 23:21
投稿者魔界の仮面弁士
> 週末からの3連休
存在自体、本気で忘れてました(汗


> こちらではpixel()は2次元配列を使用したいので、
取得したデータの内容を正しく確認するためにも、
検証段階では、Byte の一次元配列でも確認した方が良いですよ。


> またDIB.RGB_COLORSを改めて宣言していないので
> GetDIBits hMemDC, hBmp, 0, Abs(bmpinfo.bmiHeader.biHeight), pixel(0, 0), bmpinfo, 0
> としてやってみました。

・確保した pixel 配列のサイズが、biSizeImage と合致しているか確認しておいてください。
・pixel を As Long とする場合は、biBitCount が 32 であることを確認しておいてください。


このほか、圧縮形式 biCompression が 0 (無圧縮)であることも確認しておいてください。

 BI_RGB       (0) … 無圧縮。今回はこれを使う。
 BI_RLE8      (1) … 8 bit/pixel ランレングス圧縮。biBitCount=8
 BI_RLE4      (2) … 4 bit/pixel ランレングス圧縮。biBitCount=4
 BI_BITFIELDS (3) … 無圧縮。ビットフィールド。RGBQUAD に 青,緑,赤のカラーマスクが並ぶ。
 BI_JPEG      (4) … プリンタ用。画像ビットが JPEG であることを示す。
 BI_PNG       (5) … プリンタ用。画像ビットが PNG であることを示す。


> 上下逆になって表示される。
それが普通です。ビットマップという画像形式は、
左下から右上に向かって記録されるフォーマットなので。

Excel セルに表示するのなら、それを考慮して座標を指定してみてください


> bmpinfo.biHeight = -bmpinfo.biHeight
正数ならばボトムアップ(左下から右上)、
負数ならばトップダウン(左上から右下)の順となります。
bmpinfo.biHeight は最終的に、負数・正数いずれになったか確認しておいてください。

ちなみに圧縮されたビットマップの場合は、トップダウン形式が使えなかったりします。
(トップダウンは、biCompression が BI_RGB あるいは BI_BITFIELDS の場合のみ有効)


> GetDIBits hMemDC, hBmp, 0, bmpinfo.biHeight, pixel(0, 0), bmpinfo, 0
画像全体をスキャンするのですよね。
第4引数に渡す biHeight が正数になっていることを確認しておいてください(そのための Abs 関数です)。

もしも負数を渡していた場合、
     -1 → 4,294,967,295
    -64 → 4,294,967,232
  -1024 → 4,294,966,272
のように、巨大な行数を指定したものとして解釈されてしまう可能性があります。


> A色がおかしい。
Excel のバージョンは何ですか? 2007 以上ではフルカラーが使えますが、
2003 以下の場合、ワークシート上で使用できる色は最大56色に制限されます。

http://officetanaka.net/excel/vba/cell/04-16.png
http://officetanaka.net/excel/vba/cell/04-17.png


> (青系統と茶系統が逆に表示される)
それは、RGB と BGR を逆に処理しているからですね。


32bit ビットマップでは、画素情報が Blue,Green,Red,Reserved(Alpha) の順に並びます。

バイナリ(Byte 配列)で取得した場合、BB,GG,RR,AA の順になっていることを確認できるかと思います。

そして Windows において、連続した 4 Byte が BB,GG,RR,AA の順で並んでいる場合、
それを 4 バイト整数型(Long 値)で受け取ると、&HAARRGGBB になるということを意味します。


「純赤」の画素:00,00,FF,00 → &HFF0000 (16711680)
「純青」の画素:FF,00,00,00 → &HFF (255)


一方、Excel の .Interior.Color はそうではありません。

青すなわち「vbBlue」は RGB(0, 0, &HFF) で &HFF0000 (16711680) ですし、
赤すなわち「vbRed」 は RGB(&HFF, 0, 0) で &HFF (255) という値です。逆ですよね。

Excel に表示させるなら、それを踏まえて変換してやる必要があります。


また、Excel に表示する場合は、アルファ値(AA) を 0 にしておいてください。

本来、アルファ値(透明度)とは 0 で完全透過、255 なら完全不透明ですが、
Excel のセルは透明度を指定できないため、Alpha 値は切り捨てて
&H00000000〜&H00FFFFFF の範囲で指定するようにします。

[ツリー表示へ]
タイトルRe^7: GetDIbitsの使用方法について
記事No15874
投稿日: 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

[ツリー表示へ]
タイトルRe^8: GetDIbitsの使用方法について
記事No15875
投稿日: 2014/03/24(Mon) 05:04
投稿者魔界の仮面弁士
>     '初期化
>     bmpinfo.biHeight = 80
あれ? ボトムアップ形式ではなく、トップダウン形式が必要なのですよね?
なぜ、高さに正数を指定しておられるのでしょうか?

http://msdn.microsoft.com/ja-jp/library/cc428673.aspx
》 高さに正の値を指定するとボトムアップのビットマップデータ(一般的なビットマップデータ)が、
》 負の値を指定するとトップダウンのビットマップデータが格納されます。



>     '★bmpinfoが設定済みなので不要?コメント行にしても結果は同じでした。
>     GetDIBits hMemDC, hBmp, 0, bmpinfo.biHeight, ByVal 0&, bmpinfo, 0
>     '配列の宣言
>     ReDim pixel(80 - 1, 80 - 1) As Long
動作上は問題ないにせよ、これだと不自然なコードにみえます。

lpvBits に NULL 参照を渡して呼び出すのは、スキャンデータに必要な領域の大きさを取得するためです。
ですから、バッファサイズ(biSizeImage)などが事前にわかっている場合には、取得処理など不要ですし、
意図して取得されているなら、後続の処理では bmpinfo に書き込まれた値を利用すべきです。



>     '★★高さを−にするとビットマップが逆転する?
>     bmpinfo.biHeight = -bmpinfo.biHeight

現在のコードだと、80 をセットしておいてからマイナス反転させていますが、
それだと無駄なので、最初から biHeight に -80 を渡した方がスマートでしょう。

GetDIBits で高さを調べてから、走査方向を逆転させるようなコードであれば、
提示された処理手順でも良いと思いますけど。


>         '★★↑次STEPにAbsで絶対値を代入しているので不要のはずなのに
>         'この行が無い場合は結果が違う(無い場合、画像上下が逆)
>     '色を取得,Pixel配列には画像の色が入る
>     GetDIBits hMemDC, hBmp, 0, Abs(bmpinfo.biHeight), pixel(0, 0), bmpinfo, 0

何故、第4引数に「絶対値」を渡す必要があるのかは把握されていますか?

第 4 引数は、「走査線行の数」ですから、マイナスが入る事はありえないからです。
(だからこそ、Unsigned Integer 型のパラメータとなっているわけで)

ところで、走査線行(スキャンライン)の意味はご存知でしょうか。
X 方向に並んだ一行分のラインのことです。


そもそもビットマップというものは、同じサイズの行データ(スキャンライン)を
並べたデータとして管理されています。各スキャンラインは、4の倍数サイズの単位で
確保される仕様のため、たとえば256色のビットマップの場合、幅79のBMPは、
幅80の場合と同じファイルサイズとなってしまう仕様です。
(フルカラーの場合は、1ドットごとに4バイトを消費するため、こうしたズレは生じません)

そしてそのスキャンラインは、御存じのように基本的には下から積み上げていく仕様です。
80x80 サイズの画像であれば、その積み方は
 ( 0,79) …… (79,79) 第0ライン
  :          :
  :          :
 ( 0, 0) …… (79, 0) 第79ライン
という配置になっているわけです。biHeight がマイナスの場合は、上下逆順なので、
 ( 0, 0) …… (79, 0) 第79ライン
  :          :
  :          :
 ( 0,79) …… (79,79) 第0ライン
という配置です。


さて、話を GetDIBits に戻しますが、これの第3引数は「走査を開始する行」であり、
第4引数は「操作する行数」を意味しています。それを踏まえて、現在の
 GetDIBits hMemDC, hBmp, 0, 80, …
という指定を、もしも
 GetDIBits hMemDC, hBmp, 0, 60, …
という指定にしたらどうなるでしょうか。

試してみると分かりますが、ボトムアップ形式であれば、
 ( 0,79) …… (79,79) 第0ライン
  :          :
 ( 0,19) …… (79,19) 第59ライン
までが転送されますし、トップダウン形式であれば、
 ( 0,19) …… (79,19) 第59ライン
  :          :
 ( 0,79) …… (79,79) 第0ライン
までが転送される結果となります。
第3引数を 0 ではなく 10 から始めれば、第10ラインからの分が転送されます。



上記の仕組みが分かれば、
> '★★↑次STEPにAbsで絶対値を代入しているので不要のはずなのに
という疑問もとけるかと思います。



> Private Type BITMAPINFO
この構造は BITMAPINFO ではなく、BITMAPINFOHEADER のものですよね。
http://msdn.microsoft.com/ja-jp/library/cc352308.aspx
http://msdn.microsoft.com/ja-jp/library/z5731wbz.aspx


今回はフルカラー指定の為、bmiColors メンバーを使わないとはいえ、
それを BITMAPINFO の名で宣言するのは、少々奇妙な印象を受けます。
(たとえば 8 bit カラーの場合、現在の構造体定義だとメモリ破壊を引き起こします)


なお、ビットマップ情報ヘッダというものは、
 12 バイト  (BITMAPCOREHEADER) OS/2
 40 バイト  (BITMAPINFOHEADER) Windows
 52 バイト  (BITMAPV2HEADER)
 56 バイト  (BITMAPV3HEADER)
 64 バイト  (BITMAPINFOHEADER2) OS/2 2.x 以降
 108 バイト (BITMAPV4HEADER) Win95以降
 124 バイト (BITMAPV5HEADER) Win98以降
のように複数のフォーマットがあるのですが、今回の利用方法では、
BITMAPV5HEADER を指定しても、BITMAPINFOHEADER 相当の部分しか利用されないようです。

[ツリー表示へ]
タイトルRe^9: GetDIbitsの使用方法について
記事No15876
投稿日: 2014/03/25(Tue) 19:43
投稿者還暦手習い
魔界の仮面弁士様

度重なるご指導ありがとうございました。
お教えいただいたことは、概ね理解できましたが、まだまだ
勉強することが山積していることを実感いたしました。

今回は本当に勉強になりました。ありがとうございました。
また管理人の花ちゃん様、このような勉強の場を与えていた
だき感謝しております。

[ツリー表示へ]