[VB6] Snake game source code

**plenderj** · Apr 2nd, 2002, 02:22 AM

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

**plenderj** · Oct 21st, 2004, 08:46 AM

* 21-October-2004 - Moved to CodeBank *

**Hack** · Feb 10th, 2006, 09:11 AM

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

**KPS.** · Jun 25th, 2006, 09:07 AM

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

**plenderj** · Jun 25th, 2006, 11:06 AM

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.** · Jun 25th, 2006, 11:55 AM

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** · Jul 18th, 2006, 05:33 AM

can we slow down the snake speed

**Rich2189** · Jul 19th, 2006, 08:12 AM

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

**plenderj** · Jul 19th, 2006, 08:21 AM

Thanks

**shakti5385** · Jul 20th, 2006, 01:02 AM

Change this var at the top of form1

]

Thanks..........

**raouf505** · May 19th, 2007, 12:01 AM

Thank you

**plenderj** · May 19th, 2007, 06:27 AM

You're welcome

**Lord Orwell** · Jul 26th, 2007, 02:12 PM

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

**palmera** · Dec 21st, 2009, 02:21 AM

Thanks for the game its really working....

__________________

**OT²O** · May 4th, 2010, 12:45 PM

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
	' 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** · May 5th, 2010, 05:23 AM

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

**vbs19** · Feb 21st, 2011, 02:39 PM

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

**Lord Orwell** · Feb 21st, 2011, 07:53 PM

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.

**vandallist** · Mar 7th, 2011, 02:02 AM

love this game

**kyuso** · Apr 9th, 2011, 02:49 PM

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)

Thread: [VB6] Snake game source code

Thread Tools

Display

[VB6] Snake game source code

Re: Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Re: [VB6] Snake game source code

Posting Permissions