hey there! lately i have found myself needing to move the mouse in a line. making the mouse move from one point to another is no problem at all, but i want to make the mouse move slowly in a straight line from one point to another.
i have been playing with this for a while and here is my code:
- Quote:
-
Shadows Function MouseMove(ByVal X As Integer, ByVal Y As Integer, Optional ByVal speed As Integer = 0) If speed > 10 Then speed = 10 If speed <= 0 Then SetCursorPos(X, Y) Else Dim mousepos As Point = MouseGetPos() Dim TempPosX, TempPosY As Double TempPosX = mousepos.X TempPosY = mousepos.Y Dim distance As Double = Math.Sqrt(Math.Pow(Math.Abs(Math.Abs(X) - mousepos.X), 2)) + Math.Pow(Math.Abs(Math.Abs(Y) - mousepos.Y), 2) Dim ratio As Double Dim xdistance, ydistance As Double 'xdistance = (TempPosX - X) 'ydistance = (TempPosY - Y) xdistance = (X - TempPosX) ydistance = (Y - TempPosY) If Math.Max(Math.Abs(xdistance), Math.Abs(ydistance)) = Math.Abs(xdistance) Then ratio = xdistance / ydistance Dim mousepoints(Math.Abs(xdistance)) As Point If ydistance > 0 Then If xdistance > 0 Then For i = 0 To Math.Abs(xdistance) 'læg ratio til xpos og add 1 til ypos mousepoints(i).X = TempPosX + ratio mousepoints(i).Y = TempPosY + 1 TempPosX += ratio TempPosY += 1 Next ElseIf xdistance < 0 Then For i = 0 To Math.Abs(xdistance) 'træk ratio fra xpos og add 1 til ypos mousepoints(i).X = TempPosX - ratio mousepoints(i).Y = TempPosY + 1 TempPosX += (ratio) '*-1? TempPosY += 1 Next End If End If If ydistance < 0 Then If xdistance > 0 Then For i = 0 To Math.Abs(xdistance) 'læg ratio til xpos og sub 1 til ypos mousepoints(i).X = TempPosX + ratio mousepoints(i).Y = TempPosY - 1 TempPosX += ratio TempPosY += -1 Next ElseIf xdistance < 0 Then For i = 0 To Math.Abs(xdistance) 'træk ratio fra xpos og sub 1 til ypos mousepoints(i).X = TempPosX - ratio mousepoints(i).Y = TempPosY - 1 TempPosX += (ratio * -1) TempPosY += -1 Next End If End If For k = 0 To (mousepoints.Length - 1) SetCursorPos(mousepoints(k).X, mousepoints(k).Y) Label1.Text = MouseGetPos("x") & " y: " & MouseGetPos("y") If MouseGetPos("x") = X And MouseGetPos("y") = Y Then k = (mousepoints.Length - 1) Sleep(speed * 1.5) Next End If
If Math.Max(Math.Abs(xdistance), Math.Abs(ydistance)) = Math.Abs(ydistance) Then ratio = ydistance / xdistance Dim mousepoints(Math.Abs(ydistance)) As Point If ydistance > 0 Then If xdistance > 0 Then For i = 0 To Math.Abs(ydistance) 'læg ratio til xpos og add 1 til ypos mousepoints(i).X = TempPosX + 1 mousepoints(i).Y = TempPosY + ratio TempPosX += 1 TempPosY += ratio Next ElseIf xdistance < 0 Then For i = 0 To Math.Abs(ydistance) 'træk ratio fra xpos og add 1 til ypos mousepoints(i).X = TempPosX - 1 mousepoints(i).Y = TempPosY + ratio TempPosX += -1 TempPosY += ratio Next End If End If If ydistance < 0 Then If xdistance > 0 Then For i = 0 To Math.Abs(ydistance) 'læg ratio til xpos og sub 1 til ypos mousepoints(i).X = TempPosX + 1 mousepoints(i).Y = TempPosY - ratio TempPosX += 1 TempPosY += (ratio * -1) Next ElseIf xdistance < 0 Then For i = 0 To Math.Abs(ydistance) 'træk ratio fra xpos og sub 1 til ypos mousepoints(i).X = (TempPosX - mousepos.X) - 1 mousepoints(i).Y = (TempPosY - mousepos.Y) - ratio TempPosX += -1 TempPosY += (ratio * -1) Next End If End If For k = 0 To (mousepoints.Length - 1) SetCursorPos(mousepoints(k).X, mousepoints(k).Y) Label1.Text = MouseGetPos("x") & " y: " & MouseGetPos("y") If MouseGetPos("x") = X And MouseGetPos("y") = Y Then k = (mousepoints.Length - 1) Sleep(speed * 1.5) Next End If
End If End Function if the mouse is above and to the left of the target position it works just fine, but if the target is below and/or to the left of the mouse, the mouse will move in strange directions.
any ideas on how i might be able to fix this?
|