[VB6] Snake game source code

[plenderj]

The source code to the snake game is enclosed.

Originally called nibbles.bas for QBASIC bundled with DOS, then disappeared for a while, and found its way back into our lives as Snake on the Nokia 3210 mobile phone, and then Snake II in newer versions of the mobile.

If you have any queries on the source code, or any comments or suggestions, just Private Message (http://www.vbforums.com/private.php?s=&action=newmessage&userid=14016) or e-mail (http://www.vbforums.com/member.php?s=&action=mailform&userid=14016) me

[plenderj]

* 21-October-2004 - Moved to CodeBank *

[Hack]

*10-February-2006-Moved to Games CodeBank*

[KPS.]

im like this is there a way to put a score in?

[plenderj]

I'll have a look at the source code later... I can't remember how I wrote it, but whenever the snake hits a piece of 'fruit', you could use whatever code that fires there to do it perhaps?

[KPS.]

thats sort of wot i thought but i couldnt see that bit if you could point it out i can take it from there

[shakti5385]

can we slow down the snake speed

[Rich2189]

can we slow down the snake speed

Change this var at the top of form1



Private Const vbGameSpeed As Long = 50



and I would imagine if you wanted a score then stick a counter here


If gotBonus Then

[plenderj]

Thanks ;)

[shakti5385]

Change this var at the top of form1 ]

Thanks..........

[raouf505]

Thank you

[plenderj]

You're welcome :)

[Lord Orwell]

edit:
i have a games contest submission in dx7 for vb6 based on wormy, and there's a .net codebank game now.

[palmera]

Thanks for the game its really working....

__________________

[OT²O]

I have a problem, in the third sub "AutoRedraw" in undeclared. How should this variable be declared?
Option Strict Off
Option Explicit On
Imports Microsoft.VisualBasic.PowerPacks
Friend Class Form1
Inherits System.Windows.Forms.Form
'
' Snake
'
' By Jamie Plenderleith
' plenderj@tcd.ie
' http://www.coolground.com/plenderj
'



Private Const vbGameSpeed As Integer = 50

Private Const vbBackground As Integer = &HC0E0FF
'UPGRADE_NOTE: vbGridColour was changed from a Constant to a Variable. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="C54B49D7-5804-4D48-834B-B3D81E4C2F13"'
Private vbGridColour As Integer = System.Drawing.ColorTranslator.ToOle(System.Drawing.Color.Black)
'UPGRADE_NOTE: vbWallColour was changed from a Constant to a Variable. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="C54B49D7-5804-4D48-834B-B3D81E4C2F13"'
Private vbWallColour As Integer = System.Drawing.ColorTranslator.ToOle(System.Drawing.Color.Red)
'UPGRADE_NOTE: vbBonusColour was changed from a Constant to a Variable. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="C54B49D7-5804-4D48-834B-B3D81E4C2F13"'
Private vbBonusColour As Integer = System.Drawing.ColorTranslator.ToOle(System.Drawing.Color.Blue)
'UPGRADE_NOTE: vbSnakeColour was changed from a Constant to a Variable. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="C54B49D7-5804-4D48-834B-B3D81E4C2F13"'
Private vbSnakeColour As Integer = System.Drawing.ColorTranslator.ToOle(System.Drawing.Color.Lime)



Private facingUp, doLoop, gotBonus, facingDown As Boolean
Private facingLeft, facingRight As Boolean
Private lastTickCount As Integer
Private occupiedSquares() As Integer
Private Declare Function GetTickCount Lib "kernel32" () As Integer


Private Sub Form1_KeyDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
Dim KeyCode As Short = eventArgs.KeyCode
Dim Shift As Short = eventArgs.KeyData \ &H10000
Select Case KeyCode
Case System.Windows.Forms.Keys.Left
If facingRight Then Exit Sub
facingLeft = True : facingRight = False : facingUp = False : facingDown = False
Case System.Windows.Forms.Keys.Right
If facingLeft Then Exit Sub
facingRight = True : facingLeft = False : facingUp = False : facingDown = False
Case System.Windows.Forms.Keys.Up
If facingDown Then Exit Sub
facingUp = True : facingDown = False : facingLeft = False : facingRight = False
Case System.Windows.Forms.Keys.Down
If facingUp Then Exit Sub
facingDown = True : facingUp = False : facingLeft = False : facingRight = False
End Select
End Sub


Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Dim i As Integer : BackColor = System.Drawing.ColorTranslator.FromOle(vbGridColour) : box(0).BackColor = System.Drawing.ColorTranslator.FromOle(vbBackground)
'UPGRADE_ISSUE: Form property Form1.AutoRedraw was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
AutoRedraw = True : loadBoard() : facingDown = True : ReDim occupiedSquares(4)
For i = 0 To 4
occupiedSquares(i) = 50 + (5 - i)
box(occupiedSquares(i)).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
Next
Me.Show() : Activate() : doGameLoop()
End Sub


Private Sub addBonus()
Dim n As Integer
lblRetry:
n = (Int((1560 - 39 + 1) * Rnd() + 39))
If (System.Drawing.ColorTranslator.ToOle(box(n).BackColor) = vbWallColour) Or (System.Drawing.ColorTranslator.ToOle(box(n).BackColor) = vbSnakeColour) Then GoTo lblRetry
box(n).BackColor = System.Drawing.ColorTranslator.FromOle(vbBonusColour)
End Sub


Private Sub loadBoard()
Dim i As Integer
For i = 1 To 1599
box.Load(i)
With box(i)
'UPGRADE_WARNING: Shape method box.Move has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
.SetBounds(9 + (Int((i Mod 40) * .Width)), 9 + (Int(i / 40) * .Height), .Width, .Height)
.Visible = True
End With
Next
For i = 0 To 1599
If (i <= 39) Or (i >= 1560) Then box(i).BackColor = System.Drawing.ColorTranslator.FromOle(vbWallColour)
If (i Mod 40) = 0 Then box(i).BackColor = System.Drawing.ColorTranslator.FromOle(vbWallColour)
If (i Mod 40) = 39 Then box(i).BackColor = System.Drawing.ColorTranslator.FromOle(vbWallColour)
Next
addBonus()
End Sub



Private Sub doGameLoop()
doLoop = True
Do While doLoop
System.Windows.Forms.Application.DoEvents()
If (GetTickCount - lastTickCount) >= vbGameSpeed Then
lastTickCount = GetTickCount
Select Case True
Case facingUp
If (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) - 40).BackColor) = vbWallColour) And (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) - 40).BackColor) = vbSnakeColour) Then
If Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) - 40).BackColor) = vbBonusColour Then
doodleBackSquare()
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) - 40).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
shiftDownArray(occupiedSquares, occupiedSquares(0) - 40)
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
addBonus()
End If
Else
doLoop = False
doDead()
End If
Case facingDown
If (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) + 40).BackColor) = vbWallColour) And (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) + 40).BackColor) = vbSnakeColour) Then
If Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) + 40).BackColor) = vbBonusColour Then
doodleBackSquare()
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) + 40).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
shiftDownArray(occupiedSquares, occupiedSquares(0) + 40)
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
addBonus()
End If
Else
doLoop = False
doDead()
End If
Case facingLeft
If (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) - 1).BackColor) = vbWallColour) And (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) - 1).BackColor) = vbSnakeColour) Then
If Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) - 1).BackColor) = vbBonusColour Then
doodleBackSquare()
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) - 1).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
shiftDownArray(occupiedSquares, occupiedSquares(0) - 1)
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
addBonus()
End If
Else
doLoop = False
doDead()
End If
Case facingRight
If (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) + 1).BackColor) = vbWallColour) And (Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) + 1).BackColor) = vbSnakeColour) Then
If Not System.Drawing.ColorTranslator.ToOle(box(occupiedSquares(0) + 1).BackColor) = vbBonusColour Then
doodleBackSquare()
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) + 1).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
shiftDownArray(occupiedSquares, occupiedSquares(0) + 1)
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).BackColor = System.Drawing.ColorTranslator.FromOle(vbSnakeColour)
addBonus()
End If
Else
doLoop = False
doDead()
End If
End Select
End If
Loop
End Sub


Private Sub doodleBackSquare()
box(occupiedSquares(UBound(occupiedSquares))).BackColor = System.Drawing.ColorTranslator.FromOle(vbBackground)
End Sub


Private Sub shiftDownArray(ByRef arr() As Integer, ByVal newTopIndexValue As Integer)
Dim i As Integer
Dim x() As Integer : x = VB6.CopyArray(arr)
For i = 1 To UBound(arr)
arr(i) = x(i - 1)
Next
arr(0) = newTopIndexValue
End Sub


Private Sub doDead()
MsgBox("Oh boo-hoo you're dead.", MsgBoxStyle.Critical Or MsgBoxStyle.OKOnly, "Snake")
End
End Sub


Private Sub Form1_FormClosed(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
doLoop = False
End
End Sub
End Class

[Lord Orwell]

I have a problem, in the third sub "AutoRedraw" in undeclared. How should this variable be declared?

you can't upgrade any vb6 programs using the upgrade tool if they do any kind of drawing at all. All drawing code has to go into a paint event that is triggered by a form refresh. Autoredraw is not a variable. It is a property of a vb6 form. You will notice that this project said clearly it is for vb6. If you want a net equivalent, i suggest you search codebank for my submission.

edit: here is the url
http://www.vbforums.com/showthread.php?t=524940

[vbs19]

Any way of opening this using visual studio 2010??
Many thanks Dan

[Lord Orwell]

Any way of opening this using visual studio 2010??
Many thanks Dan

no. Read my previous post. If you want to dabble in 2010, check codebank. I have a mostly complete tutorial in there for writing a game step by step exactly like this one. I don't have sound or levels yet but you can see how to draw on the screen, do keypress input, etc, and food eating and collision work.

[vandallist]

love this game :)

[kyuso]

and I would imagine if you wanted a score then stick a counter here


If gotBonus Then


Ive read all the code and tough the same but i seem i cant get that too work anyone could help me with that?
Im still pretty newbie to Visual basic so maybe i doing something wrong.
(im really new XD)