Making a game with animation frames in Excel
Why might you make a game Excel? For learning and for fun. So let's get to it.
The Beginnings of a Game.
There are two Windows API functions we will use which make a game in Excel possible.
#If VBA7 Then
'64 bit declares here
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
'32 bit declares here
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
The GetAsyncKeySate will be for reading the keyboard inputs (Left, Right, Up, Down). timeGetTime will be used for the game counter to iterate frames. That's all you really need. Everything else can be down in VBA pure. Next we come to the game loop. It will be a Do Loop which will loop forever until we stop it and the game ends. Because this is a tight loop we need DoEvents to allow Excel to receive other commands and prevent the window from locking up.
Do
DoEvents
'Game code goes here.
Loop
Now we need a way to control and time updating the game state. timeGetTime is the answer. It returns the current time in milliseconds since boot time. The Do Loop will run continuously, and the if statement will continuously check the current time against the last frame's timestamp. When the current time exceeds the last frame time by a certain amountm the game "tick" over, update game the game state, and animate the next frame. I chose 50 milliseconds arbitrarily. Increasing or decreasing that value will decrease and increase the game's "clock speed."
'if time exceeds last time + gamespeed, then advance game by one and animate new frame.
If timeGetTime - lastFrameTime > 50 Then
'Game code goes here
End if
Now the game code itself. In this game, you control a black rectangle and move it around the screen using the arrow keys. Nice, right? Less of a game than Pong.
The game logic is very simple.
1) check if an arrow key is pressed.
2) if so, move a colored cell in that direction
3) repeat
To read the keystate, I'm using an enum in conjunction with GetAysyncKeyState like this.
Private Enum Direction
None = 0
Up = 1
Down
Left
Right
End Enum
Private Function ReadDirectionKeyDown() As Direction
ReadDirectionKeyDown = None
If (GetAsyncKeyState(vbKeyUp) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Up
ElseIf (GetAsyncKeyState(vbKeyDown) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Down
ElseIf (GetAsyncKeyState(vbKeyRight) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Right
ElseIf (GetAsyncKeyState(vbKeyLeft) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Left
End If
End Function
Inside the game loop we have a Select Case for each direction, and an X,Y coordinates for the location of the colored cell. Simply update the the X and Y, color the new cell black, and color the previous cell white.
Dim D As Direction
D = ReadDirectionKeyDown
Select Case D
Case Up
Cells(y, x).Interior.ColorIndex = -4142
y = y - 1
Cells(y, x).Interior.ColorIndex = 1
Case Down
Cells(y, x).Interior.ColorIndex = -4142
y = y + 1
Cells(y, x).Interior.ColorIndex = 1
Case Left
Cells(y, x).Interior.ColorIndex = -4142
x = x - 1
Cells(y, x).Interior.ColorIndex = 1
Case Right
Cells(y, x).Interior.ColorIndex = -4142
x = x + 1
Cells(y, x).Interior.ColorIndex = 1
End Select
The End. You have a "game." Ok, not a full game, but you have a controllable character in a space. Here's the entire module.
Option Explicit
#If VBA7 Then
'64 bit declares here
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
'32 bit declares here
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
Private Const KEY_DOWN As Integer = &H8000 'If the most significant bit is set, the key is down
Private Const KEY_PRESSED As Integer = &H1 'If the least significant bit is set, the key was pressed after the previous call to GetAsyncKeyState
Private Enum Direction
None = 0
Up = 1
Down
Left
Right
End Enum
Private Function ReadDirectionKeyDown() As Direction
ReadDirectionKeyDown = None
If (GetAsyncKeyState(vbKeyUp) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Up
ElseIf (GetAsyncKeyState(vbKeyDown) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Down
ElseIf (GetAsyncKeyState(vbKeyRight) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Right
ElseIf (GetAsyncKeyState(vbKeyLeft) And KEY_DOWN) = KEY_DOWN Then
ReadDirectionKeyDown = Left
End If
End Function
Sub Game()
Dim x As Long
Dim y As Long
x = 3
y = 8
Dim lastFrameTime As Long
lastFrameTime = timeGetTime 'start the tick counter
Dim D As Direction
Do
DoEvents
'if time exceeds last time + gamespeed, then advance game by one and animate new frame.
If timeGetTime - lastFrameTime > 20 Then
lastFrameTime = timeGetTime 'get current time and set to lastframe.
'All game code goes here.
'*********************************
D = ReadDirectionKeyDown
Select Case D
Case Up
Cells(y, x).Interior.ColorIndex = -4142
y = y - 1
Cells(y, x).Interior.ColorIndex = 1
Case Down
Cells(y, x).Interior.ColorIndex = -4142
y = y + 1
Cells(y, x).Interior.ColorIndex = 1
Case Left
Cells(y, x).Interior.ColorIndex = -4142
x = x - 1
Cells(y, x).Interior.ColorIndex = 1
Case Right
Cells(y, x).Interior.ColorIndex = -4142
x = x + 1
Cells(y, x).Interior.ColorIndex = 1
End Select
'*********************************
End If
Loop
End Sub