Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Public flag As Boolean
Private xy(0 To 1)
Private tekis() As Integer
Sub StageRead()
Dim gyo As Integer
Dim retu As Integer
Dim menID As Integer
Dim i As Integer
Dim masus() As String
Dim tekis() As String
Dim tekiData() As String
Dim mys() As String
Dim teki As Variant
Dim r As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("game")
Set ws2 = ThisWorkbook.Worksheets("設定")
Set ws3 = ThisWorkbook.Worksheets("面データ")
ws2.Range("B8:K10") = ""
menID = 1
masus = Split(ws3.Cells(menID + 1, 4), ",")
i = 0
For gyo = 1 To 30
For retu = 1 To 66
Set r = ws1.Range(ws1.Cells(gyo, retu + 4), ws1.Cells(gyo, retu + 4))
Select Case Val(masus(i))
Case 1
r.Interior.Color = RGB(0, 0, 0)
Case 2
r.Interior.Color = RGB(255, 0, 0)
Case Else
r.Interior.ColorIndex = xlNone
End Select
i = i + 1
Next retu
Next gyo
tekis = Split(ws3.Cells(menID + 1, 3), ":")
i = 0
For Each teki In tekis
tekiData = Split(teki, ",")
ws2.Cells(8, 2 + i) = tekiData(0)
ws2.Cells(9, 2 + i) = tekiData(1)
ws2.Cells(10, 2 + i) = tekiData(2)
i = i + 1
Next
mys = Split(ws3.Cells(menID + 1, 2), ",")
ws2.Cells(13, 2) = mys(0)
ws2.Cells(14, 2) = mys(1)
End Sub
Sub StageCapture()
Dim gyo As Integer
Dim retu As Integer
Dim masu As Integer
Dim men As String
Dim my As String
Dim teki As String
Dim tekis As String
Dim r As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("面作成用")
Set ws2 = ThisWorkbook.Worksheets("設定")
Set ws3 = ThisWorkbook.Worksheets("面データ")
For gyo = 1 To 30
For retu = 1 To 66
Set r = ws1.Range(ws1.Cells(gyo, retu + 4), ws1.Cells(gyo, retu + 4))
Select Case r.Interior.Color
Case RGB(0, 0, 0)
masu = 1
Case RGB(255, 0, 0)
masu = 2
Case Else
masu = 0
End Select
men = men & masu & ","
If r.Value = "◎" Then
my = retu + 4 & "," & gyo
ElseIf r.Value <> "" Then
For i = 0 To 3
If r.Value = ws2.Cells(i + 2, 2).Value Then
teki = i & "," & retu + 4 & "," & gyo
tekis = tekis & teki & ":"
End If
Next i
End If
Next retu
Next gyo
men = Left(men, Len(men) - 1)
tekis = Left(tekis, Len(tekis) - 1)
gyo = 2
Do While ws3.Cells(gyo, 2) <> ""
gyo = gyo + 1
Loop
ws3.Cells(gyo, 2) = my
ws3.Cells(gyo, 3) = tekis
ws3.Cells(gyo, 4) = men
End Sub
Sub keyInput()
If GetAsyncKeyState(vbKeyLeft) Then
Call my_move(-1, 0)
ElseIf GetAsyncKeyState(vbKeyRight) Then
Call my_move(1, 0)
ElseIf GetAsyncKeyState(vbKeyUp) Then
Call my_move(0, -1)
ElseIf GetAsyncKeyState(vbKeyDown) Then
Call my_move(0, 1)
End If
End Sub
Sub my_move(x, y)
Dim r As Range
Set r = Range(Cells(xy(1) + y, xy(0) + x), Cells(xy(1) + y, xy(0) + x))
If r.Interior.Color = RGB(255, 0, 0) Then
Cells(xy(1), xy(0)) = ""
xy(0) = xy(0) + x
xy(1) = xy(1) + y
MsgBox "Goooooooooool"
Worksheets("game").CommandButton1.caption = "スタート"
flag = False
ElseIf r.Interior.Color <> RGB(0, 0, 0) Then
Cells(xy(1), xy(0)) = ""
xy(0) = xy(0) + x
xy(1) = xy(1) + y
End If
End Sub
Sub tekiMove(c As Long, n As Integer)
Dim s As Integer
Dim r As Range
Dim x As Integer
Dim y As Integer
Dim muki As Integer
Select Case tekis(0, n)
Case 0:
s = 3
Case 1:
s = 4
End Select
If c Mod s = 0 Then
Select Case tekis(0, n)
Case 0:
muki = Int(4 * Rnd + 1)
Select Case muki
Case 1:
x = -1
y = 0
Case 2:
x = 1
y = 0
Case 3:
x = 0
y = -1
Case Else:
x = 0
y = 1
End Select
Case 1:
If c Mod s * 2 = 0 Then
If xy(0) - tekis(1, n) < 0 Then
x = -1
Else
x = 1
End If
Else
If xy(1) - tekis(2, n) < 0 Then
y = -1
Else
y = 1
End If
End If
End Select
Set r = Range(Cells(tekis(2, n) + y, tekis(1, n) + x), Cells(tekis(2, n) + y, tekis(1, n) + x))
If r.Interior.Color <> RGB(0, 0, 0) Then
Cells(tekis(2, n), tekis(1, n)) = ""
tekis(1, n) = tekis(1, n) + x
tekis(2, n) = tekis(2, n) + y
End If
End If
End Sub
Sub game()
Call StageRead
Dim i As Integer
Dim j As Integer
Dim c As Long
Dim tekiNum As Integer
Dim tekiMoji(0 To 3) As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("game")
Set ws2 = ThisWorkbook.Worksheets("設定")
Randomize
For i = 0 To 3
tekiMoji(i) = ws2.Cells(2 + i, 2)
Next i
teki_num = 0
Do While ws2.Cells(8, tekiNum + 2) <> ""
tekiNum = tekiNum + 1
Loop
ReDim tekis(2, tekiNum - 1)
For j = 0 To tekiNum - 1
For i = 0 To 2
tekis(i, j) = ws2.Cells(8 + i, 2 + j)
Next i
Next j
ws1.Range("L2").Select
xy(0) = ws2.Cells(13, 2)
xy(1) = ws2.Cells(14, 2)
Do While flag
Cells(xy(1), xy(0)) = "◎"
For i = 0 To tekiNum - 1
Cells(tekis(2, i), tekis(1, i)) = tekiMoji(tekis(0, i))
Next i
Sleep 50
DoEvents
Call keyInput
For i = 0 To tekiNum - 1
Call tekiMove(c, i)
Next i
i = 0
Do While i < tekiNum And flag
If xy(0) = tekis(1, i) And xy(1) = tekis(2, i) Then
flag = False
Worksheets("game").CommandButton1.caption = "スタート"
MsgBox "Game Over"
End If
i = i + 1
Loop
Range("L2").Select
c = c + 1
Loop
Range("A1:BA30") = ""
End Sub
Private Sub CommandButton1_Click()
If flag Then 'ストップ処理
flag = False
CommandButton1.caption = "スタート"
Else 'スタート処理
flag = True
CommandButton1.caption = "ストップ"
Call game
End If
End Sub
