自己写的俄罗斯方块
已知BUG:1、在方块未出之前，按住方向键，左或右，会造成该块方块丢失。原因是坐标溢出。
2、旋转过程中，没有进行判断，存在无法旋转时，进行了旋转。
程序代码：Option Explicit
Const 格子大小 = 450
Const 颜色最大值 = 16777215
Const 格子线 = 8421504
Dim 数据区(11, 21) As Long
Dim 方块(1 To 4, 1 To 4) As Long
'Dim 方块定义(1 To 4, 1 To 4, 7) As Long
Dim 方块定义(7) As String '用字符串保存方块定义
Dim NEX方块(1 To 4, 1 To 4) As Long
Dim 游戏状态 As Long '=0 表示游戏结束
Dim 得分 As Long
Dim FX As Long, FY As Long
Private Sub Command1_Click()
Dim i As Long, j As Long
'清除数据区
For i = 1 To 10
For j = 1 To 20
数据区(i, j) = 0
Next j
Next i
'置状态
游戏状态 = 1
得分 = 0
Label1.Caption = 得分
'置初始方块及显示
FX = 3
FY = -3
'Call 初始化方块(方块(), 方块定义(Int(Rnd() * 7 + 1)), Int(Rnd() * 颜色最大值))
Call 新方块(方块())
Call 刷新
'置下一个方块
'Call 初始化方块(NEX方块(), 方块定义(Int(Rnd() * 7 + 1)), Int(Rnd() * 颜色最大值))
Call 新方块(NEX方块())
Call 显示方块(Picture2, NEX方块(), 4, 4, 345)
Label2.Visible = False
'设置焦点在图片框,可以接收KEYDOWN
Picture1.SetFocus
End Sub
Public Sub 显示方块(对象 As PictureBox, 数据() As Long, 宽 As Long, 高 As Long, 大小 As Long)
Const 空格 = 30 '2像素
Dim i As Long
Dim j As Long
对象.Cls '先清掉原来的
'画格子线
For i = 1 To 宽 + 1
对象.Line (i * 大小 - 大小, 0)-(i * 大小 - 大小, 高 * 大小), 格子线
Next i
For i = 1 To 高 + 1
对象.Line (0, i * 大小 - 大小)-(宽 * 大小, i * 大小 - 大小), 格子线
Next i
'扫描数据区,并根据数据区来画方块.
'如果预定义了图案,也可以在这里复制图案的方式进行组合成方块
For i = 1 To 宽
For j = 1 To 高
If 数据(i, j) > 0 Then
对象.Line (i * 大小 - 大小 + 空格, j * 大小 - 大小 + 空格)-(i * 大小 - 空格, j * 大小 - 空格), 数据(i, j), BF
End If
'debug
' 对象.CurrentX = i * 大小 - 大小 + 空格
' 对象.CurrentY = j * 大小 - 大小 + 空格
' 对象.Print i; j
Next j
Next i
End Sub
Public Sub 显示移动方块(对象 As PictureBox, 大小 As Long)
Const 空格 = 30
Dim i As Long
Dim j As Long
Dim k1 As Long
Dim k2 As Long
'显示操作的那个方块,并且根据左上角坐标进行修正
For i = 1 To 4
For j = 1 To 4
If 方块(i, j) > 0 Then
k1 = FX * 大小 + i * 大小 - 大小
k2 = FY * 大小 + j * 大小 - 大小
对象.Line (k1 - 大小 + 空格, k2 - 大小 + 空格)-(k1 - 空格, k2 - 空格), 方块(i, j), BF
End If
Next j
Next i
End Sub
Private Sub Form_Load()
Dim i As Long
'生成边界,用于后面的判断
For i = 0 To 11
数据区(i, 0) = 256
数据区(i, 21) = 256
Next i
For i = 0 To 21
数据区(0, i) = 256
数据区(11, i) = 256
Next i
'7种方块定义. 4*4 ,一共 16 个字符 ,1表示有,0表示空
方块定义(1) = "0100010001000100"
方块定义(2) = "0100010001100000"
方块定义(3) = "0100010011000000"
方块定义(4) = "0000010011100000"
方块定义(5) = "0000011001100000"
方块定义(6) = "0000110001100000"
方块定义(7) = "0000011011000000"
Randomize Timer
Dim k As String
k = "游戏说明:" & vbCrLf
k = k & "方向键进行操作" & vbCrLf
k = k & "空格键暂停" & vbCrLf
Label3.Caption = k
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
'处于游戏中,处理所有的键
If 游戏状态 = 1 Then
Select Case KeyCode
Case vbKeyUp
Call 右旋转(方块()) '此处有BUG
Case vbKeyDown
If 能否移动(1) Then
FY = FY + 1
Call 刷新
End If
Case vbKeyLeft
If 能否移动(2) Then
FX = FX - 1
Call 刷新
End If
Case vbKeyRight
If 能否移动(3) Then
FX = FX + 1
Call 刷新
End If
Case vbKeySpace '暂停
游戏状态 = 3
Label2.Visible = True
Label2.Caption = "暂 停"
End Select
ElseIf 游戏状态 = 3 Then '处于暂停中,只处理空格键
If KeyCode = vbKeySpace Then
游戏状态 = 1
Label2.Visible = False
End If
End If
End Sub
Private Sub Picture1_Paint()
'因为没有启用图片缓存,所以需要手动重绘图像
Call 显示方块(Picture1, 数据区(), 10, 20, 格子大小)
Call 显示移动方块(Picture1, 450)
End Sub
Public Sub 初始化方块(cs() As Long, 数据 As String, color As Long)
'把方块字符串数据转为 4*4 的数组数据
Dim i As Long, j As Long
For i = 1 To 4
For j = 1 To 4
If Mid(数据, i * 4 - 4 + j, 1) = 1 Then
cs(i, j) = color
Else
cs(i, j) = 0
End If
Next j
Next i
End Sub
Private Sub Picture2_Paint()
'刷新 next 方块
Call 显示方块(Picture2, NEX方块(), 4, 4, 345)
End Sub
Public Sub 右旋转(dat() As Long)
'向右,顺时针旋转
Dim i As Long
i = dat(1, 1)
dat(1, 1) = dat(4, 1)
dat(4, 1) = dat(4, 4)
dat(4, 4) = dat(1, 4)
dat(1, 4) = i
i = dat(1, 2)
dat(1, 2) = dat(3, 1)
dat(3, 1) = dat(4, 3)
dat(4, 3) = dat(2, 4)
dat(2, 4) = i
i = dat(1, 3)
dat(1, 3) = dat(2, 1)
dat(2, 1) = dat(4, 2)
dat(4, 2) = dat(3, 4)
dat(3, 4) = i
i = dat(2, 2)
dat(2, 2) = dat(3, 2)
dat(3, 2) = dat(3, 3)
dat(3, 3) = dat(2, 3)
dat(2, 3) = i
End Sub
Public Function 能否移动(cs As Long) As Boolean
'cs 表示方向,1向下,2向左,3向右
Dim NX As Long, NY As Long
Select Case cs
Case 1
NX = FX
NY = FY + 1
Case 2
NX = FX - 1
NY = FY
Case 3
NX = FX + 1
NY = FY
End Select
If NX < -4 Or NX > 10 Or NY < -4 Or NY > 20 Then
能否移动 = False
Exit Function
End If
Dim i As Long, j As Long
能否移动 = True
For i = 1 To 4
For j = 1 To 4
If 方块(i, j) > 0 Then '存在方块
If 能否移动 Then
If FX + i - 1 < 11 And FX + i - 1 > 0 And FY + j - 1 > 0 And FY + j - 1 < 21 Then '在坐标范围内
If 数据区(NX + i - 1, NY + j - 1) > 0 Then '数据区有方块
能否移动 = False
Exit For
End If
End If
End If
End If
Next j
If Not 能否移动 Then '如果已经出了结果,不再查找了
Exit For
End If
Next i
End Function
Private Sub Timer1_Timer()
Dim i As Long
Dim j As Long
'如果游戏处于结束,则退出处理
If 游戏状态 = 0 Then
Exit Sub
End If
'设置焦点在图片框,可以接收KEYDOWN
Picture1.SetFocus
'如果游戏是处于暂停,则退出处理
If 游戏状态 = 3 Then '暂停
Exit Sub
End If
'如果游戏处于消除行,则调用清除行
If 游戏状态 = 2 Then
Call 清除行
Else
'判断能否向下移动,如果能,就向下移动
If 能否移动(1) Then
FY = FY + 1
Call 刷新
Else
'否则,如果FY<1表示方块还没出完就无法移动了,说明已经顶格了,游戏结束
If FY < 1 Then
游戏状态 = 0
Label2.Caption = "游戏结束"
Label2.Visible = True
Else
' Stop
'固定当前方块,把操作的那个方块写入到区域中去
For i = 1 To 4
For j = 1 To 4
If FX + i - 1 < 11 And FX + i - 1 > 0 And FY + j - 1 > 0 And FY + j - 1 < 21 Then
If 方块(i, j) > 0 Then
数据区(FX + i - 1, FY + j - 1) = 方块(i, j)
End If
End If
方块(i, j) = NEX方块(i, j)
Next j
Next i
'搜索是否有整行,并计分
Call 计分
'产生新的方块
FX = 3
FY = -3
Call 新方块(NEX方块()) '把下一个方块转为操作的那个方块
Call 显示方块(Picture2, NEX方块(), 4, 4, 345) '并产生一个新的方块
End If
End If
End If
End Sub
Public Sub 刷新()
'分别调用显示整个区域和控制的那个方块
Call 显示方块(Picture1, 数据区(), 10, 20, 450)
Call 显示移动方块(Picture1, 450)
End Sub
Public Sub 计分()
Dim i As Long
Dim j As Long
Dim 整行 As Boolean
Dim js As Long
js = 0
For i = 1 To 20
整行 = True
For j = 1 To 10
If 数据区(j, i) = 0 Then
整行 = False
Exit For
End If
Next j
If 整行 Then
js = js + 1
End If
Next i
'如果有整行,则进行清除
If js > 0 Then
游戏状态 = 2
Call 清除行(True)
End If
'计分原则
Select Case js
Case 1
得分 = 得分 + 100
Case 2
得分 = 得分 + 300
Case 3
得分 = 得分 + 900
Case 4
得分 = 得分 + 1500
End Select
Label1.Caption = 得分
End Sub
Public Sub 清除行(Optional cs As Boolean = False)
Static 闪烁计数 As Long
If cs Then
闪烁计数 = 6
End If
闪烁计数 = 闪烁计数 - 1
Dim i As Long
Dim j As Long
Dim 整行 As Boolean
Dim k As Long
If 闪烁计数 > 0 Then
'此节用来闪烁所有的整行
k = Int(Rnd() * 颜色最大值)
For i = 1 To 20
整行 = True
For j = 1 To 10
If 数据区(j, i) = 0 Then
整行 = False
Exit For
End If
Next j
If 整行 Then
For j = 1 To 10
数据区(j, i) = k
Next j
End If
Next i
Else
'此节用来清掉所有的整行
For i = 1 To 20
整行 = True
For j = 1 To 10
If 数据区(j, i) = 0 Then
整行 = False
Exit For
End If
Next j
If 整行 Then
For j = i To 2 Step -1
For k = 1 To 10
数据区(k, j) = 数据区(k, j - 1)
Next k
Next j
For k = 1 To 10
数据区(k, 1) = 0
Next k
End If
Next i
游戏状态 = 1
End If
Call 显示方块(Picture1, 数据区(), 10, 20, 450)
End Sub
Public Sub 新方块(dat() As Long)
Dim i As Long
Dim R1 As Long, G1 As Long, B1 As Long
Dim j As Long, k As Double
i = Int(Rnd() * 7 + 1)
'此节是为了保证产生的方块能看得清
k = 255
Do While k > 128
R1 = Rnd() * 255
G1 = Rnd() * 255
B1 = Rnd() * 255
k = 0.3 * R1 + 0.5 * G1 + 0.2 * B1
Loop
j = RGB(R1, G1, B1)
Call 初始化方块(dat(), 方块定义(i), j)
End Sub
方块.rar
(4.56 KB)
