画面の色を取得するには？
解決色に関しての記事はたくさんありましたが、
ほとんどがGetPixel、またはPointで解決しているようです。
私の質問は範囲がフォーム内でなくデスクトップ全体です。
どなたかご教示宜しくお願いいたします。
GetDC(0&)でスクリーンのデバイスコンテキストを取って、
GetPixelで座標の色を取得できます。
上のレスだけでは簡単すぎて、実現するのは難しいかな。。
Option Explicit
Private Type Point
x As Long
y As Long
End Type
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
Private Declare Function ReleaseCapture Lib "user32" () _
As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal _
hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Dim p As Point
Dim ScreenhDC
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub Command1_Click()
ScreenhDC = GetDC(0&)
SetCapture Me.hWnd
Command1.Caption = "画面の知りたい色をクリックしてね"
End Sub
Private Sub Form_Load()
Move 2000, 2000, 4000, 1000
Command1.Move 0, 0, Me.Width - 100, 600
Command1.Caption = "押してね"
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReleaseDC 0&, ScreenhDC
'キャプチャの解放
ReleaseCapture
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
Dim pc As Long
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 \ &H100&) And &HFF&) '2バイト目
b = CByte((pc \ &H10000) And &HFF&) '1バイト目
Command1.Caption = "RGB=(" & CStr(r) & "," & CStr(g) & "," & CStr(b) & ")" & vbCrLf & _
"次の色を知りたければ押してね"
ReleaseDC 0&, ScreenhDC
ReleaseCapture
DoEvents
End Sub
ここに貼り付けるために、思い切り簡単にしてます。
今日はここまでで帰るかな。。。
GetCursorPosとGetDC(0&)のみで動作しました。
ご回答いただきありがとうございました。
| ツイート |  |