|
This article learns you a nice trick on tracking mouse movement and controling it the way you like.
Using API makes almost everything possible in windows programming. On this article you also learn some side tricks like
obtaining the exact screen width and height in pixels. We use two API functoins. First one is GetCursorPos that retrieves the mouse position and puts it into lpPoint
(The only argument that is passed to the function). Here's the declaration:
'Get the current cursor position
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
POINTAPI is our custom declared type containing two X and Y variables from the Long type. This
type is used for handling cursor's X and Y cordinates:
Private Type POINTAPI
X As Long
Y As Long
End Type
The next function is SetCursorPos that sets current X and Y cordinates of
the cursor using two long argument passed to it.
'Set the current cursor position
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Now that we're done with API, It's better to get to the GUI part. First add two buttons named cmdStart and cmdStop, after that add a textbox named txtMultiplier and a timer named tmrTimer. We have to declare a variable
for handling the last cursor position. This variable (mLast as POINTAPI) helps us to predict the direction of mouse movement and multiply its movement in that
direction. On cmdStart's click event, we update mLast with the
current cursor cordinates and enable tmrTimer. Remember that tmrTimer must be disabled at application startup. Also on cmdStop's
click event tmrTimer must be disabled.
'Holds the last mouse position
Dim mLast As POINTAPI
'Update mLast with the current cursor cordinates and enable tmrTimer
Private Sub cmdStart_Click()
Call GetCursorPos(mLast)
tmrTimer.Enabled = True
End Sub
'Disable tmrTimer
Private Sub cmdStop_Click()
tmrTimer.Enabled = False
End Sub
When the timer is enabled, on each timer event we should check the difference between current mouse
position and the last one saved in mLast. By multiplying that difference we transform the
movement and set the result as current cursor position. But before doing this we should be careful not to send the
cursor out of screen cordinates. For this caution we need to have the exact screen width and height. See these two
example functions for obtaining screen size:
'Obtain screen width in pixels
Private Function ScreenWidth()
ScreenWidth = ScaleX(Screen.Width, vbTwips, vbPixels)
End Function
'Obtain screen height in pixels
Private Function ScreenHeight()
ScreenHeight = ScaleY(Screen.Height, vbTwips, vbPixels)
End Function
Everything is now ready for our acceleration. Here's tmrTimer's timer
event:
'The main part of acceleration
Private Sub tmrTimer_Timer()
On Error Resume Next
Dim Current As POINTAPI
Call GetCursorPos(Current)
Current.X = Current.X + (Current.X - mLast.X) * txt.Text
Current.Y = Current.Y + (Current.Y - mLast.Y) * txt.Text
If Current.X < 0 Then Current.X = 0
If Current.Y < 0 Then Current.Y = 0
If Current.X > ScreenWidth Then Current.X =
ScreenWidth - 1
If Current.Y > ScreenHeight Then Current.Y =
ScreenHeight - 1
Call SetCursorPos(Current.X, Current.Y)
mLast.X = Current.X
mLast.Y = Current.Y
End Sub
You can download the sample project Mouse Accelerator - 5.89 KB or use the code below for
straight copy and paste into your program:
'Get the current cursor position
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Set the current cursor position
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'Holds the last mouse position
Dim mLast As POINTAPI
'Update mLast with the current cursor cordinates and enable tmrTimer
Private Sub cmdStart_Click()
Call GetCursorPos(mLast)
tmrTimer.Enabled = True
End Sub
'Disable tmrTimer
Private Sub cmdStop_Click()
tmrTimer.Enabled = False
End Sub
'The main part of acceleration
Private Sub tmrTimer_Timer()
On Error Resume Next
Dim Current As POINTAPI
Call GetCursorPos(Current)
Current.X = Current.X + (Current.X - mLast.X) * txt.Text
Current.Y = Current.Y + (Current.Y - mLast.Y) * txt.Text
If Current.X < 0 Then Current.X = 0
If Current.Y < 0 Then Current.Y = 0
If Current.X > ScreenWidth Then Current.X =
ScreenWidth - 1
If Current.Y > ScreenHeight Then Current.Y =
ScreenHeight - 1
Call SetCursorPos(Current.X, Current.Y)
mLast.X = Current.X
mLast.Y = Current.Y
End Sub
'Obtain screen width in pixels
Private Function ScreenWidth()
ScreenWidth = ScaleX(Screen.Width, vbTwips, vbPixels)
End Function
'Obtain screen height in pixels
Private Function ScreenHeight()
ScreenHeight = ScaleY(Screen.Height, vbTwips, vbPixels)
End Function
|
IP: 38.103.63.59 |
Country: United States
|
Browser: Unknown |
OS: Unknown |
|
| 
Mouse Accelerator - 5.89 KB
