用VB6实现俄罗斯方块游戏(游戏编程入门教程)&追爱

[fangcunx]

俄罗斯方块作为一个经典游戏被广泛实现于各种平台
对于新手而言用来游戏编程入门是一个不错的选择

本教程将教你如何用VB6实现一个俄罗斯方块游戏

代码量仅有10kb多

图片如下


代码附件含音乐较大上传不了在这里下载
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

如前面所讲，方块使用3*3的0-1数组标示的，
那么绘制方块的过程就是遍历数组
如果g_Square(x,y)=1那么就绘制出小正方形，否则不绘制

程序代码：

'绘制下一方块
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

问题要来了，
虽然用0-1数组标示方块很好，但有一个问题是数组并没有被完全使用
如标示拐杖形的0-1数组
1，1，0
0，1，0
0，1，0
(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

那么如何判断方块能否落入某一区域？

游戏使用g_Site的0-1数组标示已经固化的方块

对方块数组和g_Site相对位置的数组元素进行And(位与)操作
如果有一个结果为1，就说明不可以移入
代码如下
程序代码：

'检测当前控制方块是否能处于某一位置
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

到这里游戏实现已经很清晰了，
只要检测要移入的位置是否可移入，来移动方块

那么如何实现方块的自动下降呢？
用Timer控件，每隔一段时间方块的y坐标+1，
并检测下是否有可以消除的方块

代码如下

程序代码：

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

最后此贴为追爱而发，希望觉得还不错的朋友
为了向一个女孩证明自己决定寻找一千个陌生人祝福，
希望你能留下你的祝福
谢谢
地址：
http://blog.sina.com.cn/s/blog_b2bbe82101016jum.html

[c_cyd2008]

[quote=引用 楼主 renjie010 的回复:] 为了向一个女孩证明自己决定寻找一千个陌生人祝福， 希望你能留下你的祝福 [quote] 这东西能证明什么，我都不信了。 不过还是祝福你！

[宋习侠]

这么辛苦，祝福你吧！

[王二.麻子]

辛苦了 应该是4*4的矩阵,还有大长条..

[w0123456789012345]

大大，我可以跟您要vb的程式資料夾檔案嗎?我還是初學者，第一次接觸程式設計，想要了解大大如何去完成遊戲。 [e-mail] (以上是我的信箱網址) 希望大大可以幫忙^^ 謝謝

[wubudomain]

祝福你！！