如何获取屏目上任意一点的颜色值?

[jxgzay]

现有图片颜色做参照,想在VB背景或前景设置成相同颜色.
如何获取颜色值呢?

[gamestory]

用API函数
先GetDesktopDC，获得桌面的DC
在Bitblt,将桌面图象拷贝到一个PIctureBox里
再根据鼠标位置用Getpixel获得当前位置的颜色

[MmMVP]

Option Explicit
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 Type POINTAPI
x As Long
y As Long
End Type

Private Sub Command1_Click()
Dim pt As POINTAPI
Dim Fhwnd As Long
Call GetCursorPos(pt)
Fhwnd = GetDC(0)
MsgBox GetPixel(Fhwnd, pt.x, pt.y)
End Sub

[MmMVP]

汗。。忘了releasedc

Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long

[laviewpbt]

最好不要运行上面的代码!
没有releasedc
小心你的WINDOWS罢工
呵呵

[laviewpbt]

还有, MmMVP代码只能得到按钮表面的颜色
呵呵

Option Explicit
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 ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Type POINTAPI
x As Long
y As Long
End Type

Dim pt As POINTAPI


Private Sub Timer1_Timer()
Dim color As Long, r As Long, g As Long, b As Long
Dim hwnd As Long
Call GetCursorPos(pt)
hwnd = GetDC(0)
color = GetPixel(hwnd, pt.x, pt.y)
GetRGB color, r, g, b
Text1.Text = r
Text2.Text = g
Text3.Text = b
ReleaseDC hwnd, 0
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

[MmMVP]

还有, MmMVP代码只能得到按钮表面的颜色
=========================================
只要保持窗体焦点，按回车也可以的^_^

[jxgzay]

谢谢各位!
我通过大家提示,获取了PictureBox 任一点的颜色,一个PictureBox放置一幅图片,两个TextBox,在图片框内移动属标即可.
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long


Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
l = GetPixel(Picture1.hdc, X / 15, Y / 15)
Text1.BackColor = l
Text2.Text = "当前颜色:&H" & Hex(l)
End Sub