Excel_VBA开发2048游戏教程——Einsphoton

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

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

前言

  1.      抱歉，这可能是我最后的几篇文章之一了。
  3.      由于最近工作中遇到很多问题，作者现在处于自我检讨中，恐怕以后将要告别少年时代的“装逼梦”了。
  5.      作者之后，需要洗心革面，重新做人，踏踏实实，本本分分，低调为人，从最底层做起。
  7.      接下来，还会再分享一些有关Axure的酷炫特效技巧，然后封笔。
  9.      感谢大家这段时间的支持，以及各路的批评。

前期准备

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

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

l 创建一个按钮

Excel\_VBA开发2048游戏教程——Einsphoton

程序的流程图

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

Excel\_VBA开发2048游戏教程——Einsphoton 

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



























逻辑方法

作用

StartTigger

游戏的启动器（在游戏中，以“GameStart”按钮的形式体现），主要负责通知何时开启游戏流程。

GameStart

主要负责游戏的初始化

TileController

负责游戏方块对象的移动，以及相应的逻辑检测

TileCreator

负责游戏方块的生产

GameOverChecker

负责检测游戏是否已经达成“游戏结束”的条件

开始编写代码

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

变量定义

Option Explicit ‘安全编码习惯

Dim IsGameOver As Boolean

Dim IsCanMove As Boolean

Dim AnotherChance As Integer

Dim CurrentScore, HighScore As Long

CreatTile方法

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

Private Sub CreatTile()

  1. Dim r, c As Range
  3. Dim i, n As Integer
  5. Set r = Range("GameArea").SpecialCells(xlCellTypeBlanks)    '取出游戏区域中所有的空白方格
  7. n = Int(Rnd \* r.Count + 1)                              '随机一个数
  9. For Each c In Range("GameArea").SpecialCells(xlCellTypeBlanks)
  11.     i = i + 1
  13.     If i = n Then Exit For                           '在空白方格中随机找一个
  15. Next
  17. c.Value = 2                                      '使它变成方格2

End Sub

GameStart方法

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

Private Sub GameStart()

  1. Range("GameArea").ClearContents                              '清除游戏区域的所有内容
  3. Shapes("CurrentScore").TextEffect.Text = Format(0, "000000")        '清除当前分数

Range(“GamePad”).Cells(2, 2).Activate

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

End Sub

TileController方法集

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

Private Sub DownMove()

  1. Dim i, j As Integer
  3. With Range("GameArea")
  5.     For i = 3 To 1 Step -1         '从倒数第三行开始，其上的每一行的所有小方格
  7.         For j = 1 To 4
  9.             If .Cells(i + 1, j) = "" And .Cells(i, j) <> "" Then
  11.                 .Cells(i + 1, j) = .Cells(i, j)  '遇到可以移动的情况
  13.                 .Cells(i, j).ClearContents
  15.                 IsCanMove = True
  17.             ElseIf .Cells(i + 1, j) = .Cells(i, j) And .Cells(i, j) <> "" Then
  19.                 .Cells(i + 1, j) = .Cells(i + 1, j) \* 2   '遇到可以合并的情况
  21.                 CurrentScore = CurrentScore + .Cells(i, j) \* 2
  23.                 Shapes("CurrentScore").TextEffect.Text = CurrentScore   '加分
  25.                 .Cells(i, j).ClearContents
  27.                 IsCanMove = True
  29.             End If
  31.         Next j
  33.     Next i
  35. End With

End Sub

其他方向的同理

Private Sub UpMove()

  1. Dim i, j As Integer
  3. With Range("GameArea")
  5.     For i = 2 To 4
  7.         For j = 1 To 4
  9.             If .Cells(i - 1, j) = "" And .Cells(i, j) <> "" Then
  11.                 .Cells(i - 1, j) = .Cells(i, j)
  13.                 .Cells(i, j).ClearContents
  15.                 IsCanMove = True
  17.             ElseIf .Cells(i - 1, j) = .Cells(i, j) And .Cells(i, j) <> "" Then
  19.                 .Cells(i - 1, j) = .Cells(i - 1, j) \* 2
  21.                 CurrentScore = CurrentScore + .Cells(i, j) \* 2
  23.                 Shapes("CurrentScore").TextEffect.Text = CurrentScore
  25.                 .Cells(i, j).ClearContents
  27.                 IsCanMove = True
  29.             End If
  31.         Next j
  33.     Next i
  35. End With

End Sub

Private Sub LeftMove()

  1. Dim i, j As Integer
  3. With Range("GameArea")
  5.     For i = 2 To 4
  7.         For j = 1 To 4
  9.             If .Cells(j, i - 1) = "" And .Cells(j, i) <> "" Then
  11.                 .Cells(j, i - 1) = .Cells(j, i)
  13.                 .Cells(j, i).ClearContents
  15.                 IsCanMove = True
  17.             ElseIf .Cells(j, i - 1) = .Cells(j, i) And .Cells(j, i) <> "" Then
  19.                 .Cells(j, i - 1) = .Cells(j, i - 1) \* 2
  21.                 CurrentScore = CurrentScore + .Cells(j, i) \* 2
  23.                 Shapes("CurrentScore").TextEffect.Text = CurrentScore
  25.                 .Cells(j, i).ClearContents
  27.                 IsCanMove = True
  29.             End If
  31.         Next j
  33.     Next i
  35. End With

End Sub

Private Sub RightMove()

  1. Dim i, j As Integer
  3. With Range("GameArea")
  5.     For i = 3 To 1 Step -1
  7.         For j = 1 To 4
  9.             If .Cells(j, i + 1) = "" And .Cells(j, i) <> "" Then
  11.                 .Cells(j, i + 1) = .Cells(j, i)
  13.                 .Cells(j, i).ClearContents
  15.                 IsCanMove = True
  17.             ElseIf .Cells(j, i + 1) = .Cells(j, i) And .Cells(j, i) <> "" Then
  19.                 .Cells(j, i + 1) = .Cells(j, i + 1) \* 2
  21.                 CurrentScore = CurrentScore + .Cells(j, i) \* 2
  23.                 Shapes("CurrentScore").TextEffect.Text = CurrentScore
  25.                 .Cells(j, i).ClearContents
  27.                 IsCanMove = True
  29.             End If
  31.         Next j
  33.     Next i
  35. End With

End Sub

游戏控制器的编写

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  1. Application.EnableEvents = False
  3. IsCanMove = False
  5. With Target
  7.     If .Row = Range("GamePad").Cells(1, 2).Row Then
  9.         'MsgBox ("↑")
  11.         Call UpMove    '调用三次方块移动方法，为什么？大家可以思考一下！
  13.         Call UpMove
  15.         Call UpMove
  17.     ElseIf .Column = Range("GamePad").Cells(2, 1).Column Then
  19.         'MsgBox ("←")
  21.         Call LeftMove
  23.         Call LeftMove
  25.         Call LeftMove
  27.     ElseIf .Row = Range("GamePad").Cells(3, 2).Row Then
  29.         'MsgBox ("↓")
  31.         Call DownMove
  33.         Call DownMove
  35.         Call DownMove
  37.     ElseIf .Column = Range("GamePad").Cells(2, 3).Column Then
  39.         'MsgBox ("→")
  41.         Call RightMove
  43.         Call RightMove
  45.         Call RightMove
  47.     End If
  49. End With
  51. Range("GamePad").Cells(2, 2).Activate   '默认单元格获得焦点
  53. Call CheckGameOver
  55. If IsCanMove Then Call CreatTile        '如果发生移动了，创造一个新方块
  57. Application.EnableEvents = True

End Sub

GameOverChecker方法编写

  1.      导致游戏结束的原因有两种：①胜利（出现2048）  ②失败（无法移动）
  3.      在这里，我们也需要分别检测这两种情况。

Private Sub CheckGameOver()

  1. Dim i, j As Integer
  3. IsGameOver = False
  5. If Not Range("GameArea").Find(2048) Is Nothing Then    '如果出现2048，则执行游戏胜利流程
  7. IsGameOver = True
  9. MsgBox ("You Did Splendid Job")
  11.     If CurrentScore > HighScore Then              '交换分数
  13.         HighScore = CurrentScore
  15.         Shapes("HighScore").TextEffect.Text = HighScore
  17.     End If
  19. End If
  21. If Range("GameArea").SpecialCells(xlCellTypeConstants).Count = 16 Then   '如果没有任何空位了
  23.     IsGameOver = True
  25.     For i = 1 To 4                             '并且也无法合并了
  27.         For j = 1 To 4
  29.             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
  31.         Next j
  33.     Next i
  35.     If IsGameOver = True Then
  37.         MsgBox ("Game Over")
  39.         If CurrentScore > HighScore Then
  41.             HighScore = CurrentScore
  43.             Shapes("HighScore").TextEffect.Text = HighScore
  45.         End If
  47.         Call GameStart                  '重新开始一局
  49.     End If
  51. End If

End Sub

最后

  1.      你以为就这样结束了么？太天真了！至此游戏虽然可以运行，但貌似缺少点什么？
  3.      你的美术表现呢？
  5.      起码得有点颜色吧！
  7.      在Excel里面，可以有一种超级轻松的方式实现这种美术表现。
  9.      条件格式……………………………………

发表评论

表情：
评论列表 （有 0 条评论，808人围观）

还没有评论，来说两句吧...

相关阅读

    相关 如何平衡MMO游戏 ——Einsphoton

    前言     这是一篇出自国外博客“Elder Game”的一篇文章，笔者觉得里面很多东西说的很有道理，并且这也正是国内游戏设计者所欠缺的精神。所以笔者利用工作之余拜读文

    短命女短命女/ 0 赞/ 350 阅读

    相关 2048小游戏

    ![在这里插入图片描述][70] 思想 简述项目： 1.功能：该项目完成的功能就是通过上下左右键，使相同的方块进行合并，相同的方块合并时，会将方块上面的值变为原来的

    忘是亡心i忘是亡心i/ 0 赞/ 433 阅读