用VB6实现俄罗斯方块游戏(游戏编程入门教程)&追爱
代码附件含音乐较大上传不了在这里下载
fangcun.ys168.com
游戏目录下
如何标示一个方块
我们知道俄罗斯方块有不同的方块类型，而且，如何标示这些方块是一个问题
很容易想到的方法就是使用3*3的0-1数组，
比如标示正方形的0-1数组
1，1，0
1，1，0
0，0，0
(0)
标示拐杖形的0-1数组
1，1，0
0，1，0
0，1，0
(1)
而且这样标示的话有一个好处，只要翻转数组就可以得到换向后的方块
如对(1)翻转
0，0，0
1，1，1
1，0，0
可以看出这种翻转其实就是将行变为列
翻转代码如下
程序代码：
'方块矩阵翻转
Sub ChangeSqr()
Dim x As Integer, y As Integer
Dim Sqr(3, 3) As Boolean
y = 0
While y <= 2
x = 0
While x <= 2
Sqr(x, y) = g_Square(x, y)
x = x + 1
Wend
y = y + 1
Wend
Dim x2, y2
y = 0
While y <= 2
x = 0
While x <= 2
g_Square(y, 2 - x) = Sqr(x, y)
x = x + 1
Wend
y = y + 1
Wend
End Sub
'绘制下一方块
Sub DrawNextSquare()
Dim x As Integer, y As Integer
GamePage(0).Refresh
y = 0
While y <= 2
x = 0
While x <= 2
If g_NextSquare(x, y) Then
GamePage(0).PaintPicture ImgList.ListImages.Item(1).Picture, x * SQUARESIZE, y * SQUARESIZE
End If
x = x + 1
Wend
y = y + 1
Wend
End Sub
(1)
另外该数组翻转后为
0，0，0
1，1，1
1，0，0
(2)
可看到(1)的最后一列和(2)的第一行完全空出来了
这就造成如何判断方块是否碰到墙壁和已经固化方块的问题
对此我们可以计算出方块在0-1数组中的最小范围（构成方块的最小矩形）
然后在判断是加上相对位置
如(1)的最小范围
(0,0),(1,2)
(2)的最小范围
(0,1),(2,2)
计算代码如下
程序代码：
'确定方块矩阵最小范围
Sub CalSqrRange() '
'确定方块矩阵最小方形范围
'横向扫描
wy = 0
While wy <= 2
wx = 0
While wx <= 2
If g_Square(wx, wy) Then
SqrR.y = wy
GoTo Endy
End If
wx = wx + 1
Wend
wy = wy + 1
Wend
Endy:
'竖向扫描
wx = 0
While wx <= 2
wy = 0
While wy <= 2
If g_Square(wx, wy) Then
SqrR.x = wx
GoTo Endx
End If
wy = wy + 1
Wend
wx = wx + 1
Wend
Endx:
'横向扫描
wy = 2
While wy >= 0
wx = 0
While wx <= 2
If g_Square(wx, wy) Then
SqrR.ey = wy
GoTo Endey
End If
wx = wx + 1
Wend
wy = wy - 1
Wend
Endey:
'竖向扫描
wx = 2
While wx >= 0
wy = 0
While wy <= 2
If g_Square(wx, wy) Then
SqrR.ex = wx
GoTo Endex
End If
wy = wy + 1
Wend
wx = wx - 1
Wend
Endex:
End Sub
'方块矩阵翻转
Sub ChangeSqr()
Dim x As Integer, y As Integer
Dim Sqr(3, 3) As Boolean
y = 0
While y <= 2
x = 0
While x <= 2
Sqr(x, y) = g_Square(x, y)
x = x + 1
Wend
y = y + 1
Wend
Dim x2, y2
y = 0
While y <= 2
x = 0
While x <= 2
g_Square(y, 2 - x) = Sqr(x, y)
x = x + 1
Wend
y = y + 1
Wend
End Sub
'检测当前控制方块是否能处于某一位置
Function CanMove(x As Integer, y As Integer) As Boolean
Dim tx As Integer, ty As Integer
Dim xe As Integer, ye As Integer
'确定方块矩阵最小方形范围
CalSqrRange
If x + SqrR.x < 0 Then '左侧越界
CanMove = False
GoTo EndCanMove
ElseIf x + SqrR.ex > 10 Then '右侧越界
CanMove = False
GoTo EndCanMove
ElseIf y + SqrR.ey > 15 Then '下方越界
CanMove = False
GoTo EndCanMove
End If
'检测是否有方块冲突
ty = y + SqrR.y
While ty <= y + SqrR.ey
tx = x + SqrR.x
While tx <= x + SqrR.ex
If g_Site(tx, ty) And g_Square(tx - x, ty - y) Then
CanMove = False
GoTo EndCanMove
End If
tx = tx + 1
Wend
ty = ty + 1
Wend
CanMove = True
EndCanMove:
End Function
Private Sub Timer_Timer()
Dim x As Integer, y As Integer
Dim i As Integer
Dim SqrCount As Integer '一行方块计数
Dim DelCount As Integer '消除行数计数，用来计算分数
'消除方块
DelCount = 0
y = 15
While y >= 1
x = 0
SqrCount = 0
While x <= 10
If g_Site(x, y) Then
SqrCount = SqrCount + 1
End If
x = x + 1
Wend
If SqrCount = 11 Then '符合消除条件
i = y
While i >= 1
x = 0
While x <= 10
g_Site(x, i) = g_Site(x, i - 1)
x = x + 1
Wend
i = i - 1
Wend
DelCount = DelCount + 1
End If
y = y - 1
Wend
If DelCount = 1 Then
Grades.Caption = Str(Val(Grades.Caption) + 5)
ElseIf DelCount = 2 Then
Grades.Caption = Str(Val(Grades.Caption) + 12)
ElseIf DelCount > 2 Then
Grades.Caption = Str(Val(Grades.Caption) + DelCount * 10)
End If
If CanMove(g_SquarePosX, g_SquarePosY + 1) Then
g_SquarePosY = g_SquarePosY + 1 '方块下降一个单位
Else '方块固化
CalSqrRange
y = g_SquarePosY + SqrR.y
While y <= g_SquarePosY + 2
x = g_SquarePosX + SqrR.x
While x <= g_SquarePosX + 2 And x <= 10
g_Site(x, y) = g_Site(x, y) Or g_Square(x - g_SquarePosX, y - g_SquarePosY)
x = x + 1
Wend
y = y + 1
Wend
If g_SquarePosY + SqrR.y <= 1 Then
MsgBox "抱歉，你输了!"
Timer.Enabled = False
Else
y = 0
While y <= 2
x = 0
While x <= 2
g_Square(x, y) = g_NextSquare(x, y)
x = x + 1
Wend
y = y + 1
Wend
g_SquarePosX = 4
g_SquarePosY = 0
ProduceNextSqr
End If
End If
' GamePage(1).Refresh
Draw
' DrawSquare g_SquarePosX * SQUARESIZE, (g_SquarePosY - 2) * SQUARESIZE
End Sub
