看到这个题目,想必你一定会感到非常惊讶:什么,Excel居然能开发游戏?
没错,Excel的强大取决于使用者,遇强则强,遇弱则弱。但这篇文章并不是为了展示Excel使用过程中的奇技淫巧,而是写给那些准备学习编程,但又没什么计算机基础的,或者对Excel感兴趣的那些人。如果这篇文章对你有一定帮助,希望你能够将这片文章分享出去,让更多的人看到;如果你已经是一名有经验的开发者,也希望你能提出宝贵的意见。
1. 尽可能简单,尽量少与底层硬件(诸如内存管理等)相关联,调试方便,IDE界面简单;
2. 功能相对强大,能开发各种小插件工具。
为什么选择VBA作为初学者的语言呢?因为它除了满足上面所说的两个特点之外,还有一些其它优点:
所以,这次我也选择VBA作为这次编写Demo的语言,为了照顾更多的初学者,我将每一步的细节都尽可能地呈现出来,由于每个Excel版本不一样,我电脑用的是2010版的,所以我就用2010版进行说明,其他版本也一样,只是界面可能稍有区别。
我相信,只要按照以下方法做出这个游戏,除了你将认识到Excel的强大之处,你也将逐步体会到编程的乐趣。鉴于时间所限,内容可能有部分疏忽之处,还望大家提出改正。
下面是正文
首先,看一下游戏最终大致的效果图:
我们思考一下俄罗斯方块游戏的大致架构:
第一步,创建一个Excel文件,随意命名。打开后,由于office默认隐藏了开发工具状态栏,所以我们需要在Excel选项>自定义功能区将其调出来,将其勾选后确认:
随后,我们发现主界面多了开发工具的选项:
我们再在Sheet1表格里面将A~K列的列宽大致调成跟行高一样,让它大致称为一个正方形的区域:
由于方块有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”按钮即可开始游戏。我们再试玩一下,向左键代表向左,右键代表向右,上键代表旋转,下键代表下降。看一下效果:
哈哈,试玩结束没问题,非常完美,过程虽然长久,但值得你细细研究,也希望你能从中够体会到编程的乐趣。如果您觉得学到了知识,希望您将这篇文章分享给更多的人,谢谢!