This is some code I gaffled from a VB-WORLD.NET post when I was making a tutorial program that I wanted it to click buttons for dumb people...
Code:
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type Point
X As Long
Y As Long
End Type
Private Sub Command1_Click()
SmoothMotion 100, 100
End Sub
Private Sub SmoothMotion(ByVal toX As Long, ByVal toY As Long)
' toX and toY are in SCREEN COORDINATES, in PIXELS
Dim Pt As Point, OrgPt As Point
Dim ptX As Single, ptY As Single, halfx As Single, halfy As Single
Dim Divisor As Single
Divisor = 2 ' change this to change the accel
GetCursorPos Pt
OrgPt = Pt
halfx = (toX + OrgPt.X) / 2
halfy = (toX + OrgPt.Y) / 2
ptX = Pt.X + Sign(toX - halfx)
ptY = Pt.Y + Sign(toY - halfy)
While Abs(toX - ptX) > 3 Or Abs(toY - ptY) > 3
If PtBetween(ptX, OrgPt.X, halfx, toX) Then
ptX = ptX + (toX - ptX) / Divisor
Else
ptX = ptX + (ptX - OrgPt.X) / Divisor
End If
If PtBetween(ptY, OrgPt.Y, halfy, toY) Then
ptY = ptY + (toY - ptY) / Divisor
Else
ptY = ptY + (ptY - OrgPt.Y) / Divisor
End If
SetCursorPos ptX, ptY
Sleep 0.05
Wend
SetCursorPos toX, toY
End Sub
Private Function Sign(ByVal X As Single) As Long
If (X = 0) Then Sign = 0 Else Sign = X / Abs(X)
End Function
Private Function MaxAbs(ByVal X As Long, ByVal Y As Long) As Long
If (Abs(X) < Abs(Y)) Then MaxAbs = Y Else MaxAbs = X
End Function
Private Function PtBetween(ByVal X As Long, ByVal x0 As Long, ByVal x1 As Long, ByVal x2 As Long) As Boolean
' x0, x1, and x2 should be either x0<x1><x2 or x0>x1>x2
If (x0 < x2) Then
PtBetween = (X > x1)
Else
PtBetween = (X < x1)
End If
End Function
Private Sub Sleep(dur As Single)
Dim newT As Single
newT = Timer + dur
While (Timer < newT)
DoEvents
Wend
End Sub