手把手教你用 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_li uPrivate 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     '保存方块坐标    F     or 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”按钮即可开始游戏。我们再试玩一下，向左键代表向左，右键代表向右，上键代表旋转，下键代表下降。看一下效果：

哈哈，试玩结束没问题，非常完美，过程虽然长久，但值得你细细研究，也希望你能从中够体会到编程的乐趣。如果您觉得学到了知识，希望您将这篇文章分享给更多的人，谢谢！

如果你想要源代码文件，请在文章开头部分点击我的名字关注我的公众号，在对话栏里面回复“俄罗斯方块”五个字即可，我会将源代码以及文件都发送给你，方便你后期研究代码学习。

本文来自微信公众号：，作者：刘亚曦