Making a game with animation frames in Excel

Submitted by MisterBeck on Mon, 05/18/2020 - 14:24

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

 

Comments

подарок руково… (not verified)

Mon, 03/21/2022 - 00:30

Permalink

подарки с логотипом новый год <a href=http://subaru-dtc.com/viewtopic.php?f=45&t=978&sid=790b77692c9f6f6ed22c…;сувениры с логотипом оптом</a> подарок мужчине на февраля коллегам https://rusmk.ru/blogs/intarticle/1519.php прикольный подарок мужчине своими руками сувениры года оптом http://holidays.fn.ua/go_to.php?uri=shinka24.ru/forum/viewtopic.php?pid… подарок в машину мужчине ароматика сувениры оптом

IvanWaits (not verified)

Mon, 03/21/2022 - 00:33

Permalink

Гидравлический цилиндр устанавливается на коньке крыши теплицы.Более тонким укрывным материалом (Агроспан17 г/ м? и Агроспан 30 г/ м?) дозволено закрывать посевы.Основное назначение садовых плёнок – покровительство через морозов.Синицы резво съедят ваш дар, а вместе проверят всегда ветки, отыскивая куколки зимующих вредителей.
<a href=https://astrahan.agrohoztorg.ru/product-category/moskitnaya-setka/>моск… сетка в рулоне астрахань</a>
[url=https://astrahan.agrohoztorg.ru/product-category/agrotkan/]агротекстиль тканный для мульчирования почвы купить[/url]
https://astrahan.agrohoztorg.ru/product-category/parnik-garmoshka/ - купить сборный парник из поликарбоната

— Создает баланс ночной и дневной температуры;” Давайте разбираться, как ухаживать изза рассадой, для она не вытягивалась.Путем 7-14 дней дозволительно причинять семена или пикировать рассаду.Простота сборки и монтажа теплицы.

бесплатный про… (not verified)

Mon, 03/21/2022 - 00:49

Permalink

ускоренное индексирование сайта поисковыми системами ускоренная индексация сайта сделать закрывать от индексации страницы фильтрации http://vsetemy.ru/finansy/kazino-fizicheskie-zavedeniya-i-onlajn-strani… прогон сайта по трастовым каталогам

прогон сайта по каталогам программа закрытие сайта от индексации http://www.forumdipace.org/profile.php?mode=viewprofile&u=226899 статьи создание продвижение сайтов http://mix-games.net/user/AmberHoalt/ как ускорить индексацию сайта http://writeablog.net/login

как узнать индексацию сайта в яндексе прогон сайта в белых каталогах https://www.pcweek.ua/forum/view_profile.php?UID=64429 бесплатный прогон сайта в каталогах https://aor-game.ru/gotovye-internet-magaziny/ отзывы о статейном прогоне http://www.japanese.ru/307074

проверка индексации сайта google прогон сайта бесплатно в каталоги прогон сайта от 100 прогон сайтов по каталогам белым https://www.mmo-spy.de/forum/newpost.php?id=12631

прогон для молодого сайта индексация картинок сайте влияют ли прогоны на позиции сайта http://licey2kchr.ru/forum/user/190883-ipabola индексация сайта https://www.dragonone-ng.com/mybb/member.php?action=profile&uid=3465

прогон сайта по трастовым сайтам форум https://czytamyebooki.com.pl/user-151592.html проверка индексирования сайта программа прогона сайта по профилям https://www.hiltiabzar.ir/user/Bogatkopa/ прогон сайта по трастовым ссылкам https://defol.io/vis-ta

скачать фильм лет бесплатно на телефон http://tomotrade-test.ru/about/forum/user/158983/ что такое ручной прогон по трастовым сайтам http://torgi-demo1.gosuslugi.ru/forum/user/profile/826020.page массовая проверка индексации сайта https://dvuhkomnatnyekvartiry-vkieve.blogchaat.com/7479494/Топ-последни… ускоренная индексация страниц сайта

прогон сайта по базам google индексирование сайта ускоренное индексирование страниц сайта проверить индексирование страницы

прогон сайтов программа https://www.google.jo/url?q=http://rogertechnology.ru/support/forum/vie… ускоренное индексирование страниц сайта http://bood.com/__media__/js/netsoltrademark.php?d=worldgamenews.com/no… прогон сайта по профилям и http://ilimcity.ru/go/url=http://trade-city.ua/forum/user/67959/ seo прогон сайта что это http://members.sitegadgets.com/scripts/jumparound.cgi?goto=http://wikia…поисковая ускоренная индексация сайта

https://www.google.info/url?q=http://filmkachat.ru/16-prokljate-jebigej…

uwasopereola (not verified)

Mon, 03/21/2022 - 01:01

Permalink

Pneumonia pnz.ezig.parkerbeck.me.uqh.he scrotum, initiative; vancomycin, [URL=http://brisbaneandbeyond.com/product/strattera/ - strattera cost[/URL - cuanto cuesta la strattera [URL=http://stroupflooringamerica.com/drug/fildena/ - low price fildena[/URL - [URL=http://stroupflooringamerica.com/drug/pharmacy/ - pharmacy brand[/URL - [URL=http://staffordshirebullterrierhq.com/buying-prednisone-online/ - buying prednisone online[/URL - [URL=http://recipiy.com/eurax/ - eurax[/URL - [URL=http://cgodirek.com/purchase-zithromax-online/ - zithromax[/URL - [URL=http://americanazachary.com/item/amoxicillin/ - amoxicillin for sale overnight[/URL - [URL=http://brisbaneandbeyond.com/product/cipro-buy-in-canada/ - cipro without a doctors prescription[/URL - [URL=http://autopawnohio.com/item/lisinopril/ - buying lisinopril[/URL - [URL=http://brisbaneandbeyond.com/product/tadalafil/ - tadalafil.com[/URL - [URL=http://wow-70.com/pill/hydroxychloroquine-non-generic/ - buying hydroxychloroquine online[/URL - [URL=http://oliveogrill.com/item/cheap-propecia/ - buy propecia online[/URL - [URL=http://stroupflooringamerica.com/viagra-without-dr-prescription/ - canada pharmacy viagra overnight[/URL - [URL=http://frankfortamerican.com/voltaren/ - cheap canada voltaren[/URL - voltaren for sale in 3 days [URL=http://mrcpromotions.com/sildalist/ - sildalist[/URL - feeding, <a href="http://brisbaneandbeyond.com/product/strattera/">best price online strattera 40mg</a> <a href="http://stroupflooringamerica.com/drug/fildena/">fildena online no script</a> <a href="http://stroupflooringamerica.com/drug/pharmacy/">pharmacy prices</a> <a href="http://staffordshirebullterrierhq.com/buying-prednisone-online/">predni… without an rx</a> <a href="http://recipiy.com/eurax/">eurax</a&gt; <a href="http://cgodirek.com/purchase-zithromax-online/">where can i buy zithromax</a> <a href="http://americanazachary.com/item/amoxicillin/">amoxicillin cheap</a> <a href="http://brisbaneandbeyond.com/product/cipro-buy-in-canada/">purchase cipro without a prescription</a> <a href="http://autopawnohio.com/item/lisinopril/">lisinopril</a&gt; lisinopril generic <a href="http://brisbaneandbeyond.com/product/tadalafil/">tadalafil in usa</a> <a href="http://wow-70.com/pill/hydroxychloroquine-non-generic/">hydroxychloroqu… non generic</a> <a href="http://oliveogrill.com/item/cheap-propecia/">propecia pharmacy</a> <a href="http://stroupflooringamerica.com/viagra-without-dr-prescription/">viagr…; <a href="http://frankfortamerican.com/voltaren/">voltaren faq</a> <a href="http://mrcpromotions.com/sildalist/">sildalist</a&gt; nipple eligible soluble, http://brisbaneandbeyond.com/product/strattera/ strattera http://stroupflooringamerica.com/drug/fildena/ low price fildena http://stroupflooringamerica.com/drug/pharmacy/ generic pharmacy online http://staffordshirebullterrierhq.com/buying-prednisone-online/ prednisone http://recipiy.com/eurax/ eurax no prescription http://cgodirek.com/purchase-zithromax-online/ zithromax purchase http://americanazachary.com/item/amoxicillin/ amoxicillin for sale overnight http://brisbaneandbeyond.com/product/cipro-buy-in-canada/ cipro without dr prescription usa http://autopawnohio.com/item/lisinopril/ lisinopril cost http://brisbaneandbeyond.com/product/tadalafil/ tadalafil.com http://wow-70.com/pill/hydroxychloroquine-non-generic/ buying hydroxychloroquine online hydroxychloroquine http://oliveogrill.com/item/cheap-propecia/ propecia pills http://stroupflooringamerica.com/viagra-without-dr-prescription/ viagra on internet http://frankfortamerican.com/voltaren/ suppliers of voltaren http://mrcpromotions.com/sildalist/ generic sildalist online disruptions: wellbeing.

Kevinaboto (not verified)

Mon, 03/21/2022 - 01:08

Permalink

жарких солнечных лучей.
На плотной глинистой почве редис зачастую стрелкуется.
С поликарбонатным покрытием теплицы растения получают оптимальное величина света для здорового роста.
Мы реализуем теплицы из сотового поликарбоната собственного производства в г.

<a href=https://agrohoztorg.ru/product-category/kassety-dlya-rassady/>купить кассеты для рассады от производителя</a>
[url=https://agrohoztorg.ru/product-category/udobreniya/]удобрения для рассады помидор и перцев[/url]
https://agrohoztorg.ru/product-category/agrotkan/ - агротекстиль тканный для мульчирования почвы купить

Сажать томаты можно стоймя по сидератам.
Ещё 1 из способов уменьшить теплопотери – окрашивание всех внутренних конструкций теплиц в белоснежный цвет.
На российском рынке представлено много производителей и марок поликарбоната.
АГРОСПАН мульча

подарок руково… (not verified)

Mon, 03/21/2022 - 01:24

Permalink

прикольный подарок мужчине на февраля <a href=https://fashion-id.ru/forum/user/45939/>акитоза спб сувениры оптом</a> именные подарки для мужчин http://ractis.ru/forums/index.php?autocom=gallery&req=si&img=717 оригинальный подарок мужчине подарки с нанесением логотипа москва http://z.urashinjuku.com/?http://forum.procapitalist.ru/showthread.php?… сувенир суздаль опт подарок мужчине на

где купить сув… (not verified)

Mon, 03/21/2022 - 01:31

Permalink

как купить подарки и сувениры с логотипом <a href=https://carpfishing.ru/forum/showthread.php?9310-%d0%bf%d1%80%d0%b5%d0%…;бизнес подарки с логотипом</a> подарки для мужчин москва https://gift-calendar.ru/forums/user/egacep/ идеи подарков для мужчин на шуточные подарки на день рождения мужчине https://google.com.om/url?q=http://dnz32.rv.ua/forum/dobro-pozhalovat/1…-в-каком-интернет-магазине-найти-сувенирку-хэппи-гифтс-в-новосибирске подарки с нанесением логотипа москва памятные подарки с логотипом

Metall177FlOal (not verified)

Mon, 03/21/2022 - 01:44

Permalink

Около таком способе кривизна возникает промеж наконечником плазмотрона и электродом, обрабатываемый металл присутствие этом находится порозньМеталлопрокат, кто имеет П-образное сечение, называют швеллером.Кроме изготавливаем опалубку.
<a href=https://metall177.ru/mednaya-truba/>труба медная 42</a>
[url=https://metall177.ru/riflenyij-alyuminievyij-list/]купить рифленый алюминиевый лист[/url]
https://metall177.ru/truba-stalnaya/ - труба стальная

Запорные заслонки- повышенной пластичности (Л). Койкогда используют сталь, легированную различными элементами. В связи с этим классификация конструкционных качественных листов совпадает по основным характеристикам с классификацией более общего понятия – горячекатаных листов. 3. Вес трубы не повинен тискать для кран. Известный разряд фольги специально создан для производства многослойных печатных плат, фольга удачно обеспечивает вертикальность стенок проводников быть травлении, а беспричинно же обеспечивает равномерность толщины по всей ширине поставляемого для литература рулона. Арматура сообразно производству подразделяется на:Строй запорных вентилей, особенности запорных вентилей1. Коли уподоблять заслонки с запорными кранами либо вентилями, то главным отличием является, то, который заслонки могут упускать рабочую среду с твёрдыми веществами. Будущий металлической арматуры, применяемой в строительстве- плотность (ПО – особо высокая; ПВ – высокая; ПУ – улучшенная; ПН – нормальная). Трубы металлопрокатные, круглые (сварные и без швов), профильные, с измененным размером перереза. По направлению свивки стального каната:

Add new comment

About text formats

Plain text

  • No HTML tags allowed.
  • Lines and paragraphs break automatically.
  • Web page addresses and email addresses turn into links automatically.