Excel_VBA开发2048游戏教程——Einsphoton

短命女 2022-06-08 08:27 643阅读 0赞

VBA对游戏开发的流程帮助甚微，甚至影响游戏开发效率，本应用实例仅为消遣，切勿过分关注！

# 前言 #

抱歉，这可能是我最后的几篇文章之一了。

由于最近工作中遇到很多问题，作者现在处于自我检讨中，恐怕以后将要告别少年时代的“装逼梦”了。

作者之后，需要洗心革面，重新做人，踏踏实实，本本分分，低调为人，从最底层做起。

接下来，还会再分享一些有关Axure的酷炫特效技巧，然后封笔。

感谢大家这段时间的支持，以及各路的批评。

# 前期准备 #

l  搭建如下图界面环境，仅需要用到Excel自带功能待见，例如单元格颜色，绘制表格等，数两个数字2的方块先不用管。

l  按照下图指示，分别对几个对象进行命名。

l  创建一个按钮

[![Excel\_VBA开发2048游戏教程——Einsphoton][Excel_VBA_2048_Einsphoton]][Excel_VBA_2048_Einsphoton_Excel_VBA_2048_Einsphoton]

# 程序的流程图 #

游戏过程非常简单。

当用户点击游戏开始按钮，系统先将所有数据初始化，并且随机生成两个方块，当玩家进行上下左右移动时，方块也会随之移动，并且在移动的过程中判断是否合并是否产生新的方块，以及是否游戏结束。

[![Excel\_VBA开发2048游戏教程——Einsphoton][Excel_VBA_2048_Einsphoton 1]][Excel_VBA_2048_Einsphoton_Excel_VBA_2048_Einsphoton 1]

游戏的程序逻辑共由一下几部分组成：

<table style="margin:0px; padding:0px; color:rgb(70,70,70); font-family:&quot;Microsoft YaHei&quot;,&quot;Helvetica Neue&quot;,SimSun; font-size:14px; border-width:medium; border-style:none; border-color:initial; border-collapse:collapse"> 
 <tbody> 
 <tr> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:1pt medium 1pt 1pt; border-style:solid none solid solid; border-bottom-color:rgb(237,125,49); border-left-color:rgb(237,125,49); width:84.8pt; border-top-color:rgb(237,125,49); border-right-color:initial"> 逻辑方法 </td> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:1pt 1pt 1pt medium; border-style:solid solid solid none; border-bottom-color:rgb(237,125,49); border-left-color:initial; width:330pt; border-top-color:rgb(237,125,49); border-right-color:rgb(237,125,49)"> 作用 </td> 
 </tr> 
 <tr> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium medium 1pt 1pt; border-style:none none solid solid; border-bottom-color:rgb(244,176,131); border-left-color:rgb(244,176,131); width:84.8pt; border-top-color:initial; border-right-color:initial"> StartTigger </td> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium 1pt 1pt medium; border-style:none solid solid none; border-bottom-color:rgb(244,176,131); border-left-color:initial; width:330pt; border-top-color:initial; border-right-color:rgb(244,176,131)"> 游戏的启动器（在游戏中，以“GameStart”按钮的形式体现），主要负责通知何时开启游戏流程。 </td> 
 </tr> 
 <tr> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium medium 1pt 1pt; border-style:none none solid solid; border-bottom-color:rgb(244,176,131); border-left-color:rgb(244,176,131); width:84.8pt; border-top-color:initial; border-right-color:initial"> GameStart </td> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium 1pt 1pt medium; border-style:none solid solid none; border-bottom-color:rgb(244,176,131); border-left-color:initial; width:330pt; border-top-color:initial; border-right-color:rgb(244,176,131)"> 主要负责游戏的初始化 </td> 
 </tr> 
 <tr> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium medium 1pt 1pt; border-style:none none solid solid; border-bottom-color:rgb(244,176,131); border-left-color:rgb(244,176,131); width:84.8pt; border-top-color:initial; border-right-color:initial"> TileController </td> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium 1pt 1pt medium; border-style:none solid solid none; border-bottom-color:rgb(244,176,131); border-left-color:initial; width:330pt; border-top-color:initial; border-right-color:rgb(244,176,131)"> 负责游戏方块对象的移动，以及相应的逻辑检测 </td> 
 </tr> 
 <tr> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium medium 1pt 1pt; border-style:none none solid solid; border-bottom-color:rgb(244,176,131); border-left-color:rgb(244,176,131); width:84.8pt; border-top-color:initial; border-right-color:initial"> TileCreator </td> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium 1pt 1pt medium; border-style:none solid solid none; border-bottom-color:rgb(244,176,131); border-left-color:initial; width:330pt; border-top-color:initial; border-right-color:rgb(244,176,131)"> 负责游戏方块的生产 </td> 
 </tr> 
 <tr> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium medium 1pt 1pt; border-style:none none solid solid; border-bottom-color:rgb(244,176,131); border-left-color:rgb(244,176,131); width:84.8pt; border-top-color:initial; border-right-color:initial"> GameOverChecker </td> 
 <td style="margin:0px; padding:0cm 5.4pt; font-family:Verdana,宋体,sans-serif; line-height:18px; border-width:medium 1pt 1pt medium; border-style:none solid solid none; border-bottom-color:rgb(244,176,131); border-left-color:initial; width:330pt; border-top-color:initial; border-right-color:rgb(244,176,131)"> 负责检测游戏是否已经达成“游戏结束”的条件 </td> 
 </tr> 
 </tbody> 
</table>

# 开始编写代码 #

按ALT + F11打开Excel自带的代码编辑器。

## 变量定义 ##

Option Explicit    ‘安全编码习惯

Dim IsGameOver As Boolean

Dim IsCanMove As Boolean

Dim AnotherChance As Integer

Dim CurrentScore, HighScore As Long

## CreatTile方法 ##

次方法主要用来生产方块，在每次移动操作以及游戏的初始化都会用到这个方法。

Private Sub CreatTile()

Dim r, c As Range

Dim i, n As Integer

Set r = Range("GameArea").SpecialCells(xlCellTypeBlanks)    '取出游戏区域中所有的空白方格

n = Int(Rnd \* r.Count + 1)                              '随机一个数

For Each c In Range("GameArea").SpecialCells(xlCellTypeBlanks)

i = i + 1

If i = n Then Exit For                           '在空白方格中随机找一个

c.Value = 2                                      '使它变成方格2

End Sub

## GameStart方法 ##

GameStart方法主要用来游戏初始化

Private Sub GameStart()

Range("GameArea").ClearContents                              '清除游戏区域的所有内容

Shapes("CurrentScore").TextEffect.Text = Format(0, "000000")        '清除当前分数

Range("GamePad").Cells(2, 2).Activate

Call CreatTile                                               '调用创建方块方法2次

Call CreatTile

End Sub

## TileController方法集 ##

在这里，我们要编写控制方格移动并且合并的方法。由于游戏中我们可以上下左右移动，所以我们需要分别编写上下左右移动的方法。如下：

Private Sub DownMove()

Dim i, j As Integer

With Range("GameArea")

For i = 3 To 1 Step -1         '从倒数第三行开始，其上的每一行的所有小方格

For j = 1 To 4

If .Cells(i + 1, j) = "" And .Cells(i, j) <> "" Then

.Cells(i + 1, j) = .Cells(i, j)  '遇到可以移动的情况

.Cells(i, j).ClearContents

IsCanMove = True

ElseIf .Cells(i + 1, j) = .Cells(i, j) And .Cells(i, j) <> "" Then

.Cells(i + 1, j) = .Cells(i + 1, j) \* 2   '遇到可以合并的情况

CurrentScore = CurrentScore + .Cells(i, j) \* 2

Shapes("CurrentScore").TextEffect.Text = CurrentScore   '加分

.Cells(i, j).ClearContents

IsCanMove = True

End If

Next j

Next i

End With

End Sub

其他方向的同理

Private Sub UpMove()

Dim i, j As Integer

With Range("GameArea")

For i = 2 To 4

For j = 1 To 4

If .Cells(i - 1, j) = "" And .Cells(i, j) <> "" Then

.Cells(i - 1, j) = .Cells(i, j)

.Cells(i, j).ClearContents

IsCanMove = True

ElseIf .Cells(i - 1, j) = .Cells(i, j) And .Cells(i, j) <> "" Then

.Cells(i - 1, j) = .Cells(i - 1, j) \* 2

CurrentScore = CurrentScore + .Cells(i, j) \* 2

Shapes("CurrentScore").TextEffect.Text = CurrentScore

.Cells(i, j).ClearContents

IsCanMove = True

End If

Next j

Next i

End With

End Sub

Private Sub LeftMove()

Dim i, j As Integer

With Range("GameArea")

For i = 2 To 4

For j = 1 To 4

If .Cells(j, i - 1) = "" And .Cells(j, i) <> "" Then

.Cells(j, i - 1) = .Cells(j, i)

.Cells(j, i).ClearContents

IsCanMove = True

ElseIf .Cells(j, i - 1) = .Cells(j, i) And .Cells(j, i) <> "" Then

.Cells(j, i - 1) = .Cells(j, i - 1) \* 2

CurrentScore = CurrentScore + .Cells(j, i) \* 2

Shapes("CurrentScore").TextEffect.Text = CurrentScore

.Cells(j, i).ClearContents

IsCanMove = True

End If

Next j

Next i

End With

End Sub

Private Sub RightMove()

Dim i, j As Integer

With Range("GameArea")

For i = 3 To 1 Step -1

For j = 1 To 4

If .Cells(j, i + 1) = "" And .Cells(j, i) <> "" Then

.Cells(j, i + 1) = .Cells(j, i)

.Cells(j, i).ClearContents

IsCanMove = True

ElseIf .Cells(j, i + 1) = .Cells(j, i) And .Cells(j, i) <> "" Then

.Cells(j, i + 1) = .Cells(j, i + 1) \* 2

CurrentScore = CurrentScore + .Cells(j, i) \* 2

Shapes("CurrentScore").TextEffect.Text = CurrentScore

.Cells(j, i).ClearContents

IsCanMove = True

End If

Next j

Next i

End With

End Sub

## 游戏控制器的编写 ##

到这里，游戏大部分的机制都已经写好，但我们还需要给我们的游戏设计一个用户接口。我们可以利用Excel自带的事件监听器Worksheet\_SelectionChange，来设计游戏的操控方式。思路是，我们设置一个默认的单元格，并且总是保证其焦点。每当用户操作方向键，或者点击鼠标，我们都可以抓住一个瞬间的单元格焦点位置的变化，之后又会回到默认的单元格焦点。具体方法如下：

Private Sub Worksheet\_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False

IsCanMove = False

With Target

If .Row = Range("GamePad").Cells(1, 2).Row Then

'MsgBox ("↑")

Call UpMove    '调用三次方块移动方法，为什么？大家可以思考一下！

Call UpMove

ElseIf .Column = Range("GamePad").Cells(2, 1).Column Then

'MsgBox ("←")

Call LeftMove

ElseIf .Row = Range("GamePad").Cells(3, 2).Row Then

'MsgBox ("↓")

Call DownMove

ElseIf .Column = Range("GamePad").Cells(2, 3).Column Then

'MsgBox ("→")

Call RightMove

End If

End With

Range("GamePad").Cells(2, 2).Activate   '默认单元格获得焦点

Call CheckGameOver

If IsCanMove Then Call CreatTile        '如果发生移动了，创造一个新方块

Application.EnableEvents = True

End Sub

## GameOverChecker方法编写 ##

导致游戏结束的原因有两种：①胜利（出现2048）  ②失败（无法移动）

在这里，我们也需要分别检测这两种情况。

Private Sub CheckGameOver()

Dim i, j As Integer

IsGameOver = False

If Not Range("GameArea").Find(2048) Is Nothing Then    '如果出现2048，则执行游戏胜利流程

IsGameOver = True

MsgBox ("You Did Splendid Job")

If CurrentScore > HighScore Then              '交换分数

HighScore = CurrentScore

Shapes("HighScore").TextEffect.Text = HighScore

End If

If Range("GameArea").SpecialCells(xlCellTypeConstants).Count = 16 Then   '如果没有任何空位了

IsGameOver = True

For i = 1 To 4                             '并且也无法合并了

For j = 1 To 4

If Range("GameArea").Cells(i, j) = Range("GameArea").Cells(i, j + 1) Or Range("GameArea").Cells(i, j) = Range("GameArea").Cells(i + 1, j) Then IsGameOver = False

Next j

Next i

If IsGameOver = True Then

MsgBox ("Game Over")

If CurrentScore > HighScore Then

HighScore = CurrentScore

Shapes("HighScore").TextEffect.Text = HighScore

End If

Call GameStart                  '重新开始一局

End If

End Sub

# 最后 #

你以为就这样结束了么？太天真了！至此游戏虽然可以运行，但貌似缺少点什么？

你的美术表现呢？

起码得有点颜色吧！

在Excel里面，可以有一种超级轻松的方式实现这种美术表现。

条件格式……………………………………

[Excel_VBA_2048_Einsphoton]: http://s12.sinaimg.cn/mw690/002UUI0Lgy6O91bVhft0b&690
[Excel_VBA_2048_Einsphoton_Excel_VBA_2048_Einsphoton]: /images/20220608/ebeb85aa8ee940b78a08e2c11f25a01b.png
[Excel_VBA_2048_Einsphoton 1]: http://s3.sinaimg.cn/mw690/002UUI0Lgy6O91dEinoa2&690
[Excel_VBA_2048_Einsphoton_Excel_VBA_2048_Einsphoton 1]: /images/20220608/8ef29c0946a04f0d8a1338d1ad6212ad.png