[VB6] Snake game source code

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 or e-mail me

* 21-October-2004 - Moved to CodeBank *

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

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

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?

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

can we slow down the snake speed

Quote:

---

Originally Posted by shakti5385

can we slow down the snake speed

---

Change this var at the top of form1

Code:

---


Private Const vbGameSpeed As Long = 50

---

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

Code:

---

If gotBonus Then

---

Thanks ;)

Quote:

---

Change this var at the top of form1

---

]

Thanks..........

Thank you

You're welcome :)

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

Thanks for the game its really working....

__________________

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

Code:

---

Option Strict Off
Option Explicit On
Imports Microsoft.VisualBasic.PowerPacks
Friend Class Form1
        Inherits System.Windows.Forms.Form
        '
        ' Snake
        '
        ' By Jamie Plenderleith
        ' [email protected]
        ' 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

---

Quote:

---

Originally Posted by OT²O

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

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

Quote:

---

Originally Posted by vbs19

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.

love this game :)

Quote:

---

Originally Posted by Rich2189

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

Code:

---

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)