今天刚做一个程序,里面有用到某点颜色的RGB值,又懒得去下载现成的颜色提取软件。想想利用VB自己写个,应该也不难吧。所以就查了查API,顺手写了 这个颜色提取的小程序。程序中利用了3个API,GetCursorPos、GetDC、GetPixel。原理是利用GetCursorPos得到当前 鼠标的位置,用GetDC获得桌面的场景,最后用GetPixel来提取该点的RGB值和十六进制的颜色值。在本页底部可下载原代码 

程序运行界面如图,比较简单,有兴趣自己可以改改。VB中是用RGB来表示颜色的,如果你要做网页,就会用十六进制值了。

点击输入RGB,然后可分别在R、G、B中输入数字(0-255之间),按回车可自动获取RGB值和HEX值。 

点击从屏幕抓取,可获得屏幕上任意一点的RGB和HEX值。程序右下角是鼠标的位置。

具体代码:

Option Explicit
Private Declare Function GetCursorPos Lib “user32″ (lpPoint As POINTAPI) 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 GetDC Lib “user32″ (ByVal hwnd As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim p As POINTAPI
Dim lrgb As Long
Dim sthex As String 

Private Sub Form_Load()
Timer1.Interval = 20
Timer2.Interval = 20
Timer1.Enabled = True
Timer2.Enabled = False
End Sub

Private Sub opinput_Click()
Timer2.Enabled = False
tr.Text = “”
tg.Text = “”
tb.Text = “”
tr.ToolTipText = “输入RGB值 0-255″
tg.ToolTipText = “输入RGB值 0-255″
tb.ToolTipText = “输入RGB值 0-255″
tr.SetFocus
End Sub

Private Sub opinput_DblClick()
Timer2.Enabled = False
MsgBox “已停止提取颜色”
End Sub 

Private Sub oppick_Click()
Timer2.Enabled = True
Me.Caption = “颜色提取 – 双击选项框可停止提取”
tr.ToolTipText = “”
tg.ToolTipText = “”
tb.ToolTipText = “”
End Sub

Private Sub oppick_DblClick()
Timer2.Enabled = False
MsgBox “已停止提取颜色”
End Sub

Private Sub tb_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
lrgb = RGB(tr.Text, tg.Text, tb.Text)
trgb.Text = lrgb
Picture1.BackColor = lrgb
If lrgb = 0 Then
thex.Text = “000000″
Else
sthex = Hex(lrgb)
thex.Text = Right(sthex, 2) & Mid(sthex, 3, 2) & Left(sthex, 2)
End If 

End If
End Sub

Private Sub tg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
tb.SetFocus
End If
End Sub

Private Sub Timer1_Timer()
Call GetCursorPos(p)
lx.Caption = “x =  ” & p.x
ly.Caption = “y =  ” & p.y
‘获取鼠标位置
End Sub 

Private Sub Timer2_Timer()
Dim hwnd, lrgb As Long
hwnd = GetDC(0)
lrgb = GetPixel(hwnd, p.x, p.y)
trgb.Text = lrgb
Picture1.BackColor = lrgb
tr.Text = lrgb Mod 256
tg.Text = (lrgb \ 256) Mod 256
tb.Text = lrgb \ 256 \ 256
If lrgb = 0 Then
thex.Text = “000000″
Else
sthex = Hex(lrgb)
thex.Text = Right(sthex, 2) & Mid(sthex, 3, 2) & Left(sthex, 2)
End If

End Sub

Private Sub tr_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
tg.SetFocus
End If
End Sub
代码下载:pickcolor.rar 

Feed Me


转载文章请注明转载自:ThinkAgain - Let's Blog!

引用地址:http://www.thinkagain.cn/archives/10.html