設(shè)計(jì)狀態(tài)下窗口中添加兩個(gè)Frame控件做為容器，加入二個(gè)PictureBox控件，一個(gè)PictureClip控件（其中裝入一個(gè)設(shè)計(jì)好的鼠標(biāo)指針Mask圖片），兩個(gè)文本框控件，幾個(gè)Label控件，兩個(gè)Command控件，一個(gè)CheckBox控件。



代碼如下：

Option Explicit

Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) 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 Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal Height As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop 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 Sub 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)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCPAINT = &HEE0086

Dim MousePos As POINTAPI
Dim oldMousePos As POINTAPI

Private Sub Check1_Click()
'設(shè)置頂層窗口
If Check1.Value = 1 Then
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos Me.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub

Private Sub Command1_Click()
'開(kāi)始停止捕捉屏幕
If Command1.Caption = "停止" Then
Command1.Caption = "開(kāi)始"
Timer1.Enabled = False
Else
Command1.Caption = "停止"
Timer1.Enabled = True
End If
End Sub

Private Sub Command2_Click()
'退出程序
Unload Me
End Sub

Private Sub Form_Activate()
'程序啟動(dòng)后自動(dòng)設(shè)置頂層窗口
Check1.Value = 1
End Sub

Private Sub Timer1_Timer()
Dim WindowDC As Long
Dim Color As Long
Dim r As Integer, b As Integer, g As Integer
GetCursorPos MousePos '獲取鼠標(biāo)當(dāng)前坐標(biāo)
'If MousePos.X = oldMousePos.X And MousePos.Y = oldMousePos.Y Then Exit Sub '若未移動(dòng)則返回
Frame1.Caption = "坐標(biāo)(" & MousePos.X & "," & MousePos.Y & ")"
oldMousePos = MousePos
WindowDC = GetWindowDC(0) '獲取屏幕的設(shè)備場(chǎng)景
Color = GetPixel(WindowDC, MousePos.X, MousePos.Y) '獲取鼠標(biāo)所指點(diǎn)的顏色
'分解RGB顏色值
r = (Color Mod 256)
b = (Int(Color \ 65536))
g = ((Color - (b * 65536) - r) \ 256)
Label1.BackColor = RGB(r, g, b)
Text1.Text = r & "," & g & "," & b
Text2.Text = WebColor(r, g, b)
'將以鼠標(biāo)位置為中心的9*9的屏幕圖像放大
StretchBlt Picture1.hDC, 0, 0, 73, 73, WindowDC, MousePos.X - 4, MousePos.Y - 4, 9, 9, SRCCOPY
'將一個(gè)鼠標(biāo)指針用Mask的方法透明的畫到放大的圖像中
Picture2.Picture = PictureClip1.GraphicCell(1)
BitBlt Picture1.hDC, 37, 37, 12, 21, Picture2.hDC, 0, 0, SRCAND
Picture2.Picture = PictureClip1.GraphicCell(0)
BitBlt Picture1.hDC, 37, 37, 12, 21, Picture2.hDC, 0, 0, SRCPAINT
'獲得是否按了熱鍵F12
If GetAsyncKeyState(vbKeyF12) <> 0 Then
Timer1.Enabled = False
Command1.Caption = "開(kāi)始"
End If
End Sub

Private Function WebColor(r As Integer, g As Integer, b As Integer) As String
'將10進(jìn)制RGB值轉(zhuǎn)為Web顏色值
WebColor = "#" & INT2HEX(r) & INT2HEX(g) & INT2HEX(b)
End Function

Private Function INT2HEX(Value As Integer) As String
'10進(jìn)制轉(zhuǎn)16進(jìn)制
INT2HEX = Hex(Value)
If Len(INT2HEX) = 1 Then
INT2HEX = "0" & INT2HEX
End If
End Function