# Snake Game - within worksheet - cells as pixels

Since my rather mediocre attempt at making a Space Invaders game, I stumbled on a cache of Visual Basic for Applications games written by Japanese excel wizards. I have even seen someone create Zelda?! What an inspiration! Making complete, beautiful, fun arcade / GameBoy style games inside of an Excel spreadsheet is possible.

This is my first crack at recreating the old game Snake.

Classes:

Snake Part:

Option Explicit

Private Type Properties
row As Long
column As Long
End Type

Private this As Properties

Public Property Let row(ByVal value As Long)
this.row = value
End Property

Public Property Get row() As Long
row = this.row
End Property

Public Property Let column(ByVal value As Long)
this.column = value
End Property

Public Property Get column() As Long
column = this.column
End Property

Public Sub PropertiesSet(ByVal row As Long, ByVal column As Long)
this.row = row
this.column = column
End Sub


TimerWin64:

Option Explicit

Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LongInteger) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LongInteger) As Long

Private Type LongInteger
First32Bits As Long
Second32Bits As Long
End Type

Private Type TimerAttributes
CounterInitial As Double
CounterNow As Double
PerformanceFrequency As Double
End Type

Private Const MaxValue_32Bits = 4294967296#
Private this As TimerAttributes

Private Sub Class_Initialize()
PerformanceFrequencyLet
End Sub

Private Sub PerformanceFrequencyLet()
Dim TempFrequency As LongInteger
QueryPerformanceFrequency TempFrequency
this.PerformanceFrequency = ParseLongInteger(TempFrequency)
End Sub

Public Sub TimerSet()
Dim TempCounterIntital As LongInteger
QueryPerformanceCounter TempCounterIntital
this.CounterInitial = ParseLongInteger(TempCounterIntital)
End Sub

Public Function CheckQuarterSecondPassed() As Boolean
CounterNowLet
If ((this.CounterNow - this.CounterInitial) / this.PerformanceFrequency) >= 0.25 Then
CheckQuarterSecondPassed = True
Else
CheckQuarterSecondPassed = False
End If
End Function

Public Function CheckFiveSecondsPassed() As Boolean
CounterNowLet
If ((this.CounterNow - this.CounterInitial) / this.PerformanceFrequency) >= 10 Then
CheckFiveSecondsPassed = True
Else
CheckFiveSecondsPassed = False
End If
End Function

Public Sub PrintTimeElapsed()
CounterNowLet
If CounterInitalIsSet = True Then
Dim TimeElapsed As Double
TimeElapsed = (this.CounterNow - this.CounterInitial) / this.PerformanceFrequency
Debug.Print Format(TimeElapsed, "0.000000"); " seconds elapsed "

Dim TicksElapsed As Double
TicksElapsed = (this.CounterNow - this.CounterInitial)
Debug.Print Format(TicksElapsed, "#,##0"); " ticks"
End If
End Sub

Private Function CounterNowLet()
Dim TempTimeNow As LongInteger
QueryPerformanceCounter TempTimeNow
this.CounterNow = ParseLongInteger(TempTimeNow)
End Function

Private Function CounterInitalIsSet() As Boolean
If this.CounterInitial = 0 Then
MsgBox "Counter Initial Not Set"
CounterInitalIsSet = False
Else
CounterInitalIsSet = True
End If
End Function

Private Function ParseLongInteger(ByRef LongInteger As LongInteger) As Double
Dim First32Bits As Double
First32Bits = LongInteger.First32Bits

Dim Second32Bits As Double
Second32Bits = LongInteger.Second32Bits

If First32Bits < 0 Then First32Bits = First32Bits + MaxValue_32Bits
If Second32Bits < 0 Then Second32Bits = First32Bits + MaxValue_32Bits

ParseLongInteger = First32Bits + (MaxValue_32Bits * Second32Bits)
End Function


Worksheet Code:

Option Explicit

Public Enum Direction
North = 1
South = 2
East = 3
West = 4
End Enum

Public ws As Worksheet
Public snakeParts As Collection
Public currentRow As Long
Public currentColumn As Long
Public directionSnake As Direction

Sub RunGame()
Set ws = ActiveWorkbook.Sheets("Game")
Set snakeParts = New Collection

Dim gameOver As Boolean
gameOver = False

Dim TimerGame As TimerWin64
Set TimerGame = New TimerWin64

Dim TimerBlueSquare As TimerWin64
Set TimerBlueSquare = New TimerWin64

Dim TimerYellowSquare As TimerWin64
Set TimerYellowSquare = New TimerWin64

Dim SnakePartNew As snakepart
Set SnakePartNew = New snakepart

GameBoardReset
DirectionSnakeInitialize
StartPositionInitalize
StartGameBoardInitalize
TimerGame.TimerSet
TimerBlueSquare.TimerSet
TimerYellowSquare.TimerSet

ws.cells(currentRow, currentColumn).Select
Do While gameOver = False
If TimerGame.CheckQuarterSecondPassed = True Then
CurrentCellUpdate
ws.cells(currentRow, currentColumn).Select
If SnakePartOverlapItself(currentRow, currentColumn) = True Then
gameOver = True
Exit Do
ElseIf SnakePartYellowSquareOverlap = True Then
gameOver = True
Exit Do
ElseIf SnakePartBlueSquareOverlap = True Then
Call SnakePartRemove
ws.cells(currentRow, currentColumn).Select
TimerGame.TimerSet
Else
Call SnakePartRemove
ws.cells(currentRow, currentColumn).Select
TimerGame.TimerSet
End If
End If

If TimerBlueSquare.CheckFiveSecondsPassed = True Then
TimerBlueSquare.TimerSet
End If

If TimerYellowSquare.CheckFiveSecondsPassed = True Then
TimerYellowSquare.TimerSet
End If
gameOver = OutOfBounds
DoEvents
Loop
End Sub

Private Sub GameBoardReset()
ws.cells.Interior.Color = RGB(300, 300, 300)
End Sub

Private Sub DirectionSnakeInitialize()
directionSnake = East
End Sub

Private Sub StartPositionInitalize()
currentRow = 96
currentColumn = 64
End Sub

Private Sub StartGameBoardInitalize()
End Sub

Private Sub SnakePartAdd(ByVal row As Long, ByVal column As Long)
Dim SnakePartNew As snakepart
Set SnakePartNew = New snakepart
SnakePartNew.PropertiesSet row, column
End Sub

Private Sub SnakePartAddToCollection(ByRef snakepart As snakepart)
End Sub

Private Sub SnakePartAddToGameBoard(ByRef snakepart As snakepart)
ws.cells(snakepart.row, snakepart.column).Interior.Color = RGB(0, 150, 0)
End Sub

Private Sub SnakePartRemove()
SnakePartRemoveFromGameBoard
SnakePartRemoveFromCollection
End Sub

Private Sub SnakePartRemoveFromCollection()
snakeParts.Remove 1
End Sub

Private Sub SnakePartRemoveFromGameBoard()
ws.cells(snakeParts.Item(1).row, snakeParts.Item(1).column).Interior.Color = RGB(300, 300, 300)
End Sub

Private Function OutOfBounds() As Boolean
If currentRow < 9 Or _
currentRow > 189 Or _
currentColumn < 21 Or _
currentColumn > 108 Then
OutOfBounds = True
MsgBox "GameOver"
Else
OutOfBounds = False
End If
End Function

Private Function SnakePartOverlapItself(ByVal row As Long, ByVal column As Long) As Boolean
If ws.cells(row, column).Interior.Color = RGB(0, 150, 0) Then
MsgBox "GameOver"
SnakePartOverlapItself = True
Else
SnakePartOverlapItself = False
End If
End Function

Dim TopLeftCornerRow As Long
Dim TopLeftCornerColumn As Long

TopLeftCornerRow = Application.WorksheetFunction.RandBetween(9, 189)
TopLeftCornerColumn = Application.WorksheetFunction.RandBetween(21, 108)

ws.cells(TopLeftCornerRow, TopLeftCornerColumn).Interior.Color = RGB(0, 0, 150)
ws.cells(TopLeftCornerRow, TopLeftCornerColumn + 1).Interior.Color = RGB(0, 0, 150)
ws.cells(TopLeftCornerRow + 1, TopLeftCornerColumn).Interior.Color = RGB(0, 0, 150)
ws.cells(TopLeftCornerRow + 1, TopLeftCornerColumn + 1).Interior.Color = RGB(0, 0, 150)
End Sub

Private Function SnakePartBlueSquareOverlap() As Boolean
If ws.cells(currentRow, currentColumn).Interior.Color = RGB(0, 0, 150) Then
SnakePartBlueSquareOverlap = True
Else
SnakePartBlueSquareOverlap = False
End If
End Function

Dim TopLeftCornerRow As Long
Dim TopLeftCornerColumn As Long

TopLeftCornerRow = Application.WorksheetFunction.RandBetween(9, 189)
TopLeftCornerColumn = Application.WorksheetFunction.RandBetween(21, 108)

ws.cells(TopLeftCornerRow, TopLeftCornerColumn).Interior.Color = RGB(255, 140, 0)
ws.cells(TopLeftCornerRow, TopLeftCornerColumn + 1).Interior.Color = RGB(255, 140, 0)
ws.cells(TopLeftCornerRow + 1, TopLeftCornerColumn).Interior.Color = RGB(255, 140, 0)
ws.cells(TopLeftCornerRow + 1, TopLeftCornerColumn + 1).Interior.Color = RGB(255, 140, 0)
End Sub

Private Function SnakePartYellowSquareOverlap() As Boolean
If ws.cells(currentRow, currentColumn).Interior.Color = RGB(255, 140, 0) Then
MsgBox "GameOver"
SnakePartYellowSquareOverlap = True
Else
SnakePartYellowSquareOverlap = False
End If
End Function

Private Sub CurrentCellUpdate()
Select Case directionSnake
Case Is = Direction.North
currentRow = currentRow - 1
Case Is = Direction.South
currentRow = currentRow + 1
Case Is = Direction.East
currentColumn = currentColumn + 1
Case Is = Direction.West
currentColumn = currentColumn - 1
End Select
End Sub

Private Sub SnakeCollectionUpdate(ByRef snakeParts As Collection)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'rowSwitch
If directionSnake = East Or directionSnake = West Then
If Target.column = currentColumn Then
If Target.row <> currentRow Then
If Target.row = currentRow - 1 Then
directionSnake = North
ElseIf Target.row = currentRow + 1 Then
directionSnake = South
End If
End If
End If
End If

'columnSwitch
If directionSnake = North Or directionSnake = South Then
If Target.row = currentRow Then
If Target.column <> currentColumn Then
If Target.column = currentColumn + 1 Then
directionSnake = East
ElseIf Target.column = currentColumn - 1 Then
directionSnake = West
End If
End If
End If
End If
End Sub


I could take this as a not-so-subtle reminder that I need to finish my Excel Tetris implementation... :-P

I am a little curious why you seem to have abandoned the OOP approach since your last game - this code is completely procedural (the presence of classes doesn't mean that it's object oriented).

A discussion of the architecture would basically entail a top-down re-write, so I'll leave that for other reviewers.

## Indentation

This is, well, ...weird. I initially thought it was simply a markdown problem in the question itself, but as I went through the code further, it seems more and more intentional. Why are your procedures creeping to the right? I originally thought that it had something to do with the scope, (Public members indented one level, Private two), but that doesn't jive with this:

Private this As TimerAttributes

Private Sub Class_Initialize()
PerformanceFrequencyLet
End Sub

Private Sub PerformanceFrequencyLet()
Dim TempFrequency As LongInteger
QueryPerformanceFrequency TempFrequency
this.PerformanceFrequency = ParseLongInteger(TempFrequency)
End Sub

Public Sub TimerSet()
Dim TempCounterIntital As LongInteger
QueryPerformanceCounter TempCounterIntital
this.CounterInitial = ParseLongInteger(TempCounterIntital)
End Sub


This is incredibly distracting, and is completely "non-standard" (I've never seen this done in any language). The last thing you want when somebody else is looking at your code is to distract them with the formatting. It's also generally meaningless in that I can just look at the access modifier (assuming it has something to do with scope). My brain is telling me that I'm in a procedure when I'm not, and it was disorienting to the point that I had to run an indenter on this before I continued the review.

## API Functions

Your declarations of QueryPerformanceCounter and QueryPerformanceFrequency are incorrect. From the documentation of QueryPerformanceCounter, it is defined as:

BOOL WINAPI QueryPerformanceCounter(
_Out_ LARGE_INTEGER *lpPerformanceCount
);


Furthermore, the documentation states "On systems that run Windows XP or later, the function will always succeed and will thus never return zero", so unless you are intending to support pre-XP versions of Windows (which would likely require a pre-compile directive to get rid of the PtrSafe keyword anyway), this can simply be declared as a Sub. The same applies to QueryPerformanceFrequency:

BOOL WINAPI QueryPerformanceFrequency(
_Out_ LARGE_INTEGER *lpFrequency
);


You are also never checking the return value anyway, so if you're using them as Sub's (discarding the otherwise deterministic return value), declare them as a Sub's:

Private Declare PtrSafe Sub QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As LongInteger)
Private Declare PtrSafe Sub QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As LongInteger)


Note that I've also explicitly declared the parameters ByRef. I'd get in the habit of doing this for out parameters of API declarations because it makes the usage clear without consulting the documentation.

Your LongInteger struct is also misleadingly named, in that a "long int" has a different meaning when you're thinking in API terms. It means "at least 32 bits". This is why the LARGE_INTEGER struct exists (it's technically a union). I'd use the API naming and simply call it a LargeInteger to avoid confusion. I'll propose what I'd consider a better option below.

The ParseLongInteger function performs so much work to handle the unsigned low DWORD that makes me wonder if it's really worth using at all for the additional resolution that it provides. The maximum resolution you require is quarter-second accuracy. On top of that, you're performing a fairly dirty cast when you coerce the value into a Double in order to handle the return value on a 32-bit machine (it's a simple LongLong in 64-bit Office). If you intend to support both platforms, I'd suggest going simple and using GetTickCount and GetTickCount64 (conditionally compiled) instead. Or, you could use a game loop similar to what I suggested on your Space Invader Style Game question.

## Procedure Signatures

You have functions with no return values, such as this one:

Private Function CounterNowLet()
Dim TempTimeNow As LongInteger
QueryPerformanceCounter TempTimeNow
this.CounterNow = ParseLongInteger(TempTimeNow)
End Function


This always returns Empty, and the "return value" is never checked. You're using it like it's a Sub, so declare it as a Sub. As it stands now, it appears to be a bug even though it isn't.

Sub RunGame() is missing an access modifier. You have them explicitly defined elsewhere, and this is implicitly public. Make it explicit.

You're requiring passing module level variables around as arguments all over the place in the worksheet, i.e.

Private Function SnakePartOverlapItself(ByVal row As Long, ByVal column As Long) As Boolean


...which is always called with the arguments currentRow and currentColumn - both of which are module level. They can be omitted entirely.

## Scope

Direction is not used outside of the worksheet it's declared in (more on that below). It also has no meaning outside of the context of the game and uses a very common word for an identifier - it's not hard to imagine a bunch of other ways it could potentially be used in other projects. Make it Private so it can't create namespace conflicts in no-owned code. In general, you should be declaring things with the smallest possible scope.

There is absolutely no reason for these members of the worksheet to be Public:

Public ws As Worksheet
Public snakeParts As Collection
Public currentRow As Long
Public currentColumn As Long
Public directionSnake As Direction


If they need to be used like class members, make them Private - as it stands now they break encapsulation.

## Miscellaneous

This is a run-time error waiting to happen:

Set ws = ActiveWorkbook.Sheets("Game")


What if the active workbook doesn't contain a worksheet named "Game"? What if it contains a chart named "Game"? I'd either get rid of this entirely and use the code name of the sheet explicitly or (more likely for this purpose) just create a new worksheet for the game to run on with the understanding that the user will just delete it afterward.

This code likely doesn't belong in a worksheet at all - it looks like it wants to be in its own class with a single public RunGame(target As Worksheet) method. I suspect that it's currently in a worksheet because of the Worksheet_SelectionChange handler, but there's nothing that says a user class can't hold a Worksheet member WithEvents.

This is a meaningless assignment:

Dim gameOver As Boolean
gameOver = False


The default value of a Boolean is False.

Range.Select should never be used in a loop that calls DoEvents without checking the ActiveWorkbook. If the intention is that it should re-focus the game worksheet if the user selects something else (like sets focus to a different worksheet or workbook), you should handle that with an event handler. If another workbook becomes active, this is pretty much an instant error 1004.

The Call keyword is ancient history (and only exists for backward compatibility), and you're using it inconsistently. There is no reason to use it at all, so I'd recommend getting rid of it.

snakepart might call itself a class, but it's really just a glorified Type used to hold two dimensional coordinates. I'd consider re-architecting this to just store the entire game state in a two dimensional array.

The calls to MsgBox "GameOver" belong in the RunGame() method instead of sprinkled all over the tests for game ending conditions. Just put a single call after your loop exits - there's no other way to exit the loop, so that seems like the more logical place for it.

Related to the above, your flow control within the loop is kind of contorted. Your exit condition is Do While gameOver = False, and you have multiple checks for that condition here:

        If SnakePartOverlapItself(currentRow, currentColumn) = True Then
gameOver = True
Exit Do
ElseIf SnakePartYellowSquareOverlap = True Then
gameOver = True
Exit Do


So, you're testing for True, then setting your exit flag to True, then explicitly exiting the loop with Exit Do.

I'm also struggling to see the need for 3 separate game timers - they are always initialized one right after the other, so they should only be milliseconds apart (unless you're stepping through with the debugger). The entire loop could be simplified to something more like this:

Do
If TimerGame.CheckFiveSecondsPassed Then
End If

If TimerGame.CheckQuarterSecondPassed Then
CurrentCellUpdate
ws.Cells(currentRow, currentColumn).Select

Dim part As Long
For part = 1 To IIf(SnakePartBlueSquareOverlap, 3, 1)
Next

SnakePartRemove
ws.Cells(currentRow, currentColumn).Select
TimerGame.TimerSet
End If

DoEvents
Loop Until SnakePartOverlapItself Or SnakePartYellowSquareOverlap Or OutOfBounds

MsgBox "Game Over"

• really appreciate it! going through it now. sometimes things take a passes to stick. thank you for taking time! – learnAsWeGo Mar 4 '19 at 3:31
• i knew that call was not used anymore, but when i take call away from well call to sub SnakePartAdd I get an error message, the IDE expects a return value? maybe a bug? – learnAsWeGo Mar 4 '19 at 3:35
• laughed at various points during review. a lot of my code is cringe. but wanted to throw something together. next iteration will be PRO. :-p – learnAsWeGo Mar 4 '19 at 3:37
• @learnAsWeGo - If you remove the Call keyword, you also need to remove the parens. That's why you're getting compile errors. – Comintern Mar 4 '19 at 3:40
• LOL - looking forward to seeing your sound implementation. Just do the world a favor and don't use the Beep statement. – Comintern Mar 4 '19 at 3:57