その昔 倉庫番 というゲームがありました。
Excelで完全に再現することは不可能ですが、できるだけ再現してみたいと思います。
ゲームプログラミングを勉強したい方には、あまり参考にならないと思います。
しかし、VBAの学習に多少寄与できるよう無駄なことをしながら挑戦してみます。
途中で挫折するかもしれませんので、ご承知ください。
キーボードのキーが押されたことを知るためには
前回記事の続きです。
ここまでの設定で画面の初期表示ができました。
ここから、実際のゲームプレーのコードを作成するまえに、平易な終了とやり直しの実装をしていきます。
通常VBAではコマンドボタンを配置し、これらがクリックされたときというイベントドリブンのプログラムを実行します。
しかし、今回はコマンドボタンを用意せず、キーボードのキーによる操作で実行する方針です。
としたのをちょっと後悔しています。
私は Visual Basic の経験があったので簡単に考えていたのですが、VBA標準にはキーが押された感知するものがありません。
まず、64bitマシーンの場合モジュールレベル領域にAPI利用のコードを Copy&Paste してください。
32bitマシーンの場合少しコードが違うので、調べてください。
Option Explicit '64bit PC Private Declare PtrSafe Function _ GetAsyncKeyState Lib "user32.dll" (ByVal vKey As LongPtr) As Long
この関数を用いて、標準モジュールに以下のように構成する方針にします。
- 画面表示（シェイプ構築）
- （ループ開始）
- 移動処理（矢印キー）のとき
- 最初からやり直し（HOME）のとき
- ゲーム終了（End）のとき >> プログラム終了
- （ループ終了）
ただし、ゲームクリア時のゲーム終了は別途検討します。
無限ループになるので、テスト実行時は注意しましょう。
開始時およびやり直し時のコード修正
矢印キーを押したときの実装は次回以降の予定ですが、大まかな流れとして
>> 初期地点から移動して、位置を返す
>> その位置から移動して、位置を返す
>> （以降繰り返し）
としたいので、前回作成した Macro1 を作業者の初期配置セルを戻り値として返すように修正し、 fnRefresh に名前を変えて次のようにコードを変えて利用します。
'---------------------------------------------------------------------- ' fnRefresh ' 構造体リセットや画面初期表示を行う ' 引数 = in_objSheet : シートオブジェクト ' 戻り値 = 作業者初期配置のセル（オブジェクト） '---------------------------------------------------------------------- Function fnRefresh(in_objSheet As Worksheet) As Range '画面反映停止 ' Application.ScreenUpdating = False '画僧クリア Call sbClearShapes(in_objSheet) '構造体初期化 Erase m_typCellInfo 'ステップ数初期化 in_objSheet.Cells(C_CNT_STEP_ROW, C_CNT_STEP_COL) = 0 '各セルの情報を持つ構造体を生成 Call sbStatusInfo '画像再描画 Call sbReGene(in_objSheet) '初期位置で倉庫作業者セルを定義 Set fnRefresh = fnCreateWorker(in_objSheet) '作業者セルを選択 fnRefresh.Select '画面反映再開 ' Application.ScreenUpdating = True End Function
"End"キー押下時にゲームを終了する
まずは無限ループから抜け出せる終了処理を実装します。
"End"キーを押すと、確認メッセージののちシェイプを削除してプログラムを終了します。
' 「END」ボタン 終了 If GetAsyncKeyState(vbKeyEnd) <> 0 Then If MsgBox("ゲームを終了します", vbOKCancel) = vbOK Then '画像クリア Call sbClearShapes(ActiveSheet) Exit Sub End If End If
"Home"キー押下時にゲームを最初からやり直す
"Home"キーを押すと、確認メッセージののち初期画面を描画する処理を実行します。
' 「HOME」ボタン リトライ If GetAsyncKeyState(vbKeyHome) <> 0 Then If MsgBox("最初からやり直します", vbOKCancel) = vbOK Then Set objRangePrsn = fnRefresh(ActiveSheet) End If End If
（この時点での）全体構成
いったん初期処理と終了処理、やり直し処理を反映したものを Macro2 として作成します。（この時点で Macro1 はなくなったので、Macro1を使っても構いません。）
なお、私は唯一使用しているSheetのシート名が「Sokoban」なので、それぞれのシート名に置き換えてください。
Sub Macro2() Dim objRangePrsn As Range '倉庫作業者のセル Worksheets("Sokoban").Select '初期化 Set objRangePrsn = fnRefresh(ActiveSheet) Do ' 上矢印 If GetAsyncKeyState(vbKeyUp) <> 0 Then '処理を記述 End If ' 右矢印 If GetAsyncKeyState(vbKeyRight) <> 0 Then '処理を記述 End If ' 下矢印 If GetAsyncKeyState(vbKeyDown) <> 0 Then '処理を記述 End If ' 左矢印 If GetAsyncKeyState(vbKeyLeft) <> 0 Then '処理を記述 End If ' 「HOME」ボタン リトライ If GetAsyncKeyState(vbKeyHome) <> 0 Then If MsgBox("最初からやり直します", vbOKCancel) = vbOK Then Set objRangePrsn = fnRefresh(ActiveSheet) End If End If ' 「END」ボタン 終了 If GetAsyncKeyState(vbKeyEnd) <> 0 Then If MsgBox("ゲームを終了します", vbOKCancel) = vbOK Then '画像クリア Call sbClearShapes(ActiveSheet) Exit Sub End If End If Sleep 100 DoEvents Loop End Sub
次回は、矢印キーで作業者を移動する処理を実装します。
ご質問は下の 「コメントを書く」 からお願いします。
ExcelやVBA全般に関わる質問で、比較的簡単にお答えできるものはできる限り回答したいと思います。
回答を公開でなくメールでやり取りしたいという場合は、その旨記載していただければ非公開で回答することも可能です。
有償での作業依頼は非公開にしますので、条件等をお知らせください。
