MENU
当ページのリンクには広告が含まれています。
ガジェット・アマゾンデバイス・スマート家電を中心に画像多めにレビュー！
  1. ホーム
  2. アプリ
  3. ゲーム開発で挫折した人必見！生成AI ChatGPT＆VBAでプチゲーム開発しませんか？（第4話）

ゲーム開発で挫折した人必見！生成AI ChatGPT＆VBAでプチゲーム開発しませんか？（第4話）

アプリ
当ページのリンクには広告が含まれています。
  • URLをコピーしました！

生成AI ChatGPTでゲーム開発の第4話目です。

今回はセルの移動と移動後のイベント処理について解説したいと思います。

ChatGPTが出力したソースコードの解説は第7話まで予定しています。

なので解説にもう少しお付き合い下さい。

前回の記事
ゲーム開発で挫折した人必見！生成AI ChatGPT＆VBAでプチゲーム開発しませんか？（第3話） ※2023/5/4追記　タイトル変更しました。 生成AI ChatGPTを使ってVBAゲームを開発の第3話です。 今回はプロシージャ単位の解説の一部を説明します。 前回予告でプロシー…
目次

第3話のおさらい

前回は初期化の処理と各セル（配列）へのイベントの設定の解説と補足のソースコードを書かせていただきました。

前回までのソースコードはこちら
Option Explicit
' グリッドの幅と高さを定義
Const GRID_WIDTH As Integer = 10
Const GRID_HEIGHT As Integer = 10
' グリッドのセルごとに定義する内容
Enum GridCell
    Emp
    Enemy
    Item
    Pitfall
    Door
　　Key 
End Enum
' キャラクターの初期位置
Dim playerX As Integer
Dim playerY As Integer
' キャラクターの状態
Dim playerHP As Integer
Dim playerHasKey As Boolean
Dim playerAttackPower As Integer
' グリッドの内容を保持する配列
Dim grid(GRID_WIDTH, GRID_HEIGHT) As GridCell
' 初期化処理
Sub Init()
    ' グリッドの内容をランダムに設定
    Dim x As Integer, y As Integer
    For x = 1 To GRID_WIDTH
        For y = 1 To GRID_HEIGHT
            Dim randValue As Integer
            randValue = Int(Rnd() * 4) ' 0-3のランダムな整数を生成
            grid(x, y) = randValue
        Next y
    Next x

'鍵の配置
    randValue = Int(Rnd() * 9 + 1)  ' 1-10のランダムな整数を生成
    x = randValue
    randValue = Int(Rnd() * 9 + 1)  ' 1-10のランダムな整数を生成
    y = randValue
　　grid(x, y) = 5

'扉の配置
　　Do
    　　randValue = Int(Rnd() * 9 + 1) ' 1-10のランダムな整数を生成
    　　x = randValue
    　　randValue = Int(Rnd() * 9 + 1) ' 1-10のランダムな整数を生成
    　　y = randValue
　　Loop While grid(x, y) ＝ 5 ' 鍵の位置と重なる場合はやり直す
　　grid(x, y) = 4

    ' キャラクターの初期位置を設定
    playerX = 1
    playerY = 1
    
    ' キャラクターの初期状態を設定
    playerHP = 10
    playerHasKey = False
    playerAttackPower = 1
End Sub
' キャラクターの移動
Sub MovePlayer(dx As Integer, dy As Integer)
    ' 移動先の座標を計算
    Dim newX As Integer
    newX = playerX + dx
    If newX < 1 Or newX > GRID_WIDTH Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If
    Dim newY As Integer
    newY = playerY + dy
    If newY < 1 Or newY > GRID_HEIGHT Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If
    
    ' 移動先のセルの内容によって処理を分岐
    Select Case grid(newX, newY)
        Case GridCell.Empty
            ' 空のセルなら何もしない
        Case GridCell.Enemy
            ' 敵がいるセルなら攻撃する
            AttackEnemy()
        Case GridCell.Item
            ' アイテムがあるセルなら取得する
            PickupItem()
        Case GridCell.Pitfall
            ' 落とし穴があるセルならダメージを受ける
            TakeDamage(3)
        Case GridCell.Door
            ' 扉があるセルなら鍵を持っているか確認して開ける
            If playerHasKey Then
                ' 扉を開けてクリア
　　　　　　　　　MsgBox "クリア！"
        　　Else
            　　MsgBox "鍵が必要です。"
        End If
End Select
' 移動先に移動する
playerX = newX
playerY = newY
End Sub
' 敵と戦う
Sub AttackEnemy()
' 敵にダメージを与える
' この部分は実装してください
End Sub
' アイテムを取得する
Sub PickupItem()
' アイテムの種類に応じて効果を適用する
' この部分は実装してください
End Sub
' ダメージを受ける
Sub TakeDamage(damage As Integer)
' ダメージを受けてHPを減らす
playerHP = playerHP - damage
If playerHP <= 0 Then
' HPが0以下になったらゲームオーバー
MsgBox "ゲームオーバー"
End If
End Sub
' 初期化
Randomize ' 乱数の初期化
Init()
' キャラクターを右に移動
MovePlayer(1, 0)
' キャラクターを下に移動
MovePlayer(0, 1)

さて、今回は移動処理の前半部分の解説を行いたいと思います。

3.移動 Sub MovePlayer で各種イベントを実行！？（前半）

次は移動です。移動のプロシージャはソースコードが長いので前半後半に分けて説明します。

キャラクターの配列上の移動判定処理
' キャラクターの配列上の移動判定処理
Sub MovePlayer(dx As Integer, dy As Integer)
    ' 移動先の座標を計算
    Dim newX As Integer
    newX = playerX + dx
    If newX < 1 Or newX > GRID_WIDTH Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If
    Dim newY As Integer
    newY = playerY + dy
    If newY < 1 Or newY > GRID_HEIGHT Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If

「移動先の座標を計算」部分がちょっと曲者です。

この処理は配列を移動した場合の判定処理の記述なんです。

因みにこんな内容ですね。

移動先がGrid(1,1)～(1,10)の範囲内なら先に進む
移動先がGrid(10,0)～(10,10)の範囲外なら何もしない

実はこのプログラムでは上下左右キーでシートのセルを移動しても、配列の中を移動出来ないんですよね…。

つまり移動した結果の判定はするけど移動したことにならないから、「何も起きない」プログラムなんですよね…。

なので、セルを移動する処理を追記する必要があります。

ということで、ChatGPTに上下左右キーでセルを移動の判定する処理を出力してもらいました。

キーボードの十字キーで、上下左右にセルを移動するソースをVBAで生成してください。

「上下左右キーでセルを移動」のコードはこちら
' ワークシートのセル上をキャラクターが移動する
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:J10")) Is Nothing Then
        ' セルが10x10のマップの範囲内である場合
        Dim moveX As Integer
        Dim moveY As Integer
        moveX = 0
        moveY = 0
        Select Case True
            ' 上キー
            Case Target.Row > playerY
                moveY = 1
            ' 下キー
            Case Target.Row < playerY
                moveY = -1
            ' 左キー
            Case Target.Column < playerX
                moveX = -1
            ' 右キー
            Case Target.Column > playerX
                moveX = 1
        End Select
        MovePlayer(moveX, moveY)
    End If

左右キーを押下でmoveXに座標：←（ー１）→（＋1）を代入　
上下キーを押下でmoveYに座標：↓（＋１）↑（ー1）を代入

そしてその結果をMovePlayerにセットしていますが、やっぱり問題があります。問題点は3つ。

①MovePlayer（moveX,moveY）→MovePlayer（moveY,moveX）
②Playerの現在位置を計算に含めていないので移動できない
③フォーカスが該当セルに移動する記述がない

まず座標の指定方法ですが、配列と異なりセルの移動はX、Yが逆なんですよね。

これだと上に移動したつもりが右に行っていることになってしまうので都合が悪いのです。

後、上下左右キーで増減値を書くのはOKなんですが、プレイヤーの現在の座標に対して足算しないとプレイヤーが左上3マスのセルから脱出できない不思議仕様になってしまうので、プレイヤー現在位置の変数も追加が必要です。

そして決定的なのはフォーカスが移動した座標にセットされないと、適当にクリックしたエリア外のセルにも移動できてしまうので、ゲームが破綻します。

そのため、事前に用意したプレイヤー現在位置用の変数「playerX」「playerY」の値を利用します。

10×10のセル内をフォーカスが移動できるように明示的に指定が必要です。

セル位置は「シート名(省略可).Cells(Y座標、X座標）.Active」で指定できるのでこれを使います。

以下のソースを追加することで、①、②、③をまとめて解決できます。

playerY = playerY + moveY
playerX = playerX + moveX
Sheet1.Cells(playerY, playerX).Activate

ざっくり説明すると「プレイヤーの移動先セルのY座標・X座標にフォーカスを移動して」を意味しています。

セル位置・配列位置を合わせる

これで、セル位置と配列の移動の同期の準備が整いました。

後、もう一つ。プロシージャ名を以下のように変更します。

Sub MovePlayer(dx As Integer, dy As Integer)
↓
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

SelectionChangeは選択しているワークシートのセルの位置を変更するイベントを表します。

詳細は割愛しますが、こうしないとうまく動作しないので必ず書き換えてください。

ということで冒頭のキャラクターの配列上の移動判定処理の前にセルのキャラクター移動処理を追加したソースがこちらです。

セルの移動処理を入れたソースはこちら
'  ワークシートのセル上をキャラクターが移動する
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:J10")) Is Nothing Then
        ' セルが10x10のマップの範囲内である場合
        Dim moveX As Integer
        Dim moveY As Integer
        moveX = 0
        moveY = 0
        Select Case True
            ' 上キー
            Case Target.Row > playerY
                moveY = 1
            ' 下キー
            Case Target.Row < playerY
                moveY = -1
            ' 左キー
            Case Target.Column < playerX
                moveX = -1
            ' 右キー
            Case Target.Column > playerX
                moveX = 1
        End Select
　　　　playerY = playerY + moveY
　　　　playerX = playerX + moveX
　　　　Sheet1.Cells(playerY, playerX).Activate
    End If

' キャラクターの配列上の移動判定処理
Dim newX As Integer
　　newX = playerX + dX
　　If newX < 1 Or newX > GRID_WIDTH Then
    　' 移動先がグリッド外なら何もしない
    　Exit Sub
　　End If
Dim newY As Integer
　　newY = playerY + dY
　　If newY < 1 Or newY > GRID_HEIGHT Then
    　' 移動先がグリッド外なら何もしない
    　Exit Sub
　　End If

これでOKと言いたいところなんですが、実は冒頭のキャラクターの配列上の移動判定処理も修正をする必要が出てきました。

一旦、冒頭の「 キャラクターの配列上の移動判定処理」に戻ります。

後、元の移動処理のソース部分にも手を入れます。

' キャラクターの配列上の移動判定処理
Sub MovePlayer(dx As Integer, dy As Integer)
    ' 移動先の座標を計算
    Dim newX As Integer
    newX = playerX + dx
    If newX < 1 Or newX > GRID_WIDTH Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If
    Dim newY As Integer
    newY = playerY + dy
    If newY < 1 Or newY > GRID_HEIGHT Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If

因みに元々の移動処理のソース（’ 移動先の配列の座標を計算　以下）はセルの移動処理を入れたことで不要になった変数があります。

不要な変数：dX、dY

これキャラクターのセルの移動処理でいうところのmoveX、moveYと同じ移動距離を格納する変数なんです。

プレイヤーの最新位置はplayerX、playerYに格納されているので、dX、dYは特に必要ありません。

削除しておかないとエラーも出るので、消しておきましょう。

' キャラクターの配列上の移動判定処理
Sub MovePlayer(dx As Integer, dy As Integer)
    ' 移動先の座標を計算
    Dim newX As Integer
    newX = playerX
    If newX < 1 Or newX > GRID_WIDTH Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If
    Dim newY As Integer
    newY = playerY
    If newY < 1 Or newY > GRID_HEIGHT Then
        ' 移動先がグリッド外なら何もしない
        Exit Sub
    End If

これでOKですが、実はもっとソース短くすることも可能です。

あまりいろいろやると説明が煩雑になるので、やめておきますが興味がある方は是非考えてみて下さい。

このソースはプレイヤーが配列の外側にいる場合は何もしないという処理をしています。

そしてヒントは同じことを何度もする意味があるのか？です。

第4話移動処理のまとめ

後半の移動後のイベント判定まで行きたかったのですが…。地味に説明に時間がかかったので今回はここまでにします。

ということで、現時点でのソースは以下の通り。

第4話_移動処理（前半）までのまとめソースはこちら
Option Explicit
' グリッドの幅と高さを定義
Const GRID_WIDTH As Integer = 10
Const GRID_HEIGHT As Integer = 10
' グリッドのセルごとに定義する内容
Enum GridCell
    Emp
    Enemy
    Item
    Pitfall
    Door
　　Key 
End Enum
' キャラクターの初期位置
Dim playerX As Integer
Dim playerY As Integer
' キャラクターの状態
Dim playerHP As Integer
Dim playerHasKey As Boolean
Dim playerAttackPower As Integer
' グリッドの内容を保持する配列
Dim grid(GRID_WIDTH, GRID_HEIGHT) As GridCell
' 初期化処理
Sub Init()
    ' グリッドの内容をランダムに設定
    Dim x As Integer, y As Integer
    For x = 1 To GRID_WIDTH
        For y = 1 To GRID_HEIGHT
            Dim randValue As Integer
            randValue = Int(Rnd() * 4) ' 0-3のランダムな整数を生成
            grid(x, y) = randValue
        Next y
    Next x

'鍵の配置
    randValue = Int(Rnd() * 9 + 1)  ' 1-10のランダムな整数を生成
    x = randValue
    randValue = Int(Rnd() * 9 + 1)  ' 1-10のランダムな整数を生成
    y = randValue
　　grid(x, y) = 5

'扉の配置
　　Do
    　　randValue = Int(Rnd() * 9 + 1) ' 1-10のランダムな整数を生成
    　　x = randValue
    　　randValue = Int(Rnd() * 9 + 1) ' 1-10のランダムな整数を生成
    　　y = randValue
　　Loop While grid(y, x) <> 5 ' 鍵の位置と重なる場合はやり直す
　　grid(x, y) = 4

    ' キャラクターの初期位置を設定
    playerX = 1
    playerY = 1
    
    ' キャラクターの初期状態を設定
    playerHP = 10
    playerHasKey = False
    playerAttackPower = 1
End Sub

'  ワークシートのセル上をキャラクターが移動する
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:J10")) Is Nothing Then
        ' セルが10x10のマップの範囲内である場合
        Dim moveX As Integer
        Dim moveY As Integer
        moveX = 0
        moveY = 0
        Select Case True
            ' 上キー
            Case Target.Row > playerY
                moveY = 1
            ' 下キー
            Case Target.Row < playerY
                moveY = -1
            ' 左キー
            Case Target.Column < playerX
                moveX = -1
            ' 右キー
            Case Target.Column > playerX
                moveX = 1
        End Select
　　　　playerY = playerY + moveY
　　　　playerX = playerX + moveX
　　　　Sheet1.Cells(playerY, playerX).Activate
    End If

' キャラクターの配列上の移動判定処理
Dim newX As Integer
　　newX = playerX
　　If newX < 1 Or newX > GRID_WIDTH Then
    　' 移動先がグリッド外なら何もしない
    　Exit Sub
　　End If
Dim newY As Integer
　　newY = playerY
　　If newY < 1 Or newY > GRID_HEIGHT Then
    　' 移動先がグリッド外なら何もしない
    　Exit Sub
　　End If
    
    ' 移動先のセルの内容によって処理を分岐
    Select Case grid(newX, newY)
        Case GridCell.Empty
            ' 空のセルなら何もしない
        Case GridCell.Enemy
            ' 敵がいるセルなら攻撃する
            AttackEnemy()
        Case GridCell.Item
            ' アイテムがあるセルなら取得する
            PickupItem()
        Case GridCell.Pitfall
            ' 落とし穴があるセルならダメージを受ける
            TakeDamage(3)
        Case GridCell.Door
            ' 扉があるセルなら鍵を持っているか確認して開ける
            If playerHasKey Then
                ' 扉を開けてクリア
　　　　　　　　　MsgBox "クリア！"
        　　Else
            　　MsgBox "鍵が必要です。"
        End If
End Select
' 移動先に移動する
playerX = newX
playerY = newY
End Sub
' 敵と戦う
Sub AttackEnemy()
' 敵にダメージを与える
' この部分は実装してください
End Sub
' アイテムを取得する
Sub PickupItem()
' アイテムの種類に応じて効果を適用する
' この部分は実装してください
End Sub
' ダメージを受ける
Sub TakeDamage(damage As Integer)
' ダメージを受けてHPを減らす
playerHP = playerHP - damage
If playerHP <= 0 Then
' HPが0以下になったらゲームオーバー
MsgBox "ゲームオーバー"
End If
End Sub
' 初期化
Randomize ' 乱数の初期化
Init()
' キャラクターを右に移動
MovePlayer(1, 0)
' キャラクターを下に移動
MovePlayer(0, 1)

因みに移動のプロシージャ名を途中で変えました。

Sub MovePlayer(dx As Integer, dy As Integer)
↓
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

見出しでは「3.移動 Sub MovePlayer で各種イベントを実行！？（前半）」とついていたのですが、後半の見出しは「3.移動 Sub Worksheet_SelectionChangeで各種イベントを実行！？（前半）」に変更させていただきます。

ChatGPTは便利なんですが、このレベルのソースになると修正しないと使えないので、こういった訂正はよく入ります。

話が前後したりすることがありますが、是非最後までお付き合いください。

次回は移動処理の後半を説明したいと思います。

ペースが遅くて申し訳ないのですが、じっくりしっかり進めていきたいと思います。

ということで、今回はここまで！

残念パパことイノッチでした。

では、また！

アプリ
ChatGPT EXCELマクロ VBA

この記事が気に入ったら
フォローしてね！

シェアお願いします！
  • URLをコピーしました！
  • URLをコピーしました！

コメント

コメント一覧 （4件）

    • I checked it on the speed measurement site, but the speed was fast as it was, and I didn’t really understand the cause. We recommend that you try a different browser or a different internet environment to isolate the problem.

      返信

  • Generally I don’t read post on blogs, however I would like to say that this write-up very pressured me to check out and do it! Your writing style has been amazed me. Thank you, very great post.

    返信

  • I really like your writing style, wonderful information, regards for posting :D. “Much unhappiness has come into the world because of bewilderment and things left unsaid.” by Feodor Mikhailovich Dostoyevsky.

    返信

コメントする

目次