用Excel编写俄罗斯方块（vb做俄罗斯方块）

看到这个题目，想必你一定会感到非常惊讶，什么，Excel居然能开发游戏？没错，Excel的强大取决于使用者，遇强则强，遇弱则弱。但我这篇文章并不是为了展示Excel使用过程中的奇技淫巧，而是主要写给那些准备学习编程但又没什么计算机基础的那些人，或者对Excel感兴趣的那些人。如果你已经是一名有经验的开发者，我也希望你能提出宝贵的意见。

对于那些正在学习编程的人，尤其是那些从其他领域跨入这个行业的人，兴趣才是最大的动力。我从事计算机编程这么长时间，感觉编程是一件非常有意义的事情。然而我却我经常听到有些人，尤其是那些在校学生们抱怨说编程学起来太枯燥了，坚持不下去。我觉得这部分人一方面是方向错了，另一方面就是在实际学习过程中对自己做出成果没有任何的成就感，而后者，往往占据了重要原因。

我认为，对于编程的初学者，选择第一门语言应该具备下面两个特点：

1），尽可能简单，尽量少与底层硬件（诸如内存管理等）相关联，调试方便，IDE界面简单；

2），功能相对强大，能开发各种小插件工具；

就目前行业内比较常用的编程语言中，能够同时满足上述两个特点的也就数Python,office for VBA,Java了，然而，Python虽然简单功能又强大，但是需要配置环境，而且要安装臃肿的IDE，这些对于初学者来说，无形之中又增加了学习成本，更别说Java了，所以剩下的就数VBA(Visual Basic for Application)了。VBA属于visual basic语言的子集，除了继承了部分vb功能外，还特意针对一些软件做了接口封装，使用方便。有人说VBA语法太随意，对于初学者不是件好事，如果学C的话，将来学C++就简单很多了。我不同意这种观点，对于前者，仁者见仁，但后者就是在扯淡，因为C++是一门极其复杂的编程语言，除了继承了C的繁琐指针以外，还衍生出了诸如多重继承、类模板、智能指针等恐怖级别的编程范式，所以说，对于初学者，我不建议直接就去学C++.

为什么选择VBA作为初学者的语言呢，因为他除了满足上面所说的两个特点外，还有一些其他的优点，诸如：

1），使用简单：不需要安装开发工具，更不需要配环境、安装语言包，只要你电脑里面有office软件即可。

2），用途广泛：几乎所有的工程软件、办公软件都支持用VBA做二次开发，例如财务人员如果发现Excel自带的公式有局限性的话，完全可以自己用VBA开发自己需要的控件；机械设计人员如果学了VBA后可以开发一些自己需要的代码块，极大程度地提高自己CAD的绘图速度。很难想象，Excel的重度用户尤其是财务人员不懂VBA的话他的工作量有多可怕。

3），调试简单方便。

所以，这次我也选择VBA作为这次编写Demo的语言，为了照顾更多的初学者，我将每一步的细节都尽可能地呈现出来，由于每个Excel版本不一样，我电脑用的是2010版的，所以，我就用2010版进行说明，其他版本也一样，只是界面可能稍有区别。我相信，只要亲手按照我的方法做出这个游戏，除了你将认识到Excel的强大之处外，你也将逐步体会到编程的乐趣。鉴于时间所限，内容可能有部分疏忽之处，还望大家提出改正。

下面是正文：

首先看一下游戏最终大致的效果图：

首先我们思考一下俄罗斯方块游戏的大致架构：

1），初始化界面：创建方块所需要的地图。

2），随机生成俄罗斯方块：俄罗斯方块总共有7种形态，每种形态均有4个框格组成，每种方块各对应一种颜色。可以创建一个数组存储每种方块的坐标，再用另外一个数组存储方块的对应的颜色。

3），移动旋转方块：分为向左，向右，向下。擦拭完后重新绘制，产生移动旋转的效果。

4），没产生新的方块，都进行一定速度的下落，一旦碰到障碍物，不能下落，再生成新的方块。

5），不断扫描是否有任何一行填满，如果为真，则本行删除，上面下落。每行积分为10分。

首先创建一个Excel文件，随意命名。打开后，由于office默认隐藏了开发工具状态栏，所以我们需要在Excel选项>自定义功能区将其调出来，将其勾选后确认：

随后，我们发现主界面多了开发工具的选项：

我们再在Sheet1表格里面将A~K列的列宽大致调成跟行高一样，让它大致称为一个正方形的区域：

我们点击Visual Basic菜单，打开编写代码界面，我们插入首先插入一个代码模块，用于编写我们自己的代码：

由于方块有7中形状，为了让程序绘制方便，我用一个三维数组存储所有形状的坐标，每种形状都有一个中心坐标(0,0)，其余三个方框的坐标按照中心坐标来计算相对坐标，例如丁字形状的方块：

如果中心的坐标为(0,0)的话，剩余三个从右到左逆时针三个坐标分别为(0,1),(-1,0),(0,-1)，之所以将垂直方向作为X轴是因为Excel坐标的固有属性，例如Cells(1,2)代表第一行第二列个单元格。每个方块的对象有中心坐标，颜色，形状等属性，所以我们需要定义几个模块变量，代码如下：

Option Explicit

Dim MySheet As Worksheet
Dim iCenterRow As Integer   '方块中心行
Dim iCenterCol As Integer   '方块中心列
Dim ColorArr()              '7种颜色
Dim ShapeArr()              '7种方块
Dim iColorIndex As Integer  '颜色索引
Dim MyBlock(4, 2) As Integer    '每个方框的坐标数组，会随着方块的移动而变化
Dim bIsObjectEnd As Boolean     '本个方块是否下降到最低点
Dim iScore As Integer       '分数

考虑到每种方块坐标的不一样，所以我采用一个三维数组来存储方块坐标，为了方便，我采用VBA自带的接口Array()函数给自己的ShapeArr()赋值。同时要在主界面上显示出玩家的分数，所以这两个功能我们作为一个初始化函数，我们定义一个Init()子过程，代码如下：

'初始化 By@yaxi_liu
Private Sub Init()
    Set MySheet = Sheets("Sheet1")
    ColorArr = Array(3, 4, 5, 6, 7, 8, 9)
    ShapeArr = Array(Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(0, 2)), _
                 Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(-1, -1)), _
                 Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(-1, 1)), _
                 Array(Array(0, 0), Array(-1, 1), Array(-1, 0), Array(0, 1)), _
                 Array(Array(0, 0), Array(0, -1), Array(-1, 0), Array(-1, 1)), _
                 Array(Array(0, 0), Array(0, 1), Array(-1, 0), Array(-1, -1)), _
                 Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(-1, 0)))

    With MySheet.Range("B1:K20")
        .Interior.Pattern = xlNone
        .Borders.LineStyle = xlNone

        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeLeft).Weight = xlMedium
    End With

    '设定长宽比例
    MySheet.Columns("A:L").ColumnWidth = 2
    MySheet.Rows("1:30").RowHeight = 13.5

    iScore = 0
    MySheet.Range("N1").Value = "分数"
    MySheet.Range("O1").Value = iScore
End Sub

这时候，我们初始化变量与功能的函数基本上实现了。下一步我们要编写生成一个新方块的函数，为了实现程序的模块化，低耦合，我们将本功能封装成一个独立的函数。

由于绘制函数DrawBlock()需要根据传递过来的做标数组来进行绘制，同时我们需要知道这个方块的中心坐标在哪里，还有对应的颜色，所以我们需要传递4个参数，其中数组需要传址(ByRef)，代码如下：

'绘制方块，By@yaxi_liu
Private Sub DrawBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer, ByVal icolor As Integer)
    Dim Row As Integer, Col As Integer
    Dim i As Integer
    For i = 0 To 3
        Row = center_row + block(i, 0)
        Col = center_col + block(i, 1)
        MySheet.Cells(Row, Col).Interior.ColorIndex = icolor  '颜色索引
        MySheet.Cells(Row, Col).Borders.LineStyle = xlContinuous    '周围加外框线
    Next
End Sub

至此，绘制函数已经完成，为了防止Bug出现，我们需要测试一下，我们再定义一个入口函数，Start(),同时定义一个临时方块数组，调用DrawBlock()进行测试。在主界面添加一个按钮，将其指定到Start函数，并将其拖入合适的位置：

Start函数代码如下：

Sub Start()
    Call Init

    iCenterRow = 5
    iCenterCol = 6
    iColorIndex = 4
    Dim i As Integer
    For i = 0 To 3
        MyBlock(i, 0) = ShapeArr(iColorIndex)(i)(0)
        MyBlock(i, 1) = ShapeArr(iColorIndex)(i)(1)
    Next
    Call DrawBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

我们运行一下，看看效果：

好，测试结果显示完全没问题。

由于后期我们需要在表格最上方的固定位置不断随机生成新的方块，所以我们应该将此功能再次封装为一个独立函数，为了防止产生伪随机数，我们采用Timer作为当前种子，随机生成0~6之间的数组，每个对应形状数组与颜色数组的索引，代码如下：

'随机生成新的方块函数 By@yaxi_liu
Private Sub GetBlock()
    Randomize (Timer)
    Dim i As Integer
    iColorIndex = Int(7 * Rnd)
    iCenterRow = 2
    iCenterCol = 6

    For i = 0 To 3
        MyBlock(i, 0) = ShapeArr(iColorIndex)(i)(0)
        MyBlock(i, 1) = ShapeArr(iColorIndex)(i)(1)
    Next
    Call DrawBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

既然生成了方块，我们就要让方块能够左右下移动，分为三个方向。移动的方法是首先擦除掉当前的方块，再根据规定的移动方向，计算新的坐标，再根据新的坐标重新绘制，这样就产生了移动的现象。但是，在移动之前，我们需要判断是否可以移动。

首先，我们需要编写判断是否能够移动或者旋转的函数CanMoveRotate，此函数很简单，也就是将移动后或者旋转后的坐标传递过来，判断是否越界，或者当前位置上是否有其他颜色即可，代码如下：

'是否能够移动或者旋转函数，By@yaxi_liu
Private Function CanMoveRotate(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer) As Boolean
    '本函数形参均为变换后的坐标

    '首先判断是否越界
    Dim Row As Integer, Col As Integer
    Dim i As Integer
    CanMoveRotate = True
    For i = 0 To 3
        Row = center_row + block(i, 0)
        Col = center_col + block(i, 1)
        If Row > 20 Or Row < 0 Or Col > 11 Or Col < 2 Then      '越界
            CanMoveRotate = False
        End If
        If MySheet.Cells(Row, Col).Interior.Pattern <> xlNone Then  '只要有一个颜色，则为阻挡
            CanMoveRotate = False
        End If
    Next
End Function

我们还需要一个擦除当前方块的函数EraseBlock，根据传递过来的坐标直接擦拭掉，代码如下：

'擦除方块 By@yaxi_liu
Private Sub EraseBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer)
    Dim Row As Integer, Col As Integer
    Dim i As Integer
    For i = 0 To 3
        Row = center_row + block(i, 0)
        Col = center_col + block(i, 1)
        MySheet.Cells(Row, Col).Interior.Pattern = xlNone
        MySheet.Cells(Row, Col).Borders.LineStyle = xlNone
    Next
End Sub

我们再编写移动方块的函数MoveBlock，我们规定，形参direction代表方向，-1代表向左，0代表向下，1代表向右，注意移动后需要保存当前坐标。新增形参direction，代码如下：

'移动方块 By@yaxi_liu
Private Sub MoveBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer, ByVal icolor As Integer, ByVal direction As Integer)
    Dim Row As Integer, Col As Integer
    Dim i As Integer
    Dim old_row As Integer, old_col As Integer  '保存最早的中心坐标
    old_row = center_row
    old_col = center_col

    '首先擦除掉原来位置的
    Call EraseBlock(center_row, center_col, block)

    '-1 代表向左，1 代表向右，0 代表乡下
    Select Case direction
        Case Is = -1
            center_col = center_col - 1
        Case Is = 1
            center_col = center_col + 1
        Case Is = 0
            center_row = center_row + 1
    End Select

    '再绘制
    If CanMoveRotate(center_row, center_col, block) Then
        Call DrawBlock(center_row, center_col, block, icolor)
        '保存中心坐标
        iCenterRow = center_row
        iCenterCol = center_col
    Else
        Call DrawBlock(old_row, old_col, block, icolor)
        '保存中心坐标
        iCenterRow = old_row
        iCenterCol = old_col
        If direction = 0 Then
            bIsObjectEnd = True
        End If
    End If

    '保存方块坐标
    For i = 0 To 3
        MyBlock(i, 0) = block(i, 0)
        MyBlock(i, 1) = block(i, 1)
    Next

End Sub

移动方块实现后，我们再来编写旋转方块函数RotateBlock，这里我们统一规定为逆时针旋转。跟移动函数一样，方法也是先擦除掉旧坐标的后，再根据新坐标绘制出新的方块。只不过旋转稍微麻烦一点。

不难计算出，假如一个向量(x,y)在逆时针旋转90度后的坐标为(-y,x).根据这个公式，编写旋转函数。但是注意事先应该先判断是否达到旋转的条件。代码如下：

'旋转方块函数 By@yaxi_liu
Private Sub RotateBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer, ByVal icolor As Integer)
    Dim i As Integer
    '先擦除原来的
    Call EraseBlock(center_row, center_col, block)
    Dim tempArr(4, 2) As Integer
    '保存数组
    For i = 0 To 3
        tempArr(i, 0) = block(i, 0)
        tempArr(i, 1) = block(i, 1)
    Next
    '旋转后的坐标重新赋值
    For i = 0 To 3
        block(i, 0) = -tempArr(i, 1)
        block(i, 1) = tempArr(i, 0)
    Next i

    '重新绘制新的方块
    If CanMoveRotate(center_row, center_col, block) Then
        Call DrawBlock(center_row, center_col, block, icolor)
        '保存方块坐标
        For i = 0 To 3
            MyBlock(i, 0) = block(i, 0)
            MyBlock(i, 1) = block(i, 1)
        Next
    Else
        Call DrawBlock(center_row, center_col, tempArr, icolor)
        '保存方块坐标
        For i = 0 To 3
            MyBlock(i, 0) = tempArr(i, 0)
            MyBlock(i, 1) = tempArr(i, 1)
        Next
    End If

    '保存中心坐标
    iCenterRow = center_row
    iCenterCol = center_col

End Sub

这时候，旋转、移动函数均已编写完毕。为了能够让游戏相应键盘事件，我们需要在对应的工作表代码层添加事件函数，注意这里我们需要调用Windows API。我们规定键盘的左键为方块向左MoveObject(-1)，右键为方块向右MoveObject(1)，下键为方块向下MoveObject(0)，上键为方块旋转RotateObject()。我们再Sheet1工作表里面编写如下WorkSheet事件代码：

'键盘事件代码，By@yaxi_liu
#If VBA7 And Win64 Then
  Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#Else
  Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim keycode(0 To 255) As Byte
    GetKeyboardState keycode(0)
    If keycode(38) > 127 Then   '上
        Call RotateObject
    ElseIf keycode(39) > 127 Then  '右
        Call MoveObject(1)
    ElseIf keycode(40) > 127 Then '下
        Call MoveObject(0)
    ElseIf keycode(37) > 127 Then '左
        Call MoveObject(-1)
    End If
End Sub

由于我们自己定义的MoveBlock与RotateBlock包类对象的形参，因此事件响应中不能直接调用。在这里我们将用两个 Public 的MoveObject与RotateObject函数在类模块里面再次封装，方便事件调用，代码如下：

'移动对象 By@yaxi_liu
Public Sub MoveObject(ByVal dir As Integer)
    Call MoveBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex), dir)
End Sub

'旋转对象 By@yaxi_liu
Public Sub RotateObject()
    Call RotateBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

至此，方块功能方面已经完全实现，我们随机生成一个进行测试：

为了方便，我们将按钮1里面的文字更改成“启动游戏四个字”：

随后，开始编写程序自动运行的代码。由于俄罗斯方块是生成方块后，按照一定的速度进行下降，一旦碰到障碍物后本方块结束，再生成新的方块，如此循环。由于VBA不支持定时器，所以我们采用while(true)循环的方法进行不断生成方块。为了避免CPU资源过度占用，我们在循环之间加入延时函数，供循环调用，代码如下：

'延时函数 By@yaxi_liu
Private Sub delay(T As Single)
    Dim T1 As Single
    T1 = Timer
    Do
        DoEvents
    Loop While Timer - T1 < T
End Sub

在下降过程中，我们需要知道是否某一行已经满了，判断的方法很简单，查询整行是否全部涂色即可。如果满了，我们删除本行，同时将第一行到本行下降填充。同时更新分数。因此我们再引入一个函数DeleteFullRow，代码如下：

'消除满行函数 By@yaxi_liu
Private Sub DeleteFullRow()
    Dim i As Integer, j As Integer
    For i = 1 To 20
        For j = 2 To 11
            If MySheet.Cells(i, j).Interior.ColorIndex < 0 Then
                Exit For
            ElseIf j = 11 Then
                MySheet.Range(Cells(1, 2), Cells(i - 1, j)).Cut Destination:=MySheet.Range(Cells(2, 2), Cells(i, j))       'Range("B2:K18")
                iScore = iScore + 10
            End If
        Next j
    Next i
    MySheet.Range("N1").Value = "分数"
    MySheet.Range("O1").Value = iScore
End Sub

再在Start()函数里面添加while循环，上面两个函数一样添加进去代码如下：

'启动函数 By@yaxi_liu
Sub Start() 
	Call Init 
  While (True) 
		Call GetBlock 
    bIsObjectEnd = False '本方块对象是否结束 
		While (bIsObjectEnd = False) 
				Call delay(0.5) 
				Call MoveBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex), 0) 
				MySheet.Range("L21").Select 
				With MySheet.Range("B1:K20") 
          	.Borders(xlEdgeBottom).Weight = xlMedium 
          	.Borders(xlEdgeRight).Weight = xlMedium 
          	.Borders(xlEdgeLeft).Weight = xlMedium 
			End With 
    Wend 
    Call DeleteFullRow 
  Wend
End Sub

到这里，本游戏的编写就算彻底结束了，点击Sheet1界面上面的“按钮1”按钮即可开始游戏。我们再试玩一下，向左键代表向左，右键代表向右，上键代表旋转，下键代表下降。看一下效果：

哈哈，试玩结束没问题，非常完美，过程虽然长久，但值得你细细研究，也希望你能从中够体会到编程的乐趣。