鼠标类函数

得到当前鼠标指针的坐标:GetCursorPos函数
声明:
public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long 参数缺省为byref指针传递
调用:先声明一个自定义类型变量: Dim z As POINTAPI
Private Sub Timer1_Timer()
GetCursorPos z 注:这里z是引用地址传递,其值改变,就象"返回值"
Label1.Caption = z.x
Label2.Caption = z.y
End Sub
参数lpPoint返回鼠标在屏幕上坐标(不限于程序窗体),如将鼠标指针移到屏幕左上角时,z.x=0,z.y=0,而鼠标移到屏幕右下角时,z.x=639;z.y=477
===========================================================
设置鼠标在屏幕上的坐标 : SetCursorPos函数
声明:
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
调用如:Private Sub Command1_Click()
Call SetCursorPos(600, 100) 将鼠标定位到屏幕(600,100)处。
End Sub
很简单,注:屏幕是以象素为单位的(与屏幕分辨率设定有关)。不是缇。
==========================================================
自动按下鼠标按纽:mouse_event过程函数
该过程能在程序中模拟手工按下或抬起鼠标,移动鼠标的操作,声明:
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
一般只用它的第1个参数,指明按下或抬起哪个按纽,如果要模拟鼠标移动,则要用到第2,3个参数dx和dy, 而最后面两个参数始终不用。
第1个参数dwFlags的可能设置值如下:
MOUSEEVENTF_LEFTDOWN=&H2: 模拟鼠标左键按下
MOUSEEVENTF_LEFTUP :模拟鼠标左键抬起
MOUSEEVENTF_RIGHTDOWN: 模拟鼠标右键按下
MOUSEEVENTF_RIGHTUP :模拟鼠标右键抬起
MOUSEEVENTF_ABSOLUTE=&H8000: 由参数dx和dy指定鼠标坐标系统中的一个绝对位置。在鼠标坐标系统中,屏幕在水平和垂直方向上均匀分割成65535×65535个单元
MOUSEEVENTF_MOVE=&H1 :移动鼠标
调用如:在屏幕上指定位置按下鼠标左键:
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Sub Timer1_Timer()
SetCursorPos 300, 20
mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0&
End Sub
模拟鼠标移动需要设置其dx和dy参数来确定鼠标位置,这时第1个参数用MOUSEEVENTF_MOVE加上MOUSEEVENTF_ABSOLUTE组合,如下:
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_ABSOLUTE = &H8000
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, 65535, 65535, 0&, 0& '移动鼠标
mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0& '按下鼠标
这样可省去用SetCursorPos函数,不过它不以象素为度量单位,而是将长宽分别平分为65535个鼠标位置点,要注意。
补充说明:
参数dx-- Long,根据是否指定了MOUSEEVENTF_ABSOLUTE标志,指定水平方向的绝对位置或相对运动
参数dy-- Long,根据是否指定了MOUSEEVENTF_ABSOLUTE标志,指定垂直方向的绝对位置或相对运动
==============================================
限制鼠标活动区域函数:ClipCursor函数
限制光标只能在参数lpRect给出的矩形区域内运动。声明:
Public Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
参数lpRect声明为RECT型,RECT的声明如下:
Public Type RECT
Left As Long
Top As Long Left,Top为左上角坐标。
Right As Long
Bottom As Long Right,Bottom为右下角坐标。
End Type
注:以上坐标使用的是屏幕坐标。
调用如:
Dim lxnRect As RECT
Private Sub Form_Click()
Static a As Boolean
a = Not a
If a = True Then 活动范围为Form1
lxnRect.Left = Form1.Left \ Screen.TwipsPerPixelX
lxnRect.Top = Form1.Top \ Screen.TwipsPerPixelY
lxnRect.Right = (Form1.Left + Form1.Width) \ Screen.TwipsPerPixelX
lxnRect.Bottom = (Form1.Top + Form1.Height) \ Screen.TwipsPerPixelY
ClipCursor lxnRect
Else 活动范围为全屏幕
lxnRect.Left = 0
lxnRect.Top = 0
lxnRect.Right = Screen.Width \ Screen.TwipsPerPixelX
lxnRect.Bottom = Screen.Height \ Screen.TwipsPerPixelY
ClipCursor lxnRect
End If
End Sub
上例是这样的,在窗体上单击时,鼠标活动限在此窗体,再单击,则恢复为全屏幕活动范围。
注:在VB中,所有尺寸都化为缇了(包括screen对象的width,height),而在API中,所有尺寸都为象素,因此,要统一单位,用转换比例screen对象的TwipsPerPixelX和TwipsPerPixelY(好象值就等于15。不知是否固定不变。)
======================================
显示/隐藏鼠标指针:ShowCursor函数
该函数可用于隐藏鼠标,但鼠标仍然可"看不见地移动"。声明:
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
参数很简单:bShow--当为true且"函数"返回值大于等于0时,显示指针,当为false且"函数"返回值小于0时,隐藏指针。
注:该函数的函数返回值需要注意:它返回"显示计数",windows维持着一个内部显示计数;倘若bShow为TRUE,那么每调用一次这个函数,计数就会递增1;反之,如bShow为FALSE,则计数递减1。只有在这个计数大于或等于0的情况下,指针才会显示出来。而小于0时则隐藏,因此,不单是简单地把bShow设为false就可以了。不然要想再使指针显示出来,可能会遇到困难。如:
Dim a As Boolean
Private Sub Form_Click()
a = False
x = ShowCursor(a)
Print x
End Sub
如果我们多次单击form窗体,则x的值会变为-1,-2,-3,-4……这时,如果再简单地把a改为true,则单击1次时指针不会重显,x的值会变为-3,-2,-1,0……只有多次单击使x等于大于0的时候,指针才会重显。
===========================================
在VB中捕捉mouse_leave事件:SetCapture和ReleaseCapture函数
SetCapture函数:设置鼠标捕获到指定窗口,使该窗口接收所有鼠标输入。
ReleaseCapture函数:释放鼠标捕获。
声明:
Declare Function SetCapture Lib "user32"(ByVal hwnd As Long) As Long
Declare Function ReleaseCapture Lib "user32"() As Long
参数:hwnd--要接收所有鼠标输入的窗口句柄。
调用如(捕捉command2的mouseleave"事件":
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Text = X & "," & Y
Dim MouseOver As Boolean
MouseOver = (0 <= X) And (X <= Command2.Width) And (0 <= Y) And (Y <= Command2.Height) 这里要注意,一个控件的mouse类事件返回的X,Y坐标值是此控件自身的窗口坐标,不是Form的坐标!所以左上角都是(0,0)-右下角(width,height).
If MouseOver Then 当鼠标在command2上时,
Command2.BackColor = RGB(255, 255, 0)
SetCapture Command2.hwnd 使command2窗口响应鼠标输入。
Else 当鼠标离开时,以下写mouseleave的内容。
Command2.BackColor = RGB(120, 120, 120)
ReleaseCapture command2不再响应鼠标动作
End If
End Sub

你可能感兴趣的:(vb)