6
\$\begingroup\$

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 SnakePartAdd(currentRow, currentColumn)
                    Call SnakePartAdd(currentRow, currentColumn)
                    Call SnakePartAdd(currentRow, currentColumn)
                    Call SnakePartRemove
                    ws.cells(currentRow, currentColumn).Select
                    TimerGame.TimerSet
                Else
                    Call SnakePartAdd(currentRow, currentColumn)
                    Call SnakePartRemove
                    ws.cells(currentRow, currentColumn).Select
                    TimerGame.TimerSet
                End If
            End If

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

            If TimerYellowSquare.CheckFiveSecondsPassed = True Then
                YellowSquareAdd
                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()
            Call SnakePartAdd(currentRow, currentColumn - 6)
            Call SnakePartAdd(currentRow, currentColumn - 5)
            Call SnakePartAdd(currentRow, currentColumn - 4)
            Call SnakePartAdd(currentRow, currentColumn - 3)
            Call SnakePartAdd(currentRow, currentColumn - 2)
            Call SnakePartAdd(currentRow, currentColumn - 1)
            Call SnakePartAdd(currentRow, currentColumn)
        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
            SnakePartAddToCollection SnakePartNew
            SnakePartAddToGameBoard SnakePartNew
        End Sub

            Private Sub SnakePartAddToCollection(ByRef snakepart As snakepart)
                snakeParts.add 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

        Private Sub BlueSquareAdd()
            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

        Private Sub YellowSquareAdd()
            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)
            snakeParts.add currentRow
        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
\$\endgroup\$
5
\$\begingroup\$

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
        BlueSquareAdd
        YellowSquareAdd
    End If

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

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

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

    DoEvents
Loop Until SnakePartOverlapItself Or SnakePartYellowSquareOverlap Or OutOfBounds

MsgBox "Game Over"
|improve this answer|||||
\$\endgroup\$
  • \$\begingroup\$ really appreciate it! going through it now. sometimes things take a passes to stick. thank you for taking time! \$\endgroup\$ – learnAsWeGo Mar 4 '19 at 3:31
  • \$\begingroup\$ 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? \$\endgroup\$ – learnAsWeGo Mar 4 '19 at 3:35
  • \$\begingroup\$ 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 \$\endgroup\$ – learnAsWeGo Mar 4 '19 at 3:37
  • \$\begingroup\$ @learnAsWeGo - If you remove the Call keyword, you also need to remove the parens. That's why you're getting compile errors. \$\endgroup\$ – Comintern Mar 4 '19 at 3:40
  • 1
    \$\begingroup\$ LOL - looking forward to seeing your sound implementation. Just do the world a favor and don't use the Beep statement. \$\endgroup\$ – Comintern Mar 4 '19 at 3:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.