|
关键词：Excel游戏VBA 2048 游戏开发教程 作者：Einsphoton 微信公众平台：GamesDesigner VBA对游戏开发的流程帮助甚微，甚至影响游戏开发效率，本应用实例仅为消遣，切勿过分关注！ 前言 抱歉，这可能是我最后的几篇文章之一了。 由于最近工作中遇到很多问题，作者现在处于自我检讨中，恐怕以后将要告别少年时代的“装逼梦”了。 作者之后，需要洗心革面，重新做人，踏踏实实，本本分分，低调为人，从最底层做起。 接下来，还会再分享一些有关Axure的酷炫特效技巧，然后封笔。 感谢大家这段时间的支持，以及各路的批评。 前期准备l 搭建如下图界面环境，仅需要用到Excel自带功能待见，例如单元格颜色，绘制表格等，数两个数字2的方块先不用管。 l 按照下图指示，分别对几个对象进行命名。 l 创建一个按钮
程序的流程图 游戏过程非常简单。 当用户点击游戏开始按钮，系统先将所有数据初始化，并且随机生成两个方块，当玩家进行上下左右移动时，方块也会随之移动，并且在移动的过程中判断是否合并是否产生新的方块，以及是否游戏结束。 游戏的程序逻辑共由一下几部分组成： | | | 游戏的启动器（在游戏中，以“GameStart”按钮的形式体现），主要负责通知何时开启游戏流程。 | | | | | | | | |
开始编写代码 按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 '在空白方格中随机找一个 Next 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(ByValTarget As Range) Application.EnableEvents = False IsCanMove = False With Target If .Row = Range("GamePad").Cells(1, 2).Row Then 'MsgBox ("↑") Call UpMove '调用三次方块移动方法，为什么？大家可以思考一下！ Call UpMove Call UpMove ElseIf .Column = Range("GamePad").Cells(2, 1).Column Then 'MsgBox ("←") Call LeftMove Call LeftMove Call LeftMove ElseIf .Row = Range("GamePad").Cells(3, 2).Row Then 'MsgBox ("↓") Call DownMove Call DownMove Call DownMove ElseIf .Column = Range("GamePad").Cells(2, 3).Column Then 'MsgBox ("→") Call RightMove Call RightMove 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 End If If Range("GameArea").SpecialCells(xlCellTypeConstants).Count =16 Then '如果没有任何空位了 IsGameOver = True For i = 1 To 4 '并且也无法合并了 For j = 1 To 4 IfRange("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 If End Sub 最后 你以为就这样结束了么？太天真了！至此游戏虽然可以运行，但貌似缺少点什么？ 你的美术表现呢？ 起码得有点颜色吧！ 在Excel里面，可以有一种超级轻松的方式实现这种美术表现。 条件格式……………………………………
| 
发表于 2014-12-5 15:27:50
