Results 1 to 2 of 2

Thread: Bunch O Timers - Moving Objects - Bounce off screen Edge

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 2000
    Posts
    258
    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
    Visual Basic 6 SP4 on win98se

    QUIT THE RAT RACE BECAUSE YOUR MESSING THE WORLD UP !!!!!

  2. #2

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 2000
    Posts
    258
    I Found it . Never mind .
    Visual Basic 6 SP4 on win98se

    QUIT THE RAT RACE BECAUSE YOUR MESSING THE WORLD UP !!!!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width