.png)
エクセルでテトリスを作りました
記事IT・テクノロジー
エクセルでテトリスを作りました。
午後からなんとなく作り始めまして、午後のオンライン礼拝なども見ていましたが、夜には完成しました。
一筆書きなので、不具合がないことを願っていますが…。
以下にコードをさらしますね。
Option Explicit
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
Sub テトリス()
Dim shurui As Integer
Dim ochigyou(1 To 4), ochiretu(1 To 4) As Integer
Dim hayasa, hayaokuri, hayasas As Integer
Dim tate, yoko As Integer
Dim px As Double
tate = 30
yoko = 15
Dim sude(1 To 100, 1 To 100, 1 To 3) As Integer
Dim i, j, k, n, x, p, q As Integer
Dim a(1 To 4), b(1 To 4) As Integer
Dim iro(1 To 7, 1 To 3) As Integer
Dim PressNumber(1 To 5) As Integer
Dim narabi, kaisuu As Integer
Dim tuyosa As Integer
Dim tuyosastr As String
'初期化
'色を定める
iro(1, 1) = 255
iro(1, 2) = 0
iro(1, 3) = 0
iro(2, 1) = 0
iro(2, 2) = 255
iro(2, 3) = 0
iro(3, 1) = 0
iro(3, 2) = 0
iro(3, 3) = 255
iro(4, 1) = 127
iro(4, 2) = 127
iro(4, 3) = 0
iro(5, 1) = 127
iro(5, 2) = 0
iro(5, 3) = 127
iro(6, 1) = 0
iro(6, 2) = 127
iro(6, 3) = 127
iro(7, 1) = 100
iro(7, 2) = 100
iro(7, 3) = 100
'メッセージ
MsgBox "「←」「→」のキーで左右に動きます。「z」「x」のキーで左右に回転します。「↓」で早送りできます。"
tuyosastr = InputBox("速さを選んでください。1.ゆっくり。2.普通。3．速い。4.すごく速い。")
tuyosa = Int(Val(tuyosastr))
Select Case tuyosa
Case 1
hayasas = 60
Case 2
hayasas = 30
Case 3
hayasas = 10
Case 4
hayasas = 5
Case Else
hayasas = 30
End Select
'速さを定める
hayaokuri = 3
'セルを正方形にする
px = 12 '正方形の一辺の長さ[px]
' セルの高さと幅を設定
Cells.ColumnWidth = px * 0.118
Cells.RowHeight = px * 0.75
'本当のゲームスタート
'すべて白
Cells.Clear
For i = 1 To tate
For j = 1 To yoko
For k = 1 To 3
sude(i, j, k) = 255
Range(Cells(i, j), Cells(i, j)).Interior.Color = RGB(255, 255, 255)
Next
Next
Next
'ゲームスタート
'上に発生する
L1:
x = 0
hayasa = hayasas
shurui = Int(Rnd * 7) + 1
Select Case shurui
Case 1
ochigyou(1) = 3
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochigyou(3) = 2
ochigyou(4) = 4
For j = 1 To 3
ochiretu(j + 1) = ochiretu(1)
Next
Case 2
ochigyou(1) = 1
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 2
ochiretu(2) = ochiretu(1)
ochigyou(3) = 1
ochiretu(3) = ochiretu(1) + 1
ochigyou(4) = 2
ochiretu(4) = ochiretu(1) + 1
Case 3
ochigyou(1) = 2
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochiretu(2) = ochiretu(1)
ochigyou(3) = 2
ochiretu(3) = ochiretu(1) - 1
ochigyou(4) = 2
ochiretu(4) = ochiretu(1) + 1
Case 4
ochigyou(1) = 1
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 2
ochiretu(2) = ochiretu(1)
ochigyou(3) = 1
ochiretu(3) = ochiretu(1) - 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) - 2
Case 5
ochigyou(1) = 1
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 2
ochiretu(2) = ochiretu(1)
ochigyou(3) = 1
ochiretu(3) = ochiretu(1) + 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) + 2
Case 6
ochigyou(1) = 2
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochiretu(2) = ochiretu(1)
ochigyou(3) = 2
ochiretu(3) = ochiretu(1) - 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) + 1
Case 7
ochigyou(1) = 2
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochiretu(2) = ochiretu(1)
ochigyou(3) = 2
ochiretu(3) = ochiretu(1) + 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) - 1
End Select
For i = 1 To 4
Range(Cells(ochigyou(i), ochiretu(i)), Cells(ochigyou(i), ochiretu(i))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
For k = 1 To 4
If sude(ochigyou(k), ochiretu(k), 1) < 255 Or sude(ochigyou(k), ochiretu(k), 2) < 255 Or sude(ochigyou(k), ochiretu(k), 3) < 255 Then
GoTo L3
End If
Next
'待つ
L4:
For i = 1 To hayasa
Application.Wait [Now()] + 0.01 / 86400
If PressLeft = True Then
PressNumber(1) = 1
End If
If PressRight = True Then
PressNumber(2) = 1
End If
If PressZ = True Then
PressNumber(3) = 1
End If
If PressX = True Then
PressNumber(4) = 1
End If
If PressDown = True Then
PressNumber(5) = 1
End If
If PressNumber(1) = 1 Then
For j = 1 To 4
If ochiretu(j) = 1 Then
PressNumber(1) = 0
ElseIf sude(ochigyou(j), ochiretu(j) - 1, 1) < 255 Or sude(ochigyou(j), ochiretu(j) - 1, 2) < 255 Or sude(ochigyou(j), ochiretu(j) - 1, 3) < 255 Then
PressNumber(1) = 0
End If
Next
If PressNumber(1) = 1 Then
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 1 To 4
ochiretu(k) = ochiretu(k) - 1
Next
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(1) = 0
End If
End If
If PressNumber(2) = 1 Then
For j = 1 To 4
If ochiretu(j) = yoko Then
PressNumber(2) = 0
ElseIf sude(ochigyou(j), ochiretu(j) + 1, 1) < 255 Or sude(ochigyou(j), ochiretu(j) + 1, 2) < 255 Or sude(ochigyou(j), ochiretu(j) + 1, 3) < 255 Then
PressNumber(1) = 0
End If
Next
If PressNumber(2) = 1 Then
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 1 To 4
ochiretu(k) = ochiretu(k) + 1
Next
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(2) = 0
End If
End If
If PressNumber(3) = 1 Then
Select Case shurui
Case 1, 3, 4, 5, 6, 7
For k = 2 To 4
a(k) = ochigyou(1) + (ochiretu(1) - ochiretu(k))
b(k) = ochiretu(1) - (ochigyou(1) - ochigyou(k))
If a(k) > tate Or a(k) < 1 Or b(k) > yoko Or b(k) < 1 Then
PressNumber(3) = 0
If PressNumber(3) = 1 Then
If sude(a(k), b(k), 1) < 255 Or sude(a(k), b(k), 2) < 255 Or sude(a(k), b(k), 3) < 255 Then
PressNumber(3) = 0
End If
End If
End If
Next
If PressNumber(3) = 1 Then
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 2 To 4
ochigyou(k) = a(k)
ochiretu(k) = b(k)
Next
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(3) = 0
End If
Case 2
PressNumber(3) = 0
End Select
End If
If PressNumber(4) = 1 Then
Select Case shurui
Case 1, 3, 4, 5, 6, 7
For k = 2 To 4
a(k) = ochigyou(1) - (ochiretu(1) - ochiretu(k))
b(k) = ochiretu(1) + (ochigyou(1) - ochigyou(k))
If a(k) > tate Or a(k) < 1 Or b(k) > yoko Or b(k) < 1 Then
PressNumber(4) = 0
If PressNumber(4) = 1 Then
If sude(a(k), b(k), 1) < 255 Or sude(a(k), b(k), 2) < 255 Or sude(a(k), b(k), 3) < 255 Then
PressNumber(4) = 0
End If
End If
End If
Next
If PressNumber(4) = 1 Then
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 2 To 4
ochigyou(k) = a(k)
ochiretu(k) = b(k)
Next
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(4) = 0
End If
Case 2
PressNumber(4) = 0
End Select
End If
If PressNumber(5) = 1 Then
hayasa = hayaokuri
PressNumber(5) = 0
Exit For
End If
Next
'落ちる
x = 0
For k = 1 To 4
If sude(ochigyou(k) + 1, ochiretu(k), 1) < 255 Or sude(ochigyou(k) + 1, ochiretu(k), 2) < 255 Or sude(ochigyou(k) + 1, ochiretu(k), 3) < 255 Or ochigyou(k) >= tate Then
x = 1
End If
Next
If x = 0 Then
For j = 1 To 4
Range(Cells(ochigyou(j), ochiretu(j)), Cells(ochigyou(j), ochiretu(j))).Interior.Color = RGB(255, 255, 255)
Next
For j = 1 To 4
ochigyou(j) = ochigyou(j) + 1
Next
For j = 1 To 4
Range(Cells(ochigyou(j), ochiretu(j)), Cells(ochigyou(j), ochiretu(j))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
GoTo L4
Else
For k = 1 To 4
For i = 1 To 3
sude(ochigyou(k), ochiretu(k), i) = iro(shurui, i)
Next
Next
For kaisuu = 1 To 4
For i = 1 To tate
narabi = 0
For j = 1 To yoko
If sude(i, j, 1) < 255 Or sude(i, j, 2) < 255 Or sude(i, j, 3) < 255 Then
narabi = narabi + 1
End If
Next
If narabi = yoko Then
For k = 1 To i - 1
For p = 1 To yoko
For q = 1 To 3
sude(i + 1 - k, p, q) = sude(i - k, p, q)
Next
Next
Next
End If
Next
Next
For i = 1 To tate
For j = 1 To yoko
Range(Cells(i, j), Cells(i, j)).Interior.Color = RGB(sude(i, j, 1), sude(i, j, 2), sude(i, j, 3))
Next
Next
End If
GoTo L1
L3:
MsgBox "ゲームオーバーです。"
End Sub
Function PressCtrl() As Boolean
Const KEY_PRESSED = -32767
PressCtrl = (GetAsyncKeyState(vbKeyControl) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressZ() As Boolean
Const KEY_PRESSED = -32767
PressZ = (GetAsyncKeyState(vbKeyZ) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressX() As Boolean
Const KEY_PRESSED = -32767
PressX = (GetAsyncKeyState(vbKeyX) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressC() As Boolean
Const KEY_PRESSED = -32767
PressC = (GetAsyncKeyState(vbKeyC) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressV() As Boolean
Const KEY_PRESSED = -32767
PressV = (GetAsyncKeyState(vbKeyV) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressLeft() As Boolean
Const KEY_PRESSED = -32767
PressLeft = (GetAsyncKeyState(vbKeyLeft) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressRight() As Boolean
Const KEY_PRESSED = -32767
PressRight = (GetAsyncKeyState(vbKeyRight) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressUp() As Boolean
Const KEY_PRESSED = -32767
PressUp = (GetAsyncKeyState(vbKeyUp) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressDown() As Boolean
Const KEY_PRESSED = -32767
PressDown = (GetAsyncKeyState(vbKeyDown) And KEY_PRESSED) = KEY_PRESSED
End Function
