如何获取桌面上任意一点的RGB色？那位给段代码吧。

Question

如上。多谢。

Answer 1

转贴：
 
除了使用CommonDialog的方法，还有一种使用API函数的方法进可以实现获取颜色。 参见本例：
>>步骤1----建立新工程，在窗体上放置一个CommandButton,一个PictureBox,一个TextBox；
>>步骤2----编写如下代码：private Declare Function ChooseColor Lib "comdlg32.dll" Alias _
"ChooseColorA" (pChoosecolor As ChooseColor) As Longprivate Type ChooseColor
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End TypePrivate Sub Command1_Click()
Dim cc As ChooseColorcc.lStructSize = Len(cc)
cc.hwndOwner = Me.hWnd
cc.hInstance = App.hInstance
cc.flags = 0
cc.lpCustColors = String$(16 * 4, 0)if ChooseColor(cc) >= 1 Then
Picture1.BackColor = cc.rgbResult
Text1.Text = "颜色值：" & cc.rgbResult
Else
Text1.Text = "你取消了。"
End If
End Sub>>步骤3----编译运行,看,出

Answer 2

'一个timer控件，interval=50
'lblData的控件数组
'picture控件
'功能: 取得鼠标经过点的颜色值
'你可以改造以下，在form的MouseMove事件中判断
Option ExplicitPrivate Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
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 ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPrivate Sub Timer1_Timer()
    Static lX As Long, lY As Long
    On Local Error Resume Next
    Dim P As POINTAPI, h As Long, hD As Long, r As Long
    GetCursorPos P
    If P.x = lX And P.y = lY Then Exit Sub
    lX = P.x: lY = P.y
    lblData(0).Caption = lX & "," & lY
    h = WindowFromPoint(lX, lY)
    lblData(1).Caption = h
    hD = GetDC(h)
    lblData(2).Caption = hD
    ScreenToClient h, P
    lblData(3).Caption = P.x & "," & P.y
    r = GetPixel(hD, P.x, P.y)
    If r = -1 Then
        BitBlt Picture1.hdc, 0, 0, 1, 1, hD, P.x, P.y, vbSrcCopy
        r = Picture1.Point(0, 0)
    Else
        Picture1.PSet (0, 0), r
    End If
    lblData(4).Caption = Hex$(r)    '这是rgb
    Picture1.BackColor = r
End Sub

Answer 3

Option Explicit
'Picture1,Text1,text2,Text3,Text4,Timer1各一个
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Type ColorToRGB
    R As Byte
    G As Byte
    B As Byte
End Type
Private Sub Timer1_Timer()
    Text1.Text = GetPixel(GetDC(0), MouseDC.ponX, MouseDC.ponY)
    Dim GC As ColorToRGB
    GC = GetRGB(Text1.Text)
    Text2.Text = GC.R
    Text3.Text = GC.G
    Text4.Text = GC.B
    Picture1.BackColor = Text1.Text
End Sub
Private Function GetRGB(ByVal MyColor As Long) As ColorToRGB
    GetRGB.R = MyColor And &HFF&
    GetRGB.G = (MyColor \ 256) And &HFF&
    GetRGB.B = MyColor \ 65536
End Function
------------------------
Option ExplicitPublic Declare Function WindowFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
    x As Long
    y As Long
End TypePublic Type DGfor3
    ponX As Long
    ponY As Long
    MDC As Long
End TypePublic Function MouseDC() As DGfor3
    On Error Resume Next
    Dim Cur As POINTAPI
    GetCursorPos Cur
    MouseDC.MDC = WindowFromPoint(Cur.x, Cur.y)
    MouseDC.ponX = Cur.x
    MouseDC.ponY = Cur.y
End Function
-----------------
上面的是FORM1的代码，下面的是MODULE1的代码。

Answer 4

建立两个窗口分别是Form1和Form2
将启动对象设置为Form1,将Form2的BorderStyle属性设置为0
然后在Form1添加一个按钮名为Command1，Caption属性值为“选取颜色”
Form1代码如下：
Private Sub Command1_Click()
   Form2.Show
End Sub
Form2代码如下：
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
                         ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
                         ByVal nHeight As Long, ByVal hSrcDC As Long, _
                         ByVal xSrc As Long, ByVal ySrc As Long, _
                         ByVal dwRop As Long) As Long
Private Sub Form_Load()
   Dim 桌面窗口 As Long, 设备句柄 As Long
   Me.AutoRedraw = True
   Me.Move 0, 0, Screen.Width, Screen.Height
   桌面窗口 = GetDesktopWindow
   设备句柄 = GetWindowDC(桌面窗口)
   BitBlt Me.hDC, 0, 0, Me.Width / 15, Me.Height / 15, 设备句柄, 0, 0, vbSrcCopy
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
                           X As Single, Y As Single)
   If Button = 1 Then Form1.BackColor = Me.Point(X, Y): Unload Me
End Sub

Answer 5

求RGB色的方法是:
R=颜色值 Mod 256
G=Int(颜色值 / 256) Mod 256
B=Int(Int(颜色值 / 256) / 256) Mod 256

Answer 6

昏死了。我试出来了：
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Type POINTAPI
        x As Long
        y As Long
End TypePrivate rt As Long
Private dc1 As LongPrivate Sub Form_Load()    dc1 = GetDC(0)
    If dc1 = 0 Then MsgBox "获取DC错误"
        
End Sub
Private Sub Form_Unload(Cancel As Integer)
   DeleteDC (dc1)
End SubPrivate Sub Timer1_Timer()
   Dim pDesktop_Point As POINTAPI
   rt = GetCursorPos(pDesktop_Point)
   Me.Text2.Text = pDesktop_Point.x
   Me.Text3.Text = pDesktop_Point.y
   Me.Picture1.BackColor = GetPixel(dc1, pDesktop_Point.x, pDesktop_Point.y)
      
End Sub通俗容懂。呵呵。

Answer 7

呵呵
改一下就出来了
主要是我那段程序中还有其他信息，如果只要rgb就简单了