modmouse.bas

关于WINSOCK控件基本编程的例程,提供电子邮件例程

Attribute VB_Name = "ModMouse"
Public Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
'交换按钮
'bswap为True时正常，为False时，互换
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'隐藏指针
'bShow为False时隐藏，为True时复原
Public Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal y As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
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)
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_LEFTDOWN = &H2

Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Type POINTAPI1
X As Long
y As Long
End Type



Public Function toLockCursor(ByVal ctlHwnd As Long) As Boolean
'锁定鼠标
Dim rect5 As RECT
Dim res As Long
'取得window的四个角
GetWindowRect ctlHwnd, rect5
rect5.Top = rect5.Top
rect5.Left = rect5.Left
rect5.Bottom = rect5.Bottom
rect5.Right = rect5.Right
SetCursorPos (rect5.Top + rect5.Bottom) \ 2, (rect5.Left + rect5.Right) \ 2
res = ClipCursor(rect5)
If res = 1 Then
   toLockCursor = True
Else
   toLockCursor = False
End If
End Function
Public Sub toUnLockCursor()
'鼠标解锁
Dim rscreen As RECT
rscreen.Top = 0
rscreen.Left = 0
rscreen.Right = Screen.Width \ Screen.TwipsPerPixelX
rscreen.Bottom = Screen.Height \ Screen.TwipsPerPixelY
ClipCursor rscreen
End Sub
Public Sub MoveMouse()
For i = 0 To 10
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, 5000, 0
Sleep (100)
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, 0, 60000
Sleep (100)
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, 5000, 5000
Sleep (100)
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, 0, 0
Sleep (1000)
Next i
End Sub


Public Function MousePS() As POINTAPI
'获得鼠标的位置并发送
Dim Mz As POINTAPI1
GetCursorPos Mz
frmMain.objTCP.sendata "MOUSEPO" & Mz.X & "|" & Mz.y
End Function