Click here to download the project..
Click here to download the Exe..
Code:
Imports System.Drawing.Graphics
Public Class Form1
#Region "Declarations"
Const kDown As Integer = 0 'const used to represent the key down event
Const kRight As Integer = 1 'const used to represent the key right event
Const kUp As Integer = 2 'const used to represent the key up event
Const kLeft As Integer = 3 'const used to represent the key left event
Dim snake_pen As New Pen(Brushes.Green, 3) 'pen used to draw the snake on the form
Dim erase_pen As New Pen(Brushes.DarkOrange, 3) 'pen used to follow the snake and erase the end
Dim food_brush As New SolidBrush(Color.Red) 'used to paint the food on the form
Dim erase_brush As New SolidBrush(Color.DarkOrange) 'used to erase the food after collision
Dim x1, x2, y1, y2, xFood, yFood As Integer 'coordinates used during painting to the form
Dim currentKey As Integer = kRight 'used to determin direct of the snake
Dim lastKey As Integer 'helps prevent snake moving backwards
Dim iCount As Integer 'index of the coordinates traveled by the snake entered into arrays
Dim iErase As Integer 'helps erase the path traveled by the snake
Dim iPathX(100000) As Integer 'holds the x coordinates traveled by the snake
Dim iPathY(100000) As Integer 'holds the y coordinates traveled by the snake
Dim iScore As Integer = 0 'keeps the score
#End Region
#Region "Controls"
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
'This is the snake timer
'always checks for collision
Check_Collision()
'once the snake has some lenght to it, start the erase pen and place food
If iCount = 80 Then Timer2.Start() : PlaceFood()
'currentKey is set when a different arrow is pressed
Select Case currentKey
Case kDown
'if the snake isn't currently moving up then move down (prevents snake going backwards into itself)
If Not lastKey = kUp Then
y2 += 1
lastKey = kDown
Else
'if it's going up, then keep going up
y2 -= 1
lastKey = kUp
End If
Case kRight
'similar to kDown
If Not lastKey = kLeft Then
x2 += 1
lastKey = kRight
Else
x2 -= 1
lastKey = kLeft
End If
Case kLeft
'similar to kDown
If Not lastKey = kRight Then
x2 -= 1
lastKey = kLeft
Else
x2 += 1
lastKey = kRight
End If
Case kUp
'similar to kDown
If Not lastKey = kDown Then
y2 -= 1
lastKey = kUp
Else
y2 += 1
lastKey = kDown
End If
End Select
'paint the next point on the form
Me.CreateGraphics.DrawLine(snake_pen, x1, y1, x2, y2)
'set points to draw from next loop
x1 = x2
y1 = y2
'log the path into seperate arrays
iPathX(iCount) = x2
iPathY(iCount) = y2
'increaes the index
iCount += 1
End Sub
Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
'erase line
'moves behind the snake line at a specified distance.
Me.CreateGraphics.DrawLine(erase_pen, iPathX(iErase), iPathY(iErase), iPathX(iErase + 1), iPathY(iErase + 1))
iErase += 1
End Sub
Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyCode
Case Keys.Down
'prevents error when pressing arrow key twice
If Not lastKey = kDown Then currentKey = kDown
Case Keys.Up
If Not lastKey = kDown Then currentKey = kUp
Case Keys.Left
If Not lastKey = kLeft Then currentKey = kLeft
Case Keys.Right
If Not lastKey = kLeft Then currentKey = kRight
End Select
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'set initial values to start the line
x1 = 26
x2 = 25
y1 = 25
y2 = 25
End Sub
Private Sub mnuStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuStart.Click
'start the snake
Timer1.Start()
End Sub
Private Sub mnuLevel1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuLevel1.Click
'sets the level 1 settings
mnuLevel2.Checked = False
mnuLevel3.Checked = False
Timer1.Interval = 50
Timer2.Interval = 50
End Sub
Private Sub mnuLevel2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuLevel2.Click
'sets the level 2 settings
mnuLevel1.Checked = False
mnuLevel3.Checked = False
Timer1.Interval = 25
Timer2.Interval = 25
End Sub
Private Sub mnuLevel3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuLevel3.Click
'sets the level 3 settings
mnuLevel1.Checked = False
mnuLevel2.Checked = False
Timer1.Interval = 1
Timer2.Interval = 1
End Sub
Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
Application.Exit()
End Sub
Private Sub HighScoresToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles HighScoresToolStripMenuItem.Click
MessageBox.Show("1st: " & vbTab & My.Settings.first & vbNewLine & _
"2nd: " & vbTab & My.Settings.second & vbNewLine & _
"3rd: " & vbTab & My.Settings.third)
End Sub
#End Region
#Region "Subs"
Private Sub PlaceFood()
Dim rand As New Random
xFood = rand.Next(50, Me.Width - 50) 'generate random x value
yFood = rand.Next(50, Me.Height - 50) 'generate random y value
Dim food As New Rectangle(xFood, yFood, 6, 6) 'create the rectangle for the food
Me.CreateGraphics.FillRectangle(food_brush, food) 'paint the rectangle on the form
End Sub
Private Sub Check_Collision()
'if the coordinates are within 6 pixels in either direction then eat food
If (x2 <= xFood + 6 AndAlso x2 >= xFood) AndAlso (y2 <= yFood + 6 AndAlso y2 >= yFood) Then
iScore += 1
'create the rectangle to erase the food
Dim rErase As New Rectangle(xFood, yFood, 6, 6)
'erase the food
Me.CreateGraphics.FillRectangle(erase_brush, rErase)
'creates a bigger gap between the snake line and the erase line
iErase -= 25
Me.Text = "Current Score: " & iScore
'place the food again
PlaceFood()
End If
'loops through the snake that hasn't been erased
For i = iErase To iCount - 3
'if collision then game over
If x2 = iPathX(i) AndAlso y2 = iPathY(i) Then GameOver()
Next
'if the snake hits the form border then game over.
If y2 = 20 OrElse y2 = Me.Height - 30 Then GameOver()
If x2 = 0 OrElse x2 = Me.Width - 15 Then GameOver()
End Sub
Private Sub GameOver()
'stop the timers
Timer1.Stop() : Timer2.Stop()
MessageBox.Show("Game over! Your score was " & iScore & ".")
'set high scores
If iScore > My.Settings.first Then
My.Settings.third = My.Settings.second
My.Settings.second = My.Settings.first
My.Settings.first = iScore
ElseIf iScore > My.Settings.second Then
My.Settings.third = My.Settings.second
My.Settings.second = iScore
ElseIf iScore > My.Settings.third Then
My.Settings.third = iScore
End If
'erase the form
Refresh()
Me.Text = "SF Snake V1"
'reset values to start new game.
x1 = 25 : x2 = 25 : y1 = 25 : y2 = 25
iCount = 0 : iScore = 0 : iErase = 0
currentKey = kRight : lastKey = kRight
End Sub
#End Region
End Class