A Fun Game (~*- Tunnel Racer -*~) Racing Game

Email
 Submitted on: 1/10/2015 10:52:00 PM By: Jason Ryczek (from psc cd) Level: Beginner User Rating: By 9 Users Compatibility: VB 5.0, VB 6.0 Views: 742

This is the first version of this code and will be updated a lot since this is my first version and I couldn't figure out how to do some stuff. Please email me with better ideas! In this game the walls get closer together every half second, and so far, you don't race anyone, you just try not to hit the walls. Make sure you put in 2 timers and oen picturebox that you will name picTrack. Have fun!

code:
Can't Copy and Paste this?
 ``` '************************************** ' Name: A Fun Game (~*- Tunnel Racer -*~)Racing Game ' Description:This is the first version of this code and will be updated a lot since this is my first version and I couldn't figure out how to do some stuff. Please email me with better ideas! In this game the walls get closer together every half second, and so far, you don't race anyone, you just try not to hit the walls. Make sure you put in 2 timers and oen picturebox that you will name picTrack. Have fun! ' By: Jason Ryczek (from psc cd) '************************************** '-This program needs: '-Timer1 '-Timer2 '-PictureBox - picTrack '-That should do it!!! Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Dim lx(0 To 250) As Long, rx(0 To 250) As Long '-Right and Left Sides Dim y(0 To 250) As Long Dim cX As Long '-Car X Dim Speed As Long '-The speed Dim SideMove As Integer '-The sides move right/left Dim Width_Amount As Long '-Distance apart between walls Dim Score As Long '-The score Sub Cycle() Dim a As Integer For a = 250 To 1 Step -1 lx(a) = lx(a - 1) lx(0) = ((150 - Width_Amount) / 2) + SideMove rx(a) = rx(a - 1) rx(0) = lx(0) + Width_Amount Next a End Sub Sub SidesChange() SideMove = SideMove + Round((Rnd * 2), 1) - 1 If SideMove > 100 Then SideMove = 100 If SideMove < 5 Then SideMove = 5 End Sub Private Sub Form_Load() Me.Caption = "Tunnel Racer By Jason Ryczek" Me.ScaleMode = 3 Me.Height = 4155 Me.Width = 5370 Me.AutoRedraw = True Me.ClipControls = False picTrack.Top = 0 picTrack.Left = 75 picTrack.Height = 250 picTrack.Width = 200 picTrack.ScaleMode = 3 picTrack.AutoRedraw = True picTrack.ClipControls = False picTrack.BorderStyle = 0 picTrack.Appearance = 0 Timer1.Interval = 1 Timer2.Interval = 500 Timer2.Enabled = True New_Game End Sub Private Sub picTrack_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyUp '-speed up Speed = Speed + 1 If Speed > 50 Then Speed = 50 Case vbKeyDown '-slow down Speed = Speed - 1 If Speed < 5 Then Speed = 5 Case vbKeyRight '-Move car right cX = cX + 2 Case vbKeyLeft cX = cX - 2 Case vbKeyP If Timer1.Enabled = True Then Timer1.Enabled = False Else Timer1.Enabled = True End If End Select Timer1.Interval = 51 - Speed End Sub Private Sub Timer1_Timer() Dim a As Integer, b As Integer Cycle SidesChange picTrack.Cls Me.Cls Me.Print "Speed:" & Speed Me.Print "Score:" & Score Me.Print "=============" Me.Print "Use the Arrow" Me.Print "Keys to Move" Me.Print " p - pause" Me.Print "=============" For a = 1 To 250 Step 1 rx(a) = lx(a) + Width_Amount picTrack.Line (0, a)-(10 + lx(a), a), RGB(0, 100 + (155 * Rnd), 0) picTrack.Line (lx(a), a)-(lx(a) + Width_Amount, a) picTrack.Line (rx(a), a)-(200, a), RGB(0, 100 + (155 * Rnd), 0) picTrack.PSet (lx(a) + (Width_Amount / 2), a), vbYellow Next a CarDraw cX '-This draws the car HitWall cX '-This checks to see if the car hit the wall Score = Score + 1 End Sub Sub CarDraw(ByVal CarX As Long) Dim gc As Integer gc = Rnd * 255 picTrack.Line (CarX - 5, 215)-(CarX + 5, 235), vbRed, BF picTrack.Line (CarX - 5, 215)-(CarX - 2, 215), vbYellow picTrack.Line (CarX + 5, 215)-(CarX + 2, 215), vbYellow picTrack.Line (CarX - 2, 225)-(CarX + 2, 230), vbBlack, BF picTrack.Line (CarX - 2, 224)-(CarX + 2, 225), vbBlue, B picTrack.Circle (CarX + (Rnd * 1) + 1, 236), 1, RGB(gc, gc, gc) picTrack.Circle (CarX + (Rnd * 1) + 1, 238), 1, RGB(gc, gc, gc) picTrack.Circle (CarX - (Rnd * 1) + 1, 240), 1, RGB(gc, gc, gc) picTrack.Circle (CarX + (Rnd * 1) + 1, 242), 1, RGB(gc, gc, gc) End Sub Sub HitWall(ByVal CarX As Long) Dim a As Integer, b As Long, d As Integer Dim gc As Integer gc = 255 * Rnd Dim cX(0 To 25) As Long, cy(0 To 5) As Long If (CarX - 5 <= lx(215)) Or ((CarX + 5) >= rx(215)) Then For d = 0 To 5 Step 1 cX(d) = ((CarX - 5) + (Rnd * 15)) cy(d) = (215 + (Rnd * 20)) picTrack.Circle (cX(d), cy(d)), ((Rnd * 4) + 1), RGB(gc, gc, gc) Next d Timer1.Enabled = False Me.Print "You Crashed!!!" New_Game End If End Sub Sub New_Game() MsgBox "Ready, Set, Go!" Dim a As Integer Width_Amount = 150 cX = picTrack.Width / 2 Score = 0 Speed = 25 SideMove = 25 For a = 0 To 250 lx(a) = (24 + (Rnd * 1)) rx(a) = lx(a) + Width_Amount Next a Timer1.Enabled = True End Sub Private Sub Timer2_Timer() Width_Amount = Width_Amount - 1 End Sub ```

Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)

There are no comments on this submission.

Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)