その昔 倉庫番 というゲームがありました。
Excelで完全に再現することは不可能ですが、できるだけ再現してみたいと思います。
ゲームプログラミングを勉強したい方には、あまり参考にならないと思います。
しかし、VBAの学習に多少寄与できるよう無駄なことをしながら挑戦してみます。
途中で挫折するかもしれませんので、ご承知ください。
作業者および荷物を移動する処理の確認
前回記事の続きです。
前回、現在セルのシェイプを消してとなりのセルにシェイプを生成することで移動を実現しました。
同時に目的地シェイプ処理の課題も出てきたので、荷物の移動も含めた移動処理を整理します。
（作業者の移動とともに）荷物も移動する場合
- 荷物のひとつ先が目的地ならシェイプを削除
- 荷物のひとつ先に荷物（済）のシェイプを生成
- ひとつ先が目的地でないなら、荷物（未到）のシェイプを生成
- 現在の荷物シェイプを削除
荷物の現在セルには必ず作業者が入るので、現在セルが目的地かどうかの確認は不要です。
作業者が移動する場合
- 作業者のひとつ先が目的地ならシェイプを削除
- 作業者のひとつ先に作業者シェイプを生成
- 現在の作業者シェイプを削除
- 現在セルが目的地なら、目的地シェイプを復活
矢印キーが押されたときの処理全体像
移動できることを前提に荷物および作業者のそれぞれの個別処理を確認しましたが、移動できない場合も含めた、ルールを考慮した全体的な処理をフローチャートで整理します。
複雑ではないのでフローチャートで確認するまでもなかったかもしれませんが、必要なことを整理します。
用意するアクションはおおかまにいうと
- 移動しない
- 荷物を動かす
- 作業者を動かす
情報確認が必要なセルは
- （作業者の）現在セル
- （作業者の）ひとつ先のセル : 荷物の可能性あり
- ひとつ先が荷物の場合、さらにひとつ先のセル
必要な情報は
- 壁かどうか
- 目的地かどうか
- 荷物かどうか
です。
クラスモジュールへの実装
必要な情報を収集して、clsCellクラスモジュールに集約していく方針とします。
標準モジュールにグローバルレベルの定数を追加しています。
'クラスのプロパティ用（移動前のセル） Public Const PC_PARM_CELL_WORKER As Integer = 0 '現在セル Public Const PC_PARM_CELL_CRATE As Integer = 1 'ひとつ先の荷物セル
クラスモジュールのコードです。
Option Explicit ' ===== プロパティ ===== '作業者からみた相対位置 ' 0;作業者セル、1;作業者のひとつ先のセル Public nBlocAway As Integer '現在地の情報 Public oRange_0 As Range '現在地セル Public sShpName_0 As String '現在地セルのシェイプ名 Public bGoal_0 As Boolean '現在地が目的地かどうか 'ひとつ先の情報 Public oRange_1 As Range 'ひとつ先のセル Public bGoal_1 As Boolean 'ひとつ先が目的地かどうか Public bWall_1 As Boolean 'ひとつ先が壁かどうか Public bCrate_1 As Boolean 'ひとつ先が荷物かどうか Public sShpName_1 As String 'ひとつ先の移動後シェイプ名 Public sPicType_1 As String 'ひとつ先の移動後シェイプTYPE（"荷"or"済"など） '移動方向 Public sDrct As String '移動方向 -> 上or右or下or左 '（ひとつ先だけをみて）移動可能かどうか Public bMovable As Boolean 'True;移動可能かも、False;移動不可 ' ===== メソッド ===== '---------------------------------------------------------------------- ' sbNextCell ' １つ指定方向先の行番号と列番号をセットする ' 引数 = p_oCurrentCell : 現在セル '---------------------------------------------------------------------- Public Sub sbNextCell(p_oCurrentCell As Range) '移動先セルを取得 With oRange_0 Select Case sDrct Case "上" Set oRange_1 = .Offset(-1, 0) Case "下" Set oRange_1 = .Offset(1, 0) Case "左" Set oRange_1 = .Offset(0, -1) Case "右" Set oRange_1 = .Offset(0, 1) End Select End With '現在セルのシェイプ名 If nBlocAway = PC_PARM_CELL_WORKER Then sShpName_0 = "WH-Worker" If nBlocAway = PC_PARM_CELL_CRATE Then With oRange_0 sShpName_0 = g_fnCrtShapeName(.Row, .Column) End With End If End Sub '---------------------------------------------------------------------- ' sbAfterMove ' 荷物を移動したときのピクチャを選択する ' 移動可能なら True 、不可なら False をセット '---------------------------------------------------------------------- Public Sub sbAfterMove() Dim strRet_Type As String '戻り値 '作業者の移動 If nBlocAway = PC_PARM_CELL_WORKER Then If bWall_1 Then '作業者の先が壁なら移動不可 bMovable = False Else bMovable = True '生成する作業者シェイプ sShpName_1 = "WH-Worker" sPicType_1 = sDrct End If End If '荷物の移動 If nBlocAway = PC_PARM_CELL_CRATE Then If bWall_1 Or bCrate_1 Then '荷物の先が壁か荷物なら移動不可 bMovable = False Else bMovable = True With oRange_1 sShpName_1 = g_fnCrtShapeName(.Row, .Column) End With If bGoal_1 Then sPicType_1 = "済" Else sPicType_1 = "荷" End If End If End If End Sub
作業者セル用のクラスか（作業者のとなりの）荷物セル用のクラスかで動きは変わるので、区分 : nBlockAway をプロパティに用意しています。
接頭語の "n" は数値であることを意味し、さきほど用意した定数で指定します。
なお、メソッド sbNextCell も手を加えています。
現在セルすなわち移動前のセルを引数にしました。
ひとつ先のセルの取得に加えて、現在セルのシェイプ名もプロパティにセットするようにしています。
プロパティ bMovable は移動可能かどうかがセットされますが、 True は必ずしも移動確定でなく、未確定で可能性がある場合を含みます。
新たなメソッド sbAfterMove を追加しています。
まず、一般的には移動可能かどうかを判定します。
作業者セルではひとつ先が壁かどうか、つまり移動不可確定か移動可能性があるかを判定します。
荷物セルで、移動可能であると確定します。
移動可能もしくは移動可能性ありとなれば、移動後のシェイプのコピー元（種別）やシェイプ名をプロパティにセットします。
実装の話からはずれますが、今回セルの情報を構造体（ユーザー定義型）に持っていますが、クラスインスタンスの配列のコード例をメモします。
_/_/_/_/_/
Dim clsChinese(1 To 2, 1 To 2) As clsDishes
Set clsChinese(1, 1) = New clsDishes
clsChinese(1, 1).Name = "棒棒鶏"
clsChinese(1, 1).Cate = "四川"
Set clsChinese(1, 2) = New clsDishes
clsChinese(1, 2).Name = "麻婆豆腐"
clsChinese(1, 2).Cate = "四川"
Set clsChinese(2, 1) = New clsDishes
clsChinese(2, 1).Name = "油淋鶏"
clsChinese(2, 1).Cate = "広東"
Set clsChinese(2, 2) = New clsDishes
clsChinese(2, 2).Name = "酢豚"
clsChinese(2, 2).Cate = "広東"
_/_/_/_/_/
クラスインスタンスへの情報蓄積
ひとつ先のセルに加えてふたつ先のセルまでの情報が必要であることはわかっていますが、ふたつ先のセルの取得がマップ外にならないように、制御を検討しましょう。
ひとつ先のセルですが、マップの外になるのは作業者が壁の上にいるか壁の外にいるときなので検討不要です。
ふたつ先のセルですが、マップ境界の壁の手前に作業者がいるとマップ外になります。
逆にいうと、ひとつ先のセルが壁ならふたつ先のセルを取得しない、という処理にするなら検討不要です。
「 作業者クラス 」の情報蓄積
- 構造体から現在セルが目的地かどうかを取得
- 現在セルから sbNextCell にて、ひとつ先のセルを取得
- 構造体からひとつ先のセルの情報を取得
- sbAfterMove にて、移動不可かどうか検証
ここで移動不可なら移動不可決定です。
ひとつ先のセルが荷物の場合のみ、ふたつ先のセルの情報が必要です。
「 荷物クラス 」の情報蓄積
- 作業者クラスから現在セルが目的地かどうかを取得
- 現在セルから sbNextCell にて、ひとつ先のセルを取得
- 構造体からひとつ先のセルの情報を取得
- sbAfterMove にて、移動可か否か検証
最終的に、移動可能か不可能かが決定してどのアクションを実行するか明確になります。
クラスインスタンスの生成とプロパティに値セットするコードです。
クラスから直接構造体情報を取得できないため、わかりにくくなってしまいました。
（作業者または荷物の）現在地が目的地かどうかという引数は、作業者の場合は情報取得できない状態での呼び出しのため、むりやり値をセットします。
'---------------------------------------------------------------------- ' fnSetPropertis ' 移動後情報を含むクラスのプロパティを設定する ' 引数 = in_objRange : 現在セルのオブジェクト ' 引数 = in_strDrct : 移動方向 -> 上or右or下or左 ' 引数 = in_blnGoal : 目的地かどうか ' （作業者セルのときはいったんFalseをセット） ' 引数 = in_intAway : 0;作業者セル、1;荷物セル ' 戻り値 = 各種情報をセットしたclsCell '---------------------------------------------------------------------- Function fnSetPropertis(in_objRange As Range, _ in_strDrct As String, in_blnGoal As Boolean, _ in_intAway As Integer) As clsCell Dim intRow As Integer '移動先セルの行番号 Dim intCol As Integer '移動先セルの列番号 Dim clsObjective As clsCell Set clsObjective = New clsCell With clsObjective '現在のセルかひとつ先のセルか clsObjective.nBlocAway = in_intAway .bGoal_0 = in_blnGoal '移動方向をセット .sDrct = in_strDrct '移動先のセルを取得 Call .sbNextCell(in_objRange) '構造体のセル情報を格納 intRow = .oRange_1.Row intCol = .oRange_1.Column .bWall_1 = m_typCellInfo(intRow, intCol).HasWALL .bCrate_1 = m_typCellInfo(intRow, intCol).HasCRATE .bGoal_1 = m_typCellInfo(intRow, intCol).HasGOAL '移動後情報を取得 Call .sbAfterMove End With '戻り値セット Set fnSetPropertis = clsObjective Set clsObjective = Nothing End Function
この関数をこのように呼び出すイメージです。
荷物移動のコードは次回実装します。
Dim blnMovable As Boolean '作業者セル用のインスタンス Dim clsPrsn As clsCell '荷物セル用のインスタンス Dim clsCrate As clsCell blnMovable = True '作業者セル処理情報を取得 ' この時点で作業者セルが目的地かどうかわからない Set clsPrsn = fnSetPropertis(in_objRange, in_strDrct, _ False, PC_PARM_CELL_WORKER) '作業者セルが目的地かどうか With clsPrsn.oRange_0 clsPrsn.bGoal_0 = m_typCellInfo(.Row, .Column).HasGOAL End With With clsPrsn If .bMovable Then '作業者の先が荷物なら、荷物セル処理情報を取得 If .bCrate_1 Then Set clsCrate = _ fnSetPropertis(.oRange_1, in_strDrct, _ .bGoal_1, PC_PARM_CELL_CRATE) If clsCrate.bMovable Then '移動条件を満たせば、荷物を移動する ' ===== 荷物移動を実装 ===== Else '荷物の先が壁か荷物なら移動不可 blnMovable = False End If End If Else '作業者の先が壁なら移動不可 blnMovable = False End If End With
”blnMovable"によって、作業者移動処理を実行するか作業者を移動しない処理を実行するかが決まります。
次回は、移動できない場合も含めた作業者の移動処理と荷物に移動処理を実装し完成させます。
ご質問は下の 「コメントを書く」 からお願いします。
ExcelやVBA全般に関わる質問で、比較的簡単にお答えできるものはできる限り回答したいと思います。
回答を公開でなくメールでやり取りしたいという場合は、その旨記載していただければ非公開で回答することも可能です。
有償での作業依頼は非公開にしますので、条件等をお知らせください。
