-
I'm sure it's been covered before . It's not that hard to do
yet I have issues . This is simple , Move the Object around the screen . The problem lies when it's moving to the right hand side . It seems to hit the wall then go straight up , yet on the left it works fine . I fail to see the error in my code and was hoping that you would have a look . The code is below .
Code:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETTEXT = &HD
Private Sub cmd_StartRecord_Click()
End Sub
Private Sub cmd_StopRecording_Click()
Sleep 4000 ' 2000 milliseconds = 2 seconds to delay
Timer1.Enabled = True
retval = SetCursorPos(0, 0) ' move the cursor to top left corner
End Sub
Private Sub cmd_Start_Click()
Sleep 4000 ' 2000 milliseconds = 2 seconds to delay
Timer1.Enabled = False
retval = SetCursorPos(0, 0) ' move the cursor to top left corner
End Sub
Private Sub Command1_Click()
End Sub
Private Sub cmd_Stop_Click()
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
'Call the Formsontop function
'USAGE: Call formsontop(Me ,True ) -ONTOP MOST
' Call formsontop(Me ,False ) -NOT TOP MOST
Call FormsOnTop(Me, True)
'Set Initial Settings
Steps = 0
'Set the Steps Caption to the amount of steps
lbl_Steps.Caption = "Steps (" & Steps & ")"
Recording = False
Playing = False
'Get the screen Resolution
Dim x, y As Integer
x = Screen.Width / Screen.TwipsPerPixelX
y = Screen.Height / Screen.TwipsPerPixelY
Label3.Caption = "Screen Width =" '& x '& " TwipsPerPixel"
lbl_X.Caption = x
Label4.Caption = "Screen Height =" ' & y '& " TwipsPerPixel"
lbl_Y.Caption = y
Timer2.Enabled = True ' This captures the links
End Sub
Private Sub Timer1_Timer()
If IsOnScreen Then
'Call MoveMouse(GetX + 10, GetY + 10) 'Change Location of the Current Cursor
Dim retval As Long ' return value
retval = SetCursorPos(GetX + 10, GetY + 10) ' move the cursor
'//Updatet the text boxes
txt_CurrentX.Text = GetX
txt_CurrentY.Text = GetY
Me.Refresh 'Refresh the form1
If GetAsyncKeyState(vbLeftButton) Then Debug.Print "Left Button"
If GetAsyncKeyState(vbRightButton) Then Debug.Print "Right Button"
If GetAsyncKeyState(vbMiddleButton) Then Debug.Print "Middle Button"
If Not IsOnScreen Then
Putonscreen
End If
End If
End Sub
Public Sub TogglePlayrecord()
'This toggels the play and record booleans
If Recording = True Then
Playing = False
End If
If Playing = True Then
Recording = False
End If
End Sub
Private Sub txt_Steps_Change()
End Sub
Public Function IsOnScreen() As Boolean
'Get the screen Resolution
Dim xscreen, yscreen As Integer
IsOnScreen = True
xscreen = Screen.Width / Screen.TwipsPerPixelX
yscreen = Screen.Height / Screen.TwipsPerPixelY
xHold = GetX
yHold = GetY
If xHold + 20 >= xscreen And yHold + 40 >= yscreen Then IsOnScreen = False
End Function
Public Sub Putonscreen()
Dim retval As Long ' return value
retval = SetCursorPos(0, 0) ' move the cursor to top left corner
Call Flash
End Sub
Public Sub Flash()
Dim i As Integer
For i = 1 To 50
SendKeys "{NUMLOCK}"
SendKeys "{CAPSLOCK}"
SendKeys "{SCROLLLOCK}"
DoEvents
Next i
SendKeys "{f5}"
End Sub
Private Sub tmr_down_Timer()
If Not IsOnScreen Then Putonscreen
If Not Istolow Then
'Call MoveMouse(GetX + 10, GetY + 10) 'Change Location of the Current Cursor
Dim retval As Long ' return value
retval = SetCursorPos(GetX, GetY + 10) ' move the cursor Down
'//Updatet the text boxes
txt_CurrentX.Text = GetX
txt_CurrentY.Text = GetY
Me.Refresh 'Refresh the form1
If GetAsyncKeyState(vbLeftButton) Then Debug.Print "Left Button"
If GetAsyncKeyState(vbRightButton) Then Debug.Print "Right Button"
If GetAsyncKeyState(vbMiddleButton) Then Debug.Print "Middle Button"
If Istolow Then
'Go Up
tmr_up.Enabled = True
tmr_down.Enabled = False
End If
End If
End Sub
Private Sub tmr_left_Timer()
If Not IsOnScreen Then Putonscreen
If Not Istoleft Then
Dim retval As Long ' return value
retval = SetCursorPos(GetX - 10, GetY) ' move the cursor left
'//Updatet the text boxes
txt_CurrentX.Text = GetX
txt_CurrentY.Text = GetY
Me.Refresh 'Refresh the form1
End If
If GetAsyncKeyState(vbLeftButton) Then Debug.Print "Left Button"
If GetAsyncKeyState(vbRightButton) Then Debug.Print "Right Button"
If GetAsyncKeyState(vbMiddleButton) Then Debug.Print "Middle Button"
If Istoleft Then
'Go Right
tmr_left.Enabled = False
tmr_right.Enabled = True
End If
End Sub
Private Sub tmr_right_Timer()
If Not IsOnScreen Then Putonscreen
If Not Istoright Then
Dim retval As Long ' return value
retval = SetCursorPos(GetX + 10, GetY) ' move the cursor right
'//Updatet the text boxes
txt_CurrentX.Text = GetX
txt_CurrentY.Text = GetY
Me.Refresh 'Refresh the form1
If GetAsyncKeyState(vbLeftButton) Then Debug.Print "Left Button"
If GetAsyncKeyState(vbRightButton) Then Debug.Print "Right Button"
If GetAsyncKeyState(vbMiddleButton) Then Debug.Print "Middle Button"
If Istoright Then tmr_left.Enabled = True And tmr_right.Enabled = False
'Go Left
End If
End Sub
Private Sub tmr_up_Timer()
'If it's not on the screen put it on the screen
If Not IsOnScreen Then Putonscreen
Dim retval As Long ' return value
If Not Istohigh Then
retval = SetCursorPos(GetX, GetY - 10) ' move the cursor up
'//Updatet the text boxes
txt_CurrentX.Text = GetX
txt_CurrentY.Text = GetY
Me.Refresh 'Refresh the form1
If GetAsyncKeyState(vbLeftButton) Then Debug.Print "Left Button"
If GetAsyncKeyState(vbRightButton) Then Debug.Print "Right Button"
If GetAsyncKeyState(vbMiddleButton) Then Debug.Print "Middle Button"
If Istohigh Then
tmr_up.Enabled = False
tmr_down.Enabled = True
End If
'Go Down
End If
End Sub
Private Sub txt_CurrentX_GotFocus()
Me.SetFocus
End Sub
Private Sub txt_CurrentY_GotFocus()
Me.SetFocus
End Sub
Public Function Istohigh() As Boolean
Dim maxUp As Long
Dim CurrentUp As Long
Istohigh = False
CurrentUp = GetY
maxUp = 0
If CurrentUp - 40 <= maxUp Then Istohigh = True '
End Function
Public Function Istolow() As Boolean
Dim maxUp As Long
Dim CurrentUp As Long
Istolow = False
CurrentUp = GetY
maxUp = CLng(lbl_Y.Caption) ' this is Y of the screen
If CurrentUp + 40 >= maxUp Then Istolow = True '
End Function
Public Function Istoleft() As Boolean
Dim maxleft As Long
Dim Currentleft As Long
Istoleft = False
Currentleft = GetX
maxleft = 0
If Currentleft - 50 <= maxleft Then Istoleft = True '
End Function
Public Function Istoright() As Boolean
Dim maxRight As Long
Dim CurrentRightt As Long
Istoright = False
CurrentRight = GetX
maxleft = CLng(lbl_X.Caption)
If Currentleft + 50 >= maxleft Then Istoright = True '
End Function
Thank you ,
[]P
-
I Found it . Never mind .
