自己写的俄罗斯方块
已知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)