frmmain.frm

Joystick mode Joystick mode Joystick mode Joystick mode Joystick mode

VERSION 5.00
Begin VB.Form frmMain 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Dodge"
   ClientHeight    =   6840
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3390
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   456
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   226
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer 
      Interval        =   1
      Left            =   480
      Top             =   3360
   End
   Begin VB.Shape Box 
      FillColor       =   &H00E0E0E0&
      FillStyle       =   0  'Solid
      Height          =   975
      Left            =   2040
      Top             =   -240
      Width           =   495
   End
   Begin VB.Shape Ship 
      BorderColor     =   &H000000FF&
      FillColor       =   &H0080FFFF&
      FillStyle       =   0  'Solid
      Height          =   735
      Left            =   1320
      Shape           =   5  'Rounded Square
      Top             =   6000
      Width           =   615
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long

Dim Boosts As Long  'Press 1,3,5,7,9, ect to boost left
                    'Press 0,2,4,6,8, ect to boost right

Dim Score As Long
Private Sub Form_Load()
Randomize
Boosts = 4
If Not StartJoystick Then
    MsgBox "No joystick!"
    End
End If
End Sub

Private Sub Timer_Timer()
Dim BoxRECT As RECT
Dim ShipRECT As RECT
Dim TempRECT As RECT
Dim i As Long
Dim FailedBoost As Boolean
Static Boosted As Boolean

'Move box
Box.Top = Box.Top + 20 + Fix(Score / 1)
If Box.Top > Me.ScaleHeight Then
    Box.Top = 0 - Box.Height - 5
    Box.Left = Rnd * (Me.ScaleWidth - Box.Width)
    Score = Score + 1
End If

'Gather Input
PollJoystick

If CurrentJoyX > CenterX Then
    Ship.Left = Ship.Left + 5
ElseIf CurrentJoyX < CenterX Then
    Ship.Left = Ship.Left - 5
End If

'Boosts
If (Boosts > 0) And (Boosted = False) Then
    For i = 1 To 15 Step 2
        If JoyButtons(i) = True Then
            Ship.Left = Ship.Left + 40
            Boosts = Boosts - 1
            Boosted = True
        End If
    Next i
    For i = 0 To 14 Step 2
        If JoyButtons(i) = True Then
            Ship.Left = Ship.Left - 40
            Boosts = Boosts - 1
            Boosted = True
        End If
    Next i
End If
For i = 0 To 15
    FailedBoost = FailedBoost Or JoyButtons(i)
Next i
Boosted = FailedBoost

Me.Caption = "Dodge - Boosts: " & Boosts

If Ship.Left < 0 Then Ship.Left = 0
If Ship.Left > Me.ScaleWidth - Ship.Width Then Ship.Left = Me.ScaleWidth - Ship.Width

'Check for collision
BoxRECT.Left = Box.Left
BoxRECT.Top = Box.Top
BoxRECT.Right = Box.Left + Box.Width
BoxRECT.Bottom = Box.Top + Box.Height

ShipRECT.Left = Ship.Left
ShipRECT.Top = Ship.Top
ShipRECT.Right = Ship.Left + Ship.Width
ShipRECT.Bottom = Ship.Top + Ship.Height

If IntersectRect(TempRECT, BoxRECT, ShipRECT) > 0 Then
    MsgBox "GAME OVER!" & vbCrLf & vbCrLf & "Score: " & Score, vbCritical, "Dodge"
    End
End If
End Sub