2048は面白くて、癖になりやすいミニゲームです。多くの読者が好きだと思います。Excelの強力なVBAを使用して2048ミニゲームを開発すれば、遊ぶ体験がまた違うでしょう。
目次
インターフェースの設定
最初にゲームインターフェスを設定します。最初の4行を選択し、行の高さを50に設定します。この場合、セルはほぼ正方形です。次には、罫線を4 * 4セルに追加してから、外側の罫線を太い罫線に設定します。フォントをMicrosoftYahei、太字、中央揃えに変更します。6行目に、列AにSCORE、列CにMOVESを両方とも太字で記述します。
通常、2048のようなゲームはステートマシンで実装する必要があります。つまり、プログラムはゲームが終了するまで無期限に実行されます。このメソッドはExcelには適していません。ワークシートに付属のWorksheet_Selection Changeメソッドを使用して、キーボードの状態を取得し、ゲームの進みをより便利にします。
初期状態
まず、ゲームの初期状態を作りましょう。ゲーム変数は少ない状態です。ゲームの記録と操作には、4*4の2次元配列が必要です。score変数はscoreを記録し、moves変数はステップ数を記録します。初期状態では、すべて0にします。もちろん、最高得点を追加することもできますが、Excelセルの最高得点はいつでも変更できることを考えると、ほとんど意味がありません。
ここではステートマシンは使用されておらず、オブジェクト指向プログラミングにはクラスモジュールが使用されていないため、代わりにグローバル変数が使用されます。
Public numAreaArr
Public score As Double
Public moves As Integer
Public Sub Reset()
ReDim numAreaArr(1 To 4, 1 To 4) As Integer
score = 0
moves = 0
End Sub
Public numAreaArr
Public score As Double
Public moves As Integer
Public Sub Reset()
ReDim numAreaArr(1 To 4, 1 To 4) As Integer
score = 0
moves = 0
End Sub
これは変数の初期状態であり、セルに出力する必要があるため、出力メソッドが必要です。
Public Sub Output(ByVal numArr, ByVal score As Double, ByVal moves As Integer)
'インターフェス出力
Sheet1.Range("A1:D4") = numArr
Sheet1.Cells(6, 2) = score
Sheet1.Cells(6, 4) = moves
End Sub
ゲームが開始する時に、ゲームのインターフェス上に2つの乱数があります。空白の区域に2または4の数字をランダムに生成するメソッドが必要です。 2と4の確率比は9:1です。
Public Sub Spawn()
'乱数
Dim newElement%, n%, i%, j%
newElement = 2
Randomize (Timer)
t = 100 * Rnd()
If t > 90 Then newElement = 4
n = Int(16 * Rnd())
i = Int(n / 4) + 1
j = n Mod 4 + 1
Do While (numAreaArr(i, j) <> 0)
n = Int(16 * Rnd())
i = Int(n / 4) + 1
j = n Mod 4 + 1
Loop
numAreaArr(i, j) = newElement
Call Output(numAreaArr, score, moves)
End Sub
次に、Resetメソッドの最後に次のコードを追加します。
Call Spawn
Call Spawn
Call Output(numAreaArr, score, moves)
移動
キーボードのステータスを読み取るには、インターフェイスが必要です。Sheet1に次のコードを追加します。
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#Else
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#End If
ここで読み取られるのはGetKeyboardStateインターフェイスであり、VBA7と64ビットのWindowsシステムでは、VBAの呼び出しメソッドがわずかに異なるため、IF判定が追加されます。具体的な使い方は次のとおりです。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim keycode(0 To 255) As Byte
GetKeyboardState keycode(0)
If keycode(37) > 127 Then Call Num_Move(0) '左
If keycode(38) > 127 Then Call Num_Move(1) '上
If keycode(39) > 127 Then Call Num_Move(2) '右
If keycode(40) > 127 Then Call Num_Move(3) '下
Sheet1.Cells(4, 4).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
If Game_Over Then MsgBox "ゲームが終了!", , "Game Over"
End Sub
まず、ワークシートのイベントと画面の更新をブロックして、反復を回避し、画面表示を高速化します。次に、keycode配列を使用してキーボードの状態を記録します。配列インデックスの37〜40は、キーボードの左、上、右、下に対応し、それに応じて、状態0〜3をNum_Moveメソッドに渡します。最後に、ブロックされたイベントが復元され、Game_Over関数を使用してゲームが終了したかどうかを判定します。
Num_Moveメソッドは、画面にある数値を移動するメソッドです。まず、その流れを分析しましょう。
1、画面上の数値を取得します。
2、移動できるかどうかを判断し、移動できない場合はメソッドを終了します。
3、最初にすべての数値をその方向の最後に移動し、次に隣接する同じ数値をマージしてから、マージされた数値を最後に移動します。
4、新しい乱数を追加し、画面に出力します。
分析した後、段階的に解決していきましょう。
1、データを取得する
まずは、画面上の数値を取得するメソッドです。出力メソッドと正反対です。
Public Sub Get_Data()
numAreaArr = Sheet1.Range("A1:D4")
score = Sheet1.Cells(6, 2)
moves = Sheet1.Cells(6, 4)
End Sub
2、移動できるかどうかを判定する
次に、移動できるかどうかを判断する方法です。下方向への移動を例にします。0以外の数値より下のセルの値は0で、下のセルと同じで、移動できることを意味します。コードは次のように表示されます。
Public Function Move_Is_Possible(ByVal direction As Integer) As Boolean
Move_Is_Possible = False
Dim numArr
numArr = numAreaArr
'下に確認する
For i = 1 To 3
For j = 1 To 4
If numArr(i, j) <> 0 And numArr(i + 1, j) = 0 Then Move_Is_Possible = True: Exit Function
If numArr(i, j) <> 0 And numArr(i, j) = numArr(i + 1, j) Then Move_Is_Possible = True: Exit Function
Next j
Next i
End Function
ここでの問題は、上、下、左、右方向の判定を別々に書くと、面倒で賢くないです。移動、縮小と数値マージの場合、上、下、左、右の4つの状況で記述する必要があることを考えると、まだいくつかのより便利なメソッドを考えています。(実際にはありません)
配列を処理しているので、行列を使ったいくつかのメソッドを考えることができます。例えば、右への判定を検証するには、配列を転置してから下に判定します。左への判定を検証するには、配列を反転して右に判定し、前の質問に戻ります。上への判定を検証するには、配列を反転して左に判定し、前の質問に戻ることができます。 未知の問題から既知の問題への変換は、数学の削減です。
そのため、配列の転置関数と反転関数のみが必要になります。コードは次のように表示されます。
Public Function Transpose(ByVal numArr) As Variant
'転置
Dim newArr(1 To 4, 1 To 4) As Integer
For i = 1 To 4
For j = 1 To 4
newArr(i, j) = numArr(j, i)
Next j
Next i
Transpose = newArr
End Function
Public Function Invert(ByVal numArr) As Variant
'反転
Dim newArr(1 To 4, 1 To 4) As Integer
For i = 1 To 4
For j = 1 To 4
newArr(i, j) = numArr(i, 5 - j)
Next j
Next i
Invert = newArr
End Function
この時には、キーボード状態操作で配列を変更する関数が必要です。direction引数の0、1、2、3がそれぞれ方向の左、上、右、下に対応します。配列操作の方法は前述のとおりです。右が下に変更することは転置で、左が下に変更することは反転→転置で、上が下に変更することは転置→反転→転置です。
Public Function Arr_Change(ByVal numArr, ByVal direction As Integer, Optional status As Integer = 0) As Variant
If direction = 0 And status = 1 Then
Arr_Change = Invert(Transpose(numArr))
Exit Function
End If
Select Case direction
Case 0
numArr = Transpose(Invert(numArr))
Case 1
numArr = Transpose(Invert(Transpose(numArr)))
Case 2
numArr = Transpose(numArr)
End Select
Arr_Change = numArr
End Function
オプションの引数statusを追加する必要がある理由を説明します。このメソッドは、配列を移動、縮小、マージするときにも使用されると言いましたが、使用後に配列を画面に出力するように復元する必要があります。 方向1と2に対応する操作は対称であるため、復元時に同じメソッドが使用されます。方向0での操作は対称ではないため、出力前に配列を復元するメソッドを呼び出すときに、方向0の場合は、status引数によって反対の操作をします。
ここで、Arr_Change関数をMove_Is_Possible関数に追加して、numArr変数の割り当てが次のようになります。
numArr = Arr_Change(numAreaArr, direction)
方向で判定できます。
3、移動の操作
上記のメソッドによって、下方向への移動を考えるだけでいいです。
まずは、収縮を実行し、配列を下から上に読み取ります。0であるセルがある場合は、この列にある下から上、最初の0ではないセルと交換します。コードは次のように表示されます。
Public Function Tighten(ByVal numArr) As Variant
'下に収縮する
For i = 4 To 1 Step -1
For j = 1 To 4
If numArr(i, j) = 0 Then
For k = i - 1 To 1 Step -1
If numArr(k, j) <> 0 Then
numArr(i, j) = numArr(k, j)
numArr(k, j) = 0
Exit For
End If
Next k
End If
Next j
Next i
Tighten = numArr
End Function
次に、マージを実行し、下から上に読み取ります。0ではない、または前の行と同じ数値がある場合は、その行に追加し、前の行を0に戻します。同時に、マージした数値をSCOREに追加します。コードは次のように表示されます。
Public Function Merge(ByVal numArr) As Variant
'下にマージする
For i = 4 To 2 Step -1
For j = 1 To 4
If numArr(i, j) <> 0 And numArr(i, j) = numArr(i - 1, j) Then
numArr(i, j) = numArr(i, j) * 2
score = score + numArr(i, j)
numArr(i - 1, j) = 0
End If
Next j
Next i
Merge = numArr
End Function
これらの関数を使用して、Num_Moveメソッドを組み合わせることができます。
Public Sub Num_Move(ByVal direction As Integer)
Call Get_Data
If Move_Is_Possible(direction) = False Then Exit Sub
numAreaArr = Arr_Change(numAreaArr, direction)
numAreaArr = Tighten(Merge(Tighten(numAreaArr)))
numAreaArr = Arr_Change(numAreaArr, direction, 1)
moves = moves + 1
Call Spawn
Call Output(numAreaArr, score, moves)
End Sub
ゲームが終了
ゲームが終了時の判定関数は、すべての方向をトラバースし、Move_Is_PossibleがFalseを返す場合、Trueを返します。コードは次のとおりです。
Public Function Game_Over() As Boolean
Call Get_Data
Game_Over = True
For i = 0 To 3
If Move_Is_Possible(i) Then Game_Over = False: Exit Function
Next i
End Function
画面の最適化
上記のコードはゲームの基本機能を実行できますが、黒白の2048は私たちのニーズを満たしていません。著者はコードを書くよりも時間がかかって、ゲームの元の配色を見つけ、それをOutputメソッドに追加しました。
最適化の内容は次のとおりです。
1、0から4096までのセルに異なる背景色を指定します。大きい方の数値は、4096と同じです。
2、0のセルに同じフォントの色と背景色を指定し、2と4は黒、その他の数字は白にします。
3、 4桁以上のフォントサイズを16に調整し、列幅を常に8.38に保ちます。
4、ボタンを挿入し、Resetメソッドを呼び出して、ゲームを再開できるようにします。
Public Sub Output(ByVal numArr, ByVal score As Double, ByVal moves As Integer)
'画面の出力
Dim index%, redArr, greenArr, blueArr
redArr = Array(204, 238, 238, 243, 243, 248, 249, 239, 239, 239, 239, 239, 95)
greenArr = Array(192, 228, 224, 177, 177, 149, 94, 207, 207, 203, 199, 195, 218)
blueArr = Array(179, 218, 198, 116, 116, 90, 50, 108, 99, 82, 57, 41, 147)
For i = 1 To 4
For j = 1 To 4
'背景色インデックス
If numArr(i, j) = 0 Then
index = 0
ElseIf numArr(i, j) <= 4096 Then
index = Log(numArr(i, j)) / Log(2)
Else
index = 11
End If
'フォントの色
If numArr(i, j) = 0 Then
Sheet1.Cells(i, j).Font.Color = RGB(redArr(index), greenArr(index), blueArr(index))
ElseIf numArr(i, j) <= 4 Then
Sheet1.Cells(i, j).Font.Color = vbBlack
Else
Sheet1.Cells(i, j).Font.Color = vbWhite
End If
If numArr(i, j) >= 1024 Then
Sheet1.Cells(i, j).Font.Size = 16
Else
Sheet1.Cells(i, j).Font.Size = 20
End If
Sheet1.Cells(i, j).Interior.Color = RGB(redArr(index), greenArr(index), blueArr(index))
Next j
Next i
Sheet1.Range("A1:D4") = numArr
Sheet1.Range("A:D").ColumnWidth = 8.38
Sheet1.Cells(6, 2) = score
Sheet1.Cells(6, 4) = moves
End Sub
上記では、Excelバージョン2048が作成しており、完全なコードは通常どおり付録にあり、直接コピーして貼り付けることができます。
付録:ワークシートコード
Public numAreaArr
Public score As Double
Public moves As Integer
Public Sub Get_Data()
numAreaArr = Sheet1.Range("A1:D4")
score = Sheet1.Cells(6, 2)
moves = Sheet1.Cells(6, 4)
End Sub
Public Sub Num_Move(ByVal direction As Integer)
Call Get_Data
'Debug.Print Move_Is_Possible(direction)
If Move_Is_Possible(direction) = False Then Exit Sub
numAreaArr = Arr_Change(numAreaArr, direction)
numAreaArr = Tighten(Merge(Tighten(numAreaArr)))
numAreaArr = Arr_Change(numAreaArr, direction, 1)
moves = moves + 1
Call Spawn
Call Output(numAreaArr, score, moves)
End Sub
Public Function Merge(ByVal numArr) As Variant
'下にマージする
For i = 4 To 2 Step -1
For j = 1 To 4
If numArr(i, j) <> 0 And numArr(i, j) = numArr(i - 1, j) Then
numArr(i, j) = numArr(i, j) * 2
score = score + numArr(i, j)
numArr(i - 1, j) = 0
End If
Next j
Next i
Merge = numArr
End Function
Public Function Tighten(ByVal numArr) As Variant
'下に収縮する
For i = 4 To 1 Step -1
For j = 1 To 4
If numArr(i, j) = 0 Then
For k = i - 1 To 1 Step -1
If numArr(k, j) <> 0 Then
numArr(i, j) = numArr(k, j)
numArr(k, j) = 0
Exit For
End If
Next k
End If
Next j
Next i
Tighten = numArr
End Function
Public Function Arr_Change(ByVal numArr, ByVal direction As Integer, Optional status As Integer = 0) As Variant
If direction = 0 And status = 1 Then
Arr_Change = Invert(Transpose(numArr))
Exit Function
End If
Select Case direction
Case 0
numArr = Transpose(Invert(numArr))
Case 1
numArr = Transpose(Invert(Transpose(numArr)))
Case 2
numArr = Transpose(numArr)
End Select
Arr_Change = numArr
End Function
Public Function Move_Is_Possible(ByVal direction As Integer) As Boolean
Move_Is_Possible = False
Dim numArr
numArr = Arr_Change(numAreaArr, direction)
'下に確認する
For i = 1 To 3
For j = 1 To 4
If numArr(i, j) <> 0 And numArr(i + 1, j) = 0 Then Move_Is_Possible = True: Exit Function
If numArr(i, j) <> 0 And numArr(i, j) = numArr(i + 1, j) Then Move_Is_Possible = True: Exit Function
Next j
Next i
End Function
Public Function Invert(ByVal numArr) As Variant
'反転
Dim newArr(1 To 4, 1 To 4) As Integer
For i = 1 To 4
For j = 1 To 4
newArr(i, j) = numArr(i, 5 - j)
Next j
Next i
Invert = newArr
End Function
Public Function Transpose(ByVal numArr) As Variant
'転置
Dim newArr(1 To 4, 1 To 4) As Integer
For i = 1 To 4
For j = 1 To 4
newArr(i, j) = numArr(j, i)
Next j
Next i
Transpose = newArr
End Function
Public Function Game_Over() As Boolean
Call Get_Data
Game_Over = True
For i = 0 To 3
If Move_Is_Possible(i) Then Game_Over = False: Exit Function
Next i
End Function
Public Sub Reset()
ReDim numAreaArr(1 To 4, 1 To 4) As Integer
score = 0
moves = 0
Call Spawn
Call Spawn
Call Output(numAreaArr, score, moves)
End Sub
Public Sub Output(ByVal numArr, ByVal score As Double, ByVal moves As Integer)
'画面の出力
Dim index%, redArr, greenArr, blueArr
redArr = Array(204, 238, 238, 243, 243, 248, 249, 239, 239, 239, 239, 239, 95)
greenArr = Array(192, 228, 224, 177, 177, 149, 94, 207, 207, 203, 199, 195, 218)
blueArr = Array(179, 218, 198, 116, 116, 90, 50, 108, 99, 82, 57, 41, 147)
For i = 1 To 4
For j = 1 To 4
'背景色インデックス
If numArr(i, j) = 0 Then
index = 0
ElseIf numArr(i, j) <= 4096 Then
index = Log(numArr(i, j)) / Log(2)
Else
index = 11
End If
'フォントの色
If numArr(i, j) = 0 Then
Sheet1.Cells(i, j).Font.Color = RGB(redArr(index), greenArr(index), blueArr(index))
ElseIf numArr(i, j) <= 4 Then
Sheet1.Cells(i, j).Font.Color = vbBlack
Else
Sheet1.Cells(i, j).Font.Color = vbWhite
End If
If numArr(i, j) >= 1024 Then
Sheet1.Cells(i, j).Font.Size = 16
Else
Sheet1.Cells(i, j).Font.Size = 20
End If
Sheet1.Cells(i, j).Interior.Color = RGB(redArr(index), greenArr(index), blueArr(index))
Next j
Next i
Sheet1.Range("A1:D4") = numArr
Sheet1.Range("A:D").ColumnWidth = 8.38
Sheet1.Cells(6, 2) = score
Sheet1.Cells(6, 4) = moves
End Sub
Public Sub Spawn()
'乱数
Dim newElement%, n%, i%, j%
newElement = 2
Randomize (Timer)
t = 100 * Rnd()
If t > 90 Then newElement = 4
n = Int(16 * Rnd())
i = Int(n / 4) + 1
j = n Mod 4 + 1
Do While (numAreaArr(i, j) <> 0)
n = Int(16 * Rnd())
i = Int(n / 4) + 1
j = n Mod 4 + 1
Loop
numAreaArr(i, j) = newElement
End Sub
コメントを残す