Excel/VBAでパックマンを作る
2017/10/04
Excel方眼紙を使ってパックマンを作ってみました。
まだゲームとしては成り立っておらず、壁も敵キャラもいません。単に矢印キーでパックマンが上下左右に動くだけですね。壁もこれからです。
とりあえず、パックマンを矢印キーで動かすような基本的なところを押さえました。
[ad#top-1]
動画でみるExcelパックマン
動画でざっとした動きを紹介します。上下左右に動いていますがパソコンの矢印キーで動かしています。
https://www.youtube.com/watch?v=UZBVtckFgFM
動画にはありませんが、実際は赤丸で示したフォームが現れます。こいつが矢印キーをキャッチしてくれるんですね。シート上ではキーイベントが拾えないみたいなので。フォームをダブルクリックすると終了します。
ソースコード
まだ、パックマンのキー操作だけですが、ソースコードを書き留めておきます。もう少し完成度が上がったらGitHubにアップします。
Startボタン押下時
Excelシート右上の「Start」ボタンを押すとパックマンが開始されます。
開始コードは以下の通り。まずは4行目にスタート時のパックマンを描画します。座標と、”RIGHT”というのは「右向き」という意味です。
Sub start() Range("A2:ZZ200").Interior.Pattern = xlNone Call packman(7, 7, "RIGHT") 'パックマンの描画 座標(7,7) Call UserForm1.setPos(7, 7) 'フォームに開始座標をセット UserForm1.Show 'フォーム起動 End Sub
packmanプロシージャ
パックマンを描画するプロシージャは下記の通りです。pack配列はパックマンを描画するためのデータです。右向き、左向き、上向き、下向きのそれぞれに対応しています。描画前に1セル後ろの1列分の色を消しているので、あたかも進んでいるように見えるってわけですね。
Sub packman(posx, posy, direct) Dim pack As Variant If direct = "RIGHT" Then If posx > 150 Then Exit Sub pack = Array( _ Array(0, 0, 1, 1, 0), _ Array(0, 1, 1, 1, 1), _ Array(1, 1, 1, 0, 0), _ Array(0, 1, 1, 1, 1), _ Array(0, 0, 1, 1, 0) _ ) Range(Cells(posy - 2, posx - 3), Cells(posy + 2, posx - 3)).Interior.Pattern = xlNone ElseIf direct = "LEFT" Then If posx < 7 Then Exit Sub pack = Array( _ Array(0, 1, 1, 0, 0), _ Array(1, 1, 1, 1, 0), _ Array(0, 0, 1, 1, 1), _ Array(1, 1, 1, 1, 0), _ Array(0, 1, 1, 0, 0) _ ) Range(Cells(posy - 2, posx + 3), Cells(posy + 2, posx + 3)).Interior.Pattern = xlNone ElseIf direct = "UP" Then If posy < 7 Then Exit Sub pack = Array( _ Array(0, 1, 0, 1, 0), _ Array(1, 1, 0, 1, 1), _ Array(1, 1, 1, 1, 1), _ Array(0, 1, 1, 1, 0), _ Array(0, 0, 1, 0, 0) _ ) Range(Cells(posy + 3, posx - 2), Cells(posy + 3, posx + 2)).Interior.Pattern = xlNone ElseIf direct = "DOWN" Then If posy > 70 Then Exit Sub pack = Array( _ Array(0, 0, 1, 0, 0), _ Array(0, 1, 1, 1, 0), _ Array(1, 1, 1, 1, 1), _ Array(1, 1, 0, 1, 1), _ Array(0, 1, 0, 1, 0) _ ) Range(Cells(posy - 3, posx - 2), Cells(posy - 3, posx + 2)).Interior.Pattern = xlNone End If For i = 0 To UBound(pack) For j = 0 To UBound(pack(i)) If pack(i)(j) = 1 Then Cells(posy - 2 + i, posx - 2 + j).Interior.Color = 49407 Else Cells(posy - 2 + i, posx - 2 + j).Interior.Pattern = xlNone End If Next j Next i Call UserForm1.setPos(posx, posy) End Sub
UserForm
スタートボタンを押したときに各矢印キーに応じて座標を指定しつつ前出のpackmanプロシージャを呼び出しているわけです。
Dim lastposx As Integer Dim lastposy As Integer Sub setPos(x, y) lastposx = x lastposy = y End Sub Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyUp Then Call packman(lastposx, lastposy - 1, "UP") ElseIf KeyCode = vbKeyDown Then Call packman(lastposx, lastposy + 1, "DOWN") ElseIf KeyCode = vbKeyLeft Then Call packman(lastposx - 1, lastposy, "LEFT") ElseIf KeyCode = vbKeyRight Then Call packman(lastposx + 1, lastposy, "RIGHT") End If End Sub
とりあえずこんな感じです。今後は迷路みたいな壁を作ってそこを通るような動きをさせようと思います。
※続編です。
https://www.youtube.com/watch?v=0AduSpuhaT0
[ad#ad-1]
スポンサーリンク