Moudle1:
Public NowY() As Integer
Public NowX() As Integer
Public NowShape As Integer
Public block() As Boolean
Private Sub Cmd1_Click() '开始/重新开始
ReDim block(Int(Text1.Text) + 1, Int(Text2.Text) + 1) '定义2维数组
For i = 1 To Int(Text1.Text) '以下9行是初始化数组，令可操作(Pic1以内)的部分为False，Pic1以外的边缘部分为True
For j = 1 To Int(Text2.Text)
block(i, j) = False
block(0, j) = True
block(i, 0) = True
block(Int(Text1.Text) + 1, j) = True
block(i, Int(Text2.Text) + 1) = True
Next j
Next i
Text1.Enabled = False
Text2.Enabled = False
Cmd2.Enabled = True
Call MakeBlock '产生方块
Timer1.Enabled = True '开始
Cmd1.Caption = "重新开始"
Text3.Text = 0
Pic1.SetFocus '令Pic1接收键盘
End Sub
Private Sub Cmd2_Click() '暂停/继续
If Cmd2.Caption = "暂停" Then
Timer1.Enabled = False
Cmd2.Caption = "继续"
Else
Timer1.Enabled = True
Cmd2.Caption = "暂停"
End If
Pic1.SetFocus '令Pic1接收键盘
End Sub
Private Sub Cmd3_Click()
End
End Sub
Private Sub Form_Load()
Randomize '随机种子
ReDim NowX(3)
ReDim NowY(3) '定义数组来记录当前的4个方块的坐标
Image1(0).Width = 300
Image1(0).Height = 300
Image2(0).Width = 300
Image2(0).Height = 300
Image2(0).Picture = Image1(0).Picture '对相关Image的描述
For i = 1 To 3
Load Image2(i)
Image2(i).Visible = True
Next i '装载所需的Image2，并设置为可见
Image2(0).Visible = True
End Sub
Sub MakeBlock() '随机产生方块图形
Static NextShape As Integer '定义静态变量NextShape，用来存储下一个图形的样式。
NowX(0) = Int(Text1.Text) \ 2
NowY(0) = 1 '先定义第一个方块的坐标
NowShape = IIf(NextShape = 0, Fix(7 * Rnd) + 1, NextShape) '当前形状根据“下一个”而定
NextShape = Fix(7 * Rnd) + 1 '得到下一个即将出现的类型
Select Case NowShape '以下Case是按照事先规定的编号给相应的点赋予坐标值
Case 1 '方形
NowX(1) = NowX(0) + 1
NowY(1) = 1
NowX(2) = NowX(0)
NowY(2) = 2
NowX(3) = NowX(0) + 1
NowY(3) = 2
Case 2 'L形
NowX(1) = NowX(0) + 1
NowY(1) = 1
NowX(2) = NowX(0) + 1
NowY(2) = 2
NowX(3) = NowX(0) + 1
NowY(3) = 3
Case 3 '反L形
NowX(1) = NowX(0) + 1
NowY(1) = 1
NowX(2) = NowX(0)
NowY(2) = 2
NowX(3) = NowX(0)
NowY(3) = 3
Case 4 '长条形
For i = 1 To 3
NowX(i) = NowX(0)
NowY(i) = i + 1
Next i
Case 5 'Z形
NowX(1) = NowX(0) - 1
NowY(1) = 2
NowX(2) = NowX(0)
NowY(2) = 2
NowX(3) = NowX(0) - 1
NowY(3) = 3
Case 6 '反Z形
NowX(1) = NowX(0)
NowY(1) = 2
NowX(2) = NowX(0) + 1
NowY(2) = 2
NowX(3) = NowX(0) + 1
NowY(3) = 3
Case 7 'T形
NowX(1) = NowX(0) - 1
NowY(1) = 2
NowX(2) = NowX(0)
NowY(2) = 2
NowX(3) = NowX(0) + 1
NowY(3) = 2
End Select
For i = 0 To 3
If block(NowX(i), NowY(i)) = True Then '如果在即将产生的点中出现了已存在点(堆满)
Timer1.Enabled = False
Cmd2.Enabled = False
MsgBox "游戏结束", vbOKOnly, "gameover" '则游戏结束
Exit Sub
Else
block(NowX(i), NowY(i)) = True '如果没有堆满，则产生相应的点
End If
Next i
Image2(0).Left = 600
Image2(0).Top = 400
Select Case NextShape '以下Case是绘制“下一个”中的图形
Case 1
Image2(1).Left = 900
Image2(1).Top = 400
Image2(2).Left = 600
Image2(2).Top = 700
Image2(3).Left = 900
Image2(3).Top = 700
Case 2
Image2(1).Left = 900
Image2(1).Top = 400
Image2(2).Left = 900
Image2(2).Top = 700
Image2(3).Left = 900
Image2(3).Top = 1000
Case 3
Image2(1).Left = 900
Image2(1).Top = 400
Image2(2).Left = 600
Image2(2).Top = 700
Image2(3).Left = 600
Image2(3).Top = 1000
Case 4
Image2(1).Left = 600
Image2(1).Top = 700
Image2(2).Left = 600
Image2(2).Top = 1000
Image2(3).Left = 600
Image2(3).Top = 1300
Case 5
Image2(1).Left = 300
Image2(1).Top = 700
Image2(2).Left = 600
Image2(2).Top = 700
Image2(3).Left = 300
Image2(3).Top = 1000
Case 6
Image2(1).Left = 600
Image2(1).Top = 700
Image2(2).Left = 900
Image2(2).Top = 700
Image2(3).Left = 900
Image2(3).Top = 1000
Case 7
Image2(1).Left = 300
Image2(1).Top = 700
Image2(2).Left = 600
Image2(2).Top = 700
Image2(3).Left = 900
Image2(3).Top = 700
End Select
Call DrawBlock '重画所有方块
End Sub
Private Sub Pic1_KeyDown(KeyCode As Integer, Shift As Integer) '根据按键执行相应动作
Select Case KeyCode
Case 37 '左
Call MoveBlock(-1, 0)
Case 40 '下
Call MoveBlock(0, 1)
Case 39 '右
Call MoveBlock(1, 0)
Case 38 '上(旋转)
Call Eddy
End Select
End Sub
Private Sub Timer1_Timer()
Call MoveBlock(0, 1) '定时向下移动
End Sub
Sub MoveBlock(MoveX As Integer, MoveY As Integer) '在3个方向上平移方块
ReDim NewX(3) As Integer
ReDim NewY(3) As Integer
For i = 0 To 3
block(NowX(i), NowY(i)) = False '先令当前的4个方块所在点为False，便于判断是否可移动
NewX(i) = NowX(i) + MoveX
NewY(i) = NowY(i) + MoveY '算出移动后新点所在坐标，并赋给新点坐标组NewX(),NewY()
Next i
If AllowChange(NewX(), NewY()) = False Then '如果不可移动
For i = 0 To 3
block(NowX(i), NowY(i)) = True '因为不可移动，所以将暂时变为False的方块所在点改为True
Next i
If MoveY = 1 Then '如果是向下移动
Call Clear '判断是否可执行或执行消除整行的动作
Call MakeBlock '产生新的方块图形
End If
Else '如果可以移动
For i = 0 To 3
block(NewX(i), NewY(i)) = True '令新点坐标的值为True
NowX(i) = NewX(i)
NowY(i) = NewY(i) '将新点坐标赋给当前点坐标
Next i
End If
Call DrawBlock '重画所有方块
End Sub
Sub DrawBlock() '重画所有方块
For i = 1 To Image1.Count - 1
Unload Image1(i) '先卸载之前的所有方块
Next i
For i = 1 To Int(Text1.Text)
For j = 1 To Int(Text2.Text)
If block(i, j) = True Then '如果遇到True的点
Load Image1(Image1.Count) '加载新的Image1
Image1(Image1.Count - 1).Left = (i - 1) * 300
Image1(Image1.Count - 1).Top = (j - 1) * 300 '确定新Image1的位置，因为是从1开始算，所以要i-1,j-1
Image1(Image1.Count - 1).Visible = True
End If
Next j
Next i
End Sub
Sub Eddy() '旋转，以图（文末处）中2号点为旋转中心
ReDim NewX(3) As Integer
ReDim NewY(3) As Integer '定义即将旋转到新坐标的数组
If NowShape = 1 Then Exit Sub '如果是方块则退出Sub
For i = 0 To 3
block(NowX(i), NowY(i)) = False '把旋转前所有点都变成False,以便判断是否可以旋转。
NewX(i) = NowY(2) - NowY(i) + NowX(2)
NewY(i) = NowX(i) - NowX(2) + NowY(2) '利用坐标运算确定新坐标的位置，并赋给数组NewX(),NewY()
Next i '
If AllowChange(NewX(), NewY()) = True Then '如果可以变化
For i = 0 To 3
block(NewX(i), NewY(i)) = True '把新坐标的点都变为True
NowX(i) = NewX(i)
NowY(i) = NewY(i) '把所有新点坐标赋给当前坐标
Next i
Else '如果不能变化
For i = 0 To 3
block(NowX(i), NowY(i)) = True
Next i '把刚才改成False的点都变成True，相当于无变化
End If
Call DrawBlock '重画所有方块
End Sub
Function AllowChange(NewX() As Integer, NewY() As Integer) As Boolean '根据坐标判断是否能变化（包括翻转和移动）
On Error Resume Next
For i = 0 To 3
If block(NewX(i), NewY(i)) = True Then
AllowChange = False '如果有一个点已经存在（值为True），返回值则为False，即不可变化。
Exit Function '防止多于的循环造成错误，所以离开函数。
Else
AllowChange = True '否则可以变化。
End If
Next i
End Function
Sub Clear() '判断并执行销掉整排方块的动作
Dim Xn As Integer
Dim row As Boolean
For j = 0 To 3
Xn = 0
Do While Xn < Int(Text1.Text)
Xn = Xn + 1
row = True
row = row And block(Xn, NowY(j)) '和同一排的点做And运算。
If row = False Then Exit Do '如果发现有False值，则证明同一排有空缺点，则不再循环。
Loop
If row = True Then '经过循环，如果同一排的点都是True（存在），那么开始销去
Text3.Text = Text3.Text + 100 '加100分
For i = 1 To Int(Text1.Text)
block(i, NowY(j)) = False '通过循环把该排(Y=Now(j))的方块销去（令对应的数组值为False）
Next i
'接下来就该把该排上面堆积的方块向下移动一个格
For k = NowY(j) - 1 To 1 Step -1 '从该排的上一层开始，先动下层，再动上层。如果从上到下就会在移动下层时覆盖掉上层移动完的结果
For l = 1 To Int(Text1.Text) '从左到右，这个顺序倒没关系
If block(l, k) = True Then '如果在移动范围内发现有方块
block(l, k) = False '先销掉该方块（如果先动上层则会把上层移动后的点变成False,就相当于令上层移动的点消失）
block(l, k + 1) = True '在该方块的下面产生一个新的方块（相当于向下移）
End If
Next l
Next k
End If
Next j
Call DrawBlock '画出所有方块
End Sub
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024