VB可以获取屏幕一个点的颜色吗？

Question

如果有并给出例子马上加至200分

Answer 1

有啊！如下；'Module1 模块
'--------------------------------------------------------------------------
Option ExplicitPublic Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Long) As Long
Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public 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
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As LongPublic Const VK_LBUTTON = &H1
Public Const VK_RBUTTON = &H2
Public Const VK_ESCAPE = &H1B
Public Const HWND_TOPMOST = -1
Public Const SWP_NOSIZE = &H1
Public Const FLAGS = SWP_NOSIZEPublic Type POINTAPI
        x As Long
        y As Long
End Type'创建画笔
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long'nPenStyle  ，指定画笔样式，可以是下述常数之一
Public Const PS_SOLID = 0 '画笔画出的是实线Public Const PS_DASH = 1 '画笔画出的是虚线（nWidth必须是1）Public Const PS_DOT = 2 '画笔画出的是点线（nWidth必须是1）Public Const PS_DASHDOT = 3 '画笔画出的是点划线（nWidth必须是1）Public Const PS_DASHDOTDOT = 4 '画笔画出的是点-点-划线（nWidth必须是1）Public Const PS_NULL = 5 '画笔不能画图Public Const PS_INSIDEFRAME = 6 '画笔在由椭圆、矩形、圆角矩形、饼图以及弦等生成的封闭对象框中画图。如指定的准确RGB颜色不存在，就进行抖动处理'删除画笔
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long'****************************************************************************************
'窗体模块
Option ExplicitDim tC As POINTAPI
Dim Rlor As Long
Dim wTp As Long
Dim Regwd As LongPrivate Sub Command1_Click()wTp = GetDC(0)Timer1.Enabled = True
Timer1.Interval = 50
'GetCursorPos tCEnd SubPrivate Sub Form_Unload(Cancel As Integer)
Regwd = ReleaseDC(0, wTp)
Unload MeEnd SubPrivate Sub Timer1_Timer()
GetCursorPos tC Rlor = GetPixel(wTp, tC.x, tC.y)
 Text1.Text = Rlor
 Text2.Text = tC.x
 Text3.Text = tC.y
 
End Sub

Answer 2

Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Dim pt As POINTAPIPrivate Sub Timer1_Timer()
Dim hdc As Long, Col As Long
Dim R As Long, g As Long, b As Long
hdc = GetDC(0)
GetCursorPos pt
cor = GetPixel(hdc, pt.x, pt.y)
GetRGB cor, R, g, b
ReleaseDC Me.hwnd, hdc
Text1.Text = "R: " & R & "  G:" & g & "  B:" & b
End Sub
'得到一种颜色的r,g,b值
Private Sub GetRGB(ByVal Col As Long, ByRef R As Long, ByRef g As Long, ByRef b As Long)
  R = Col Mod 256
  g = ((Col And &HFF00&) \ 256&) Mod 256&
  b = (Col And &HFF0000) \ 65536
End Sub

Answer 3

Option Explicit
Private Type POINTAPI
        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 GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim hScrDC As LongPrivate Sub Command1_Click()
    Timer1.Enabled = True
    Timer1.Interval = 1
End SubPrivate Sub GetRGB(RGBData As Long)
    Debug.Print RGBData
    Me.Text1.Text = RGBData Mod 256
    Me.Text2.Text = (RGBData \ 256&) Mod 256
    Me.Text3.Text = (RGBData \ 65535) Mod 256
End SubPrivate Sub Command2_Click()
    Me.Timer1.Enabled = False
    ReleaseDC Me.hwnd, hScrDC
End SubPrivate Sub Timer1_Timer()
    Dim hScrDC As Long
    Dim PT As POINTAPI
    Dim RGB As Long
    hScrDC = GetDC(0)
    GetCursorPos PT
    RGB = GetPixel(hScrDC, PT.x, PT.y)
    Call GetRGB(RGB)
End Sub