设计状态下窗口中添加两个Frame控件做为容器,加入二个PictureBox控件,一个PictureClip控件(其中装入一个设计好的鼠标指针Mask图片),两个文本框控件,几个Label控件,两个Command控件,一个CheckBox控件。
代码如下:
Option Explicit
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate 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 LongPrivate 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 LongPrivate Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As LongPrivate 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 = -1Private Const HWND_NOTOPMOST = -2Private Const SWP_NOSIZE = &H1Private Const SWP_NOMOVE = &H2Private Const SWP_NOACTIVATE = &H10Private Const SWP_SHOWWINDOW = &H40
Private Type POINTAPI X As Long Y As LongEnd Type
Private Const SRCCOPY = &HCC0020Private Const SRCAND = &H8800C6Private Const SRCPAINT = &HEE0086
Dim MousePos As POINTAPIDim oldMousePos As POINTAPI
Private Sub Check1_Click()'设置顶层窗口 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 IfEnd Sub
Private Sub Command1_Click()'开始停止捕捉屏幕 If Command1.Caption = "停止" Then Command1.Caption = "开始" Timer1.Enabled = False Else Command1.Caption = "停止" Timer1.Enabled = True End IfEnd Sub
Private Sub Command2_Click()'退出程序 Unload MeEnd Sub
Private Sub Form_Activate()'程序启动后自动设置顶层窗口 Check1.Value = 1End Sub
Private Sub Timer1_Timer()Dim WindowDC As LongDim Color As LongDim r As Integer, b As Integer, g As Integer GetCursorPos MousePos '获取鼠标当前坐标 'If MousePos.X = oldMousePos.X And MousePos.Y = oldMousePos.Y Then Exit Sub '若未移动则返回 Frame1.Caption = "坐标(" & MousePos.X & "," & MousePos.Y & ")" oldMousePos = MousePos WindowDC = GetWindowDC(0) '获取屏幕的设备场景 Color = GetPixel(WindowDC, MousePos.X, MousePos.Y) '获取鼠标所指点的颜色 '分解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) '将以鼠标位置为中心的9*9的屏幕图像放大 StretchBlt Picture1.hDC, 0, 0, 73, 73, WindowDC, MousePos.X - 4, MousePos.Y - 4, 9, 9, SRCCOPY '将一个鼠标指针用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 = "开始" End IfEnd Sub
Private Function WebColor(r As Integer, g As Integer, b As Integer) As String'将10进制RGB值转为Web颜色值 WebColor = "#" & INT2HEX(r) & INT2HEX(g) & INT2HEX(b)End Function
Private Function INT2HEX(Value As Integer) As String'10进制转16进制 INT2HEX = Hex(Value) If Len(INT2HEX) = 1 Then INT2HEX = "0" & INT2HEX End IfEnd Function
运行效果:
<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>