این کد رو چک کنید ببینید کار می کنه
Option Explicit
' Code by Mike Williams (2010) to modify the user's
' mouse movement in accordance with any set of rules
' (this specific example reverses the direction of
' both the x and y mouse movements, but it can easily
' be modified to perform other tasks, for example to
' swap the mouse orientation from landscape to portrait
Private Declare Function SetWindowsHookEx _
Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx _
Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx _
Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal Length As Long)
Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long
Private Const WH_MOUSE_LL As Long = 14 'low level
Private Const WH_MOUSE As Long = 7 ' app level
Private Const HC_ACTION = 0
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_RBUTTONDBLCLK As Long = &H206
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_SCROLL As Long = &H20A
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type MOUSELLHOOKSTRUCT
point As POINTAPI
data As Long
flags As Long
time As Long
extra As Long
End Type
Private mousedata As MOUSELLHOOKSTRUCT
Private oldCoords As POINTAPI
Private Hook As Long
Private xMax As Long, yMax As Long
Public Sub SetHook()
xMax = (Screen.Width / Screen.TwipsPerPixelX) - 1
yMax = (Screen.Height / Screen.TwipsPerPixelY) - 1
Hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)
End Sub
Public Sub ReleaseHook()
UnhookWindowsHookEx Hook
End Sub
Private Function MouseProc(ByVal nCode As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Static Initialised As Boolean, temp As Long
Dim diffX As Long, diffY As Long
If (nCode = HC_ACTION) And (wParam = WM_MOUSEMOVE) Then
CopyMemory mousedata, ByVal lParam, Len(mousedata)
If Not Initialised Then
oldCoords.X = mousedata.point.X
oldCoords.Y = mousedata.point.Y
Initialised = True
MouseProc = CallNextHookEx _
(0, nCode, wParam, ByVal lParam)
End If
diffX = mousedata.point.X - oldCoords.X
diffY = mousedata.point.Y - oldCoords.Y
If diffX = 0 And diffY = 0 Then
' same coords as previous coords, so this must be
' the move triggered by our Call to SetCursorPos,
' in which case we need to allow the system to
' deal with it
MouseProc = CallNextHookEx _
(0, nCode, wParam, ByVal lParam)
Else
' different coords, so this must be a standard mouse
' movement not triggered by our Call to SetCursorPos,
' in which case we need to modify the mouse movement
' in accordance with whatever rules we have set (this
' specific example reverses the movement in both the
' x plane and the y plane) abd we then need to tell
' the system to ignore the unwanted mouse movement
' that triggered this event.
' We modify the movement by first setting the mouse
' to the position we want it to be (using a call to
' SetCursorPos) and we instruct the system to ignore
' the "unwanted" mouse movement that triggered this
' event by setting the return value to True
oldCoords.X = mousedata.point.X - diffX - diffX
oldCoords.Y = mousedata.point.Y - diffY - diffY
If oldCoords.X < 0 Then oldCoords.X = 0
If oldCoords.X > xMax Then oldCoords.X = xMax
If oldCoords.Y < 0 Then oldCoords.Y = 0
If oldCoords.Y > yMax Then oldCoords.Y = yMax
SetCursorPos oldCoords.X, oldCoords.Y
MouseProc = True
Exit Function
End If
End If
End Function
Private Sub Form_Load()
Caption = "Close this Form to return " _
& "mouse movement to normal."
SetHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReleaseHook
End Sub
نوشته شده توسط kholous
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول