我想做一个屏幕取色程序，请帮忙！

Question

当点下取色按钮后，鼠标就开始对屏幕取色，并且鼠标指针变为吸色管状，
但鼠标移出vb的窗体范围后，鼠标的指针就变为原形，并且在vb窗体的范围外点击鼠标，也不能触发屏幕取色的事件。
请问该如何解决？

Answer 1

程序可能有点长.说一下思路吧. 在窗体上放一个PICTURBOX,跟踪当前用当用户鼠标.如果超出窗体外,当用户点击鼠标时,交当前点COPY到PICTUREBOX(就是在当前位置截一个一至三个点大的屏).然后取PICTUREBOX中的颜色即可.

Answer 2

我也要个
[email protected]

Answer 3

太感谢了！
[email protected]

Answer 4

看
lbldata是控件数组,picture,timer控件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)
    Picture1.BackColor = r
End Sub

Answer 5

给你一个，和你要的不太一样，但是差不多了，如果要源代码，QQ我58426824
主要的代码如下：需要的控件和ICO就自己加把
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long            '返回设备的句柄，取消只能用ReleaseDC
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    '得到鼠标位置的API函数
Private Type POINTAPI
    X As Long
    Y As Long
End TypePrivate Sub Timer1_Timer()
Dim hDC As Long
hDC = GetDC(0)            '设定屏幕为当前设备
Dim Point As POINTAPI
GetCursorPos Point        '得到鼠标位置
a = Point.X
b = Point.Y
Label1.Caption = "x=" & a & " y=" & b
Label3.BackColor = GetPixel(hDC, Point.X, Point.Y)          '得到鼠标位置的颜色
Label2.Caption = Hex$(Label3.BackColor)
Label2.Caption = " " & Mid$("00000", 1, 6 - Len(Label2.Caption)) & Label2.CaptionLabel4(0).BackColor = Label3.BackColor
For i = 1 To 80 Step 1
  a = Val(Mid$(Label4(i).Caption, 1, 2)) + Point.X
  b = Val(Mid$(Label4(i).Caption, 3, 4)) + Point.Y
  If a < 0 Or a > Screen.Width / Screen.TwipsPerPixelX - 1 Or b < 0 Or b > Screen.Height / Screen.TwipsPerPixelY - 1 Then '实际上应该是屏幕的坐标极限，其中表达式是得到屏幕的分辨率，减去1是防止显示器的误差
  Label4(i).BackColor = &H0&
  Label4(i).ForeColor = &H0&
  Else
  Label4(i).BackColor = GetPixel(hDC, a, b)
  Label4(i).ForeColor = Label4(i).BackColor
  End If
Next iIf GetAsyncKeyState(17) <> 0 And GetAsyncKeyState(71) <> 0 Then     '判断CTRL（ASC码17）和G（71）是否同时按下
Label8.BackColor = Label3.BackColor
Text1.Text = "(" & Point.X & "," & Point.Y & ")"
Text2.Text = "&" & Mid$(Label2.Caption, 2) & "&"
End If
End Sub功能是抓取全屏幕的颜色，你如果只是想抓窗体的自己改一下就可以了，另外我是使用CTRL+G来抓取颜色，你可以自己改为按钮
程序中的LABEL4数组是用来放大屏幕的，
做的很粗糙，呵呵