VBAでゲーム作成(音ゲー作ってみたVer1)【ExcelVBA】
実際に使用したサンプルコード
Option Explicit
'音楽再生用のWinAPI 宣言コード
Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'Windows起動後の時間取得
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
'押したボタンを取得
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
'対象のセル
Dim rg As Range
Dim rg2 As Range
Dim rg3 As Range
'連打防止フラグ
Dim 押せるflg As Boolean
'フラグ
Dim flg As Boolean
Dim flg2 As Boolean
Public Sub Main()
'最初の点数を入れる
Range("B13").Value = 0
'音楽再生
mciSendString "play " & "music5.mp3", "", 0, 0
Dim 開始時間 As Long
Call 初期設定(rg)
Do
If rg.Row > 3 And flg = False Then
Call 初期設定(rg2)
flg = True
End If
If rg.Row > 6 And flg2 = False Then
Call 初期設定(rg3)
flg2 = True
End If
'赤色で色を付ける
rg.Interior.ColorIndex = 3
If flg Then rg2.Interior.ColorIndex = 3
If flg2 Then rg3.Interior.ColorIndex = 3
'待機
開始時間 = GetTickCount
Do While GetTickCount - 開始時間 < 200
DoEvents 'OSに制御を渡す
If 押せるflg = False Then
If GetAsyncKeyState(37) <> 0 Then
Call 判定処理(Range("A10"))
End If
If GetAsyncKeyState(38) <> 0 Then
Call 判定処理(Range("B10"))
End If
If GetAsyncKeyState(39) <> 0 Then
Call 判定処理(Range("C10"))
End If
End If
Loop
'フラグを元に戻す
押せるflg = False
'色を消す
Cells.Interior.ColorIndex = xlNone
'オフセットで1つ下の位置をセットする
Set rg = rg.Offset(1)
If flg Then Set rg2 = rg2.Offset(1)
If flg2 Then Set rg3 = rg3.Offset(1)
'行が11を超えたら1に戻る
If rg.Row > 11 Then Call 初期設定(rg)
If flg Then If rg2.Row > 11 Then Call 初期設定(rg2)
If flg2 Then If rg3.Row > 11 Then Call 初期設定(rg3)
Loop
'音楽停止
mciSendString "stop " & "music5.mp3", "", 0, 0
End Sub
Private Sub 初期設定(ByRef 初期セル As Range)
'乱数初期化
Randomize
'ランダムに1から3の整数を乱数という変数に入れます
Dim 乱数 As Integer
乱数 = WorksheetFunction.RandBetween(1, 3)
Set 初期セル = Choose(乱数, Range("A1"), Range("B1"), Range("C1"))
End Sub
Private Sub 判定処理(ByRef 判定セル As Range)
判定セル.Interior.ColorIndex = 37
If Application.Intersect(Union(rg, rg2, rg3), 判定セル) Is Nothing = False Then
'判定として当たってる場合
Range("B13").Value = Range("B13").Value + 1
'判定セルを選択する形にする
判定セル.Select
End If
押せるflg = True
End Sub