【API Function】

[スクリーン上の指定座標の色を得る]

　他のウインドウ上の色やスクリーン上の色を得るためには、 SetCapture関数を使って、まず自ウインドウにマウスカーソルをキャプチャする必要があります。
　通常、マウスカーソルがフォーム上を動いている時、「動いている」という動作はそのフォームにメッセージとして送られ、 MouseMoveイベントが発生しますが、マウスカーソルがフォームの外に出ると、メッセージは送られなくなります。しかし、そのフォームにキャプチャしていれば、このウインドウがアクティブな間、マウスカーソルがフォームの外に出ても、メッセージはフォームに送られるようになります。ここでは、この方法を利用してスクリーン上の色を取得します。

（SetCaputure　関数等の使用方法）

フォームのGeneralセクションに次の宣言コードを追加して下さい。

'構造体の定義
Private Type POINT
    X As Long
    Y As Long
End Type


'ハンドルがhwndのデバイスコンテキストを得る
Private Declare Function GetDC Lib "user32" (ByVal hwnd As _
        Long) As Long


'デバイスコンテキストを解放する
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As _
        Long, ByVal hdc As Long) As Long

'マウスカーソルの現在の位置を､スクリーン座標で取得します｡
Private Declare Function GetCursorPos Lib "user32" _
        (lpPoint As POINT) As Long

'指定されたウインドウにマウスをキャプチャする
Private Declare Function SetCapture Lib "user32" _
        (ByVal hwnd As Long) As Long
    '---------------------引数---------------------------
    '(hwnd) マウスをキャプチャするウィンドウハンドル
    '--------------------戻り値--------------------------
    'その前にキャプチャされていたウィンドウのハンドル返す
    'そういったウインドウがなければ0を返す

'キャプチャを解放する
Private Declare Function ReleaseCapture Lib "user32" () _
        As Long
    '--------------------戻り値--------------------------
    '関数が成功すると0 以外の値が返り
    '関数が失敗すると0が返る

'指定座標の色を得る
Private Declare Function GetPixel Lib "gdi32" (ByVal _
        hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
    '---------------------引数---------------------------
    '(hdc) 対象のデバイスコンテキスト
    '(x)　色を取得するx座標
    '(y)　色を取得するy座標
    '--------------------戻り値--------------------------
    'RGB値を返す

    'スクリーン座標を格納する
    Dim p As POINT
    'スクリーンのデバイスコンテキスト
    Dim ScreenhDC As Long

フォームに、CommandButtonを2つ，TextBoxを1つ配置し、Form_Load(), Form_MouseDown,Command1_Click(),Command2_Click()プロシージャにそれぞれ次のコードを追加してください

'コントロールの初期化
Private Sub Form_Load()
    Command1.Enabled = True/FONT>
    Command2.Enabled = False/FONT>
End Sub/FONT>

'スクリーン座標，色の取得
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
        X As Single, Y As Single)
    'GetPixelで取得した色
    Dim pc As Long
    'GetPixelで取得した色を分解したもの
    Dim r As Long, g As Long, b As Long
    'スクリーン座標を得る
    GetCursorPos p
    'その座標の色を得る
    pc = GetPixel(ScreenhDC, p.X, p.Y)
    r = CByte(pc And &HFF)           '3バイト目を得る
    g = CByte((pc \ 256&) And &HFF)  '2バイト目を得る
    b = CByte((pc \ 65536) And &HFF) '1バイト目を得る
    Text1.BackColor = pc
    Text1.Text = "座標 ： " & "(" & p.X & "," & p.Y & ")" _
                 & "　" & "RGB値 = " & _
                 "(" & r & "," & g & "," & b & ")"
    'デバイスコンテキストの解放
    ReleaseDC 0&, ScreenhDC
    'キャプチャの解放
    ReleaseCapture
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

'色の取得開始
Private Sub Command1_Click()
    Command1.Enabled = False
    Command2.Enabled = True
    ScreenhDC = GetDC(0&)
    SetCapture Me.hwnd
End Sub

'色の取得をやめる
Private Sub Command2_Click()
    'デバイスコンテキストの解放
    ReleaseDC 0&, ScreenhDC
    ReleaseCapture
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Command1をクリックして、取得したい座標でマウスダウンすれば、取得したスクリーン座標とその色がTextBoxに表示されます。この方法では、マウスダウンすることで元のフォームが非アクティブ状態になるので1回しか取得できません。

API Functionインデックストップ