音游UP主居然写程序教学专栏系列第1期 基于VB.NET语言编写小游戏《2048》
发布时间:2023-01-30 00:54:20 来源:哔哩哔哩

一、前言


(相关资料图)

由于本专栏是我的第一次编写程序教学的尝试,前言部分多寒暄几句,没错,你们没目害,一个音游屑up主现在闲着没事干开始写屑程序啦,嘿嘿嘿~

写程序的爱好和我打音游的爱好其实是一并开始的,扯到音游上的年代,大概是初中时期,我接触Cytus初代的时间,也是我玩的第一款音游,几乎同期我摸到了VB 6.0,并真正开始用if then结构写各种弹窗微型闯关游戏了,仔细想想当年就会写剧情发展树真是不得了呢。

VB的程序用语和编写习惯从那时起就根深蒂固了,现在VB 6.0进化到了VB.net,虽然这两种语言也有很大差异,但用VB的语句构思逻辑已经很难改变了,所以,我的教学专栏是100%纯VB.net语言编写,这确实和现在的时代落差相当大,但我真的。。。emmm,不想换语言从头熟悉了,摸过python,但真正玩起来还是磕磕绊绊的,不像VB.net那样顺手,同时python给我了一个巨大的手癖,写循环总是for i in [数组],然而VB是不认识的。

《2048》这款游戏具有非常强烈的时代特征,它诞生于2014年,作为一款爆款手游横行霸道,参考最近的案例就是《羊了个羊》的火爆程度,那时几乎人人都在手机上搓搓搓,然后晒一个大大的黄色2048表示自己毕业了。2014年我正好读大一,选修了一门VB.net课程,开始系统性学习编程的概念,掌握了很多新的VB功能,而不是单纯的if then加按钮的简陋组合了,有幸,这是我第一次上手编写有简单界面的游戏。它相对我后期开发的游戏,显得比较简陋,功能单一,代码量也比较少,但可以拿来先做一次专栏编写的尝试,我尝试把这个系列的教学专栏写给编程的入门小白,让大多数初学者看懂并且可以自己操作,就像我的音游专栏初衷一样,写给入门者,开发兴趣之用。

本系列专栏内容我更多偏重于写关键功能实现的逻辑,淡化编程语言的使用(因为我也不是专业程序猿hhh),如果各位读者并没有使用过VB.net,希望本篇也可以提供相关思路,帮助你们用自己所学的编程语言去实现,就好比我用private sub func(),可以换成c语言的void func(),也可以换成python的def func(),思路到了,编程语言只是一个工具去实现我们的思路。

二、编程环境简介

开发工具:Microsoft Visual Studio 2013及以上版本(这个IDE可以实时代码查错,并且具有代码单词分颜色、代码自动分段错位,高亮变量、代码预测等功能,很人性化,推荐使用);

编程框架:Microsoft .NET Framework 4.5及以上版本;

电脑配置:intel 13900k处理器+ NVIDIA 4090Ti显卡(误,随便弄个电脑就可以嘿嘿);

外设硬件:鼠标键盘显示器,加一个的脑袋;

软件优势:软件最终可以形成一个单独的.exe文件,不需要安装部署、写注册表、调用组件等额外步骤,即开即用,基本上交给普通windows系统用户都可以双击直接运行,用的UI框架、程序库等都是微软自己的产品,兼容性很好,疑难杂症相对较少。

软件劣势:语言比较偏门,脱离python时代,游戏比较古老,其实相关开源代码等资料已经很丰富了,本期单纯拿来试写专栏当案例使用,看看怎样编排章节能更好说清楚一个程序的思路。

三、界面UI交互

我使用VB做小游戏主要原因是自带UI组件,可以自行画按钮、画文本框来直观表达操作交互逻辑,而不是隐晦的Y/N(没错,黑乎乎程序交互窗体点名批评)。首先,放出2048涉及到的VB组件,见下图:  

双击运行后,正常的显示效果如下图:

这里额外赘述一下VB.net的组件特点,这里每一个组件都有很多属性,如显示字体颜色、是否可用、是否可见、组件名称、排版方式、组件大小、组件位置等等自身属性,同时不同类型的组件支持的触发事件也各不相同,如单击、双击、悬停、拖动、内容变更、获得或失去焦点、属性改动等等。举个简单例子,2048的界面中那个最长的按钮,底色属性是“Gold”,显示内容是“重新开始游戏”,字体是“微软雅黑”,它还有窗体坐标、可见性等很多属性可调整,大多数都是默认的,如果有特殊的属性需求,我会单独提出相关的改动内容,如果没有特殊说明,复刻界面可以凭自己喜好来做,按钮长什么样子不影响咱们功能的实现,一般要注意的问题,就是按钮的位置选择了,像2048这个界面中,至少,按钮要放在4*4的方阵下方避免遮盖,相关属性列表列出一个供参考:

再引入程序面向对象的概念,这里的属性可以理解为一个对象的属性,比如对象是button,可以针对这个button的属性进行编程修改,比如button1.text=”按钮”这样。

界面中的4*4文本框方阵需要单独设置一些的属性,这16个textbox统一应用这个配置:enabled属性为false,这样文本框就不再支持编辑了,仅仅起到显示作用;multiline属性为true,可以多行显示,这样可以把文本框拉长变成正方形。其余属性并不太重要,可以自行调整。

这个游戏由于涉及到敲击键盘控制,所以窗体Form属性需要单独设置一项,KeyPreview设置为true,让这个程序正常反馈敲击键盘的动作。

这样我们就完成了全部UI的设计工作,建立VB程序项目后,按图示的这些组件一一画出来,并调好相应的属性,接下来就可以正式写代码了,如果调试运行期间,某个功能或效果并没有达到心理预期,除了查验代码的编写问题,也要注意这些组件的属性是否符合我们的设计思路。UI界面的美丑问题切忌纠结,调UI是个很费功夫的工作,初学程序本着能用就行,这里也放一下我当年交作业的初版UI,比起我现在扁平化设计的精调版本,实在是两个时代的产物~

四、核心功能实现

在搬上所有代码前,首先用文字捋一遍我们将要实现的功能,这里要具备模块化的思维,我们所做的过程或者函数,都分别代表一个专有的功能模块,搞清楚所有的功能模块,就可以组合在一起实现全部效果了。

2048从交互逻辑来看,主要是程序会响应我们的一个“上下左右”操作,把数字往我们操作的方向平移,合并相同的数字,然后随机生成一个新的2或4元素在方阵里面。

从这段描述中,我们不难提炼出一些核心功能点,用模块化的思维将其逐个分解并实现:

1、读取“上下左右”的操作指令,并调用对应的数据处理功能(难点在于对操作指令的正确识别);

2、记录、运算、输出我们方阵中的数字(难点在于运算过程的逻辑);

3、根据显示的数字,调整方格颜色(难点在于各颜色间要差异明显);

4、检测生成新数字的时机,并生成新数字(难点在于生成什么,放在哪);

5、检测游戏是否已经结束,无法移动数字(难点在于检测逻辑的构建,具体参数有哪些,如何界定这个游戏结束);

6、计算我们的游戏得分,并保存到计算机的某个位置(难点在于读写外部文件功能的函数调用技巧)。

由此可见,2048游戏的算法不算太难,功能也很少,是一个比较入门的小游戏编程训练。

五、代码搬运

这个游戏只需要一个窗体,所以接下来的代码都会在一个Public Class Form1中编写,读懂代码后,调好各个组件名称,这段代码去掉中间我增加的整段描述文字,直接全部复制即可(可以保留代码末尾的注释),报错则多注意是不是名称没调好,导致函数或过程引用错误了。

<——<代码搬运开始>——>

Public Class Form1

这里定义了很多公共变量,变量的作用详见代码末尾的注释,用于记录方阵数据和游戏状态。我写的程序可能变量命名比较放飞自我,比如对文本框编组,使用Two Zero Four Eight缩写tzfe来代替,各位读者见谅,奇怪的命名我尽力文字都解释到位。。。

这一版本的代码是我经过优化后的结果,保留原汁原味的“青涩”外,尽量节约了很多代码行数,而且很多扩展功能我并没有真正添加进来,比如sqr变量是4,原版代码我并没有单独做变量来表达阶数,是我后续学会了动态数组后,写高阶2048才用到的参数,这里建议初学者直接把后续带有sqr变量的部分替换成纯数字,方便理解程序思路。Diff变量是一个玄学参数,我搜索了各大论坛,以及GitHub上的源代码,都没有真正论述过难度问题,我会在相应功能模块处再做深入解释,我认为这个参数和游戏体验的关系很密切,同样,初次写2048也可以不用理它,带diff变量引用的部分,替换成纯数字。

另外,我还写了彩蛋功能,也可以不用去管它,比如作弊模式让2048盘面可编辑,或者自动2048滚动播放等,这些功能一般集成在label控件的触发事件里,在末尾会出现这些彩蛋功能的代码,删除不影响正常游戏体验。

Public a(3, 3) As Long '2048底层数据,先数据处理,再输出至盘面

Public b(15), c(15) As Long '辅助数组。详见相关功能模块

Public tzfe(15) As TextBox '2048的盘面由textbox控件展示

Public sqr As Byte = 4 '记录2048阶数,这里限制在了4阶,做动态控件的话,放开这个参数即可实现高阶2048

Public diff As Byte = 3 '记录2048难度,这里默认为7级,这个参数实际为10-难度数值,由随机生成数字的公式引用达到更改概率的效果

Public score As Long '记录分数,先加分,再显示分数

Public nomove As Boolean = False '结束游戏状态变量,true代表游戏结束了

Public cheat As Boolean = False '标记功能开关,true代表作弊模式开启,彩蛋功能

Public turn As Integer '配个秒表,上右下左循环autoplay,彩蛋功能

以下是程序框体加载时执行的内容,为了保留“青涩味”,手动建的16个文本框我并没有替换成动态数组,但我又不想保留对每个文本框写一次判定的冗长代码,于是这里还是用了“先进”的控件对象编组,用序号把它们串了起来,可以用循环来依次编辑各个文本框的状态了,注意手动建立的独立textbox是没法放到循环里的,只能一个一个枚举。后续就是游戏初始化、弹窗欢迎界面功能了,相关引用可以查阅对应的功能模块,比如这里用了Restart()过程,则可以查找对Restart()定义的部分,我安排内容一般会就近放,就可以查看这个功能模块具体写了什么了。

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

tzfe(0) = TextBox1

tzfe(1) = TextBox2

tzfe(2) = TextBox3

tzfe(3) = TextBox4

tzfe(4) = TextBox5

tzfe(5) = TextBox6

tzfe(6) = TextBox7

tzfe(7) = TextBox8

tzfe(8) = TextBox9

tzfe(9) = TextBox10

tzfe(10) = TextBox11

tzfe(11) = TextBox12

tzfe(12) = TextBox13

tzfe(13) = TextBox14

tzfe(14) = TextBox15

tzfe(15) = TextBox16

Restart()

MsgBox("欢迎进入2048")

End Sub

这个函数是我查CSDN论坛得来的,对于各种需要键盘响应的小游戏来说,一般需要加这样一段,目的是让一些系统默认的操作转换为自己定义的操作,键盘“上下左右”一般用来移动光标,我们要拿来移动数字用,所以覆盖了系统默认分配的事件,这段无需太深入理解,扔在那里即可,涉及到的知识点比较复杂。

Protected Overrides Function ProcessDialogKey(keyData As Keys) As Boolean

If keyData = Keys.Left Or keyData = Keys.Right Or keyData = Keys.Up Or keyData = Keys.Down Then

Return False

Else

Return MyBase.ProcessDialogKey(keyData)

End If

'某些键,如 Tab、Return、Esc 和箭头键,由控件自动处理。

'所以当你的窗体添加了其它控件如按钮,checkbox等,form的keydown事件就触发不了.

'为使这些键引发窗体的KeyDown事件,你需要重写form.ProcessDialogKey函数,这个函数可以在消息预处理期间 处理对话字符,例如TAB、RETURN、ESCAPE和箭头键等

'同时窗体属性Keypreview要改为True,将Keydown事件传给内部控件,避免失去焦点导致Keydown触发失败

End Function

这个函数完成了我们归纳的第一个功能点,读取“上下左右”的操作指令,并调用对应的数据处理功能,敲下键盘时触发了2048这个窗体的事件,开始判定敲下了什么按键(select case),如果是“上下左右”,则调用对应的移动功能(upmove/downmove/leftmove/rightmove详见对应的功能模块代码),移动前后调用了两次复制盘面数据的功能(copy/copy2过程),根据判定结果来决定是否增加一个2/4新元素,这些完成后,刷新盘面各个文本框的颜色(setcolor过程),再判定游戏是不是结束了(theend过程)。

Public Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown

If e.KeyCode <> Keys.Left And e.KeyCode <> Keys.Right And e.KeyCode <> Keys.Up And e.KeyCode <> Keys.Down Then

Exit Sub

End If

Input()

Copy()

Select Case e.KeyCode

Case Keys.Up

Upmove()

Case Keys.Down

Downmove()

Case Keys.Left

Leftmove()

Case Keys.Right

Rightmove()

End Select

Copy2()

If Check2() = True Then '盘面挪动了,证明空出来一个格子,继续随机塞入数字

Add()

End If

Output()

Setcolor()

Theend()

End Sub

这个过程清零盘面数据,加一个初始2或4元素,记录数据,刷新格子颜色,重新标记游戏状态为“未结束”(nomove=false),归零得分等,由特定的按钮(重新开始游戏)和主窗体过程(开局初始化)调用。

Private Sub Restart() '重置盘面

Dim i As Integer

For i = 0 To sqr ^ 2 - 1

tzfe(i).Text = "0"

Next

Input()

Add()

Output()

Setcolor()

score = 0

nomove = False

End Sub

这是判定游戏是否结束的过程(check/check2/check3,具体判定功能的代码详见后续),每一次敲击键盘都会调用一次这个过程,为了避免游戏结束后,多次敲击键盘重复弹窗提示“游戏结束”,过程开头做了个跳出的判定,如果游戏已经结束了,再调用这个过程将什么都不发生(使用exit sub命令跳出),nomove变量实现了这个功能,当它的值发生改变,代表着“游戏结束”已经弹窗过一次了。

其中涉及到IO.File的代码是记录分数功能,效果是在exe程序文件路径中生成了另一个文档形式的文件“score”,在这里写入了游戏最高分,如果编程基础薄弱,可以暂缓这部分代码,删去也是可以的,不影响2048游戏体验,但这个功能在更复杂的游戏中不可避免地出现,是需要掌握的一个技能,IO.File是可以直接调用的一个系统模块,提供了很多文件读写的功能,深入了解需要查阅这个关键词的资料,了解全部功能的调用技巧。

过程末尾再扫描一下2048的盘面数据,如果成功合成了一个2048,则额外弹窗"2048目标达成!"恭喜一番,增加仪式感。

Private Sub Theend()

If nomove = True Then

Exit Sub '避免游戏结束后还弹窗

End If

If Check() = sqr ^ 2 And Check3() = False Then '都填满了,而且没有数字可以合并,游戏结束

nomove = True

MsgBox("游戏结束,你的得分:" & score)

If IO.File.Exists(Application.StartupPath & "/score") = True Then

Dim gameover As Integer

gameover = Val(IO.File.ReadAllText(Application.StartupPath & "/score"))

If score > gameover Then

IO.File.WriteAllText(Application.StartupPath & "/score", score)

MsgBox("恭喜你创造新纪录")

Else

MsgBox("很遗憾你没有打破纪录," & "最高分:" & gameover)

End If

Else

IO.File.WriteAllText(Application.StartupPath & "/score", score)

MsgBox("分数已记录")

End If

Dim i As Integer

For i = 0 To sqr ^ 2 - 1

If Val(tzfe(i).Text) >= 2048 Then

MsgBox("2048目标达成!")

Exit For

End If

Next

End If

End Sub

以下是两个基本功能,逐个扫描文本框内容,input将文本框数据写入a()数组记录,output将计算好的a()数组写回到文本框显示出来。如果想解锁高阶2048,调整sqr参数之外,注意调整a()数组的容量,在开头public变量声明中调整,否则运行时会报错数组溢出。

Private Sub Input()

Dim i, j As Integer

For i = 0 To sqr - 1

For j = 0 To sqr - 1

a(i, j) = Val(tzfe(i * sqr + j).Text)

Next

Next

End Sub

Private Sub Output()

Dim i, j As Integer

For i = 0 To sqr - 1

For j = 0 To sqr - 1

tzfe(i * sqr + j).Text = CStr(a(i, j))

Next

Next

End Sub

以下是另外两个小功能,两次扫描盘面数据并记录在临时数组中(b/c),对比两个数组,如果不同则代表上一个操作使得2048盘面变动了,那么后续再执行填入新元素的功能。同理,如果需要解锁高阶2048,注意扩容b和c的数组容量避免数组溢出。这里显示了另一个“青涩”的代码习惯,我用j、k、l作为临时计数变量,这个l(字母)就很灵性,它太像1(数字)了!负面教材,以后大家请使用i、j、k。

Private Sub Copy() '移动前记录状态

Dim j, k As Integer

Dim l As Integer = 0

For j = 0 To sqr - 1

For k = 0 To sqr - 1

b(l) = a(j, k)

l += 1

Next

Next

End Sub

Private Sub Copy2() '移动后记录状态

Dim j, k As Integer

Dim l As Integer = 0

For j = 0 To sqr - 1

For k = 0 To sqr - 1

c(l) = a(j, k)

l += 1

Next

Next

End Sub

这里的三个check函数是2048比较核心的逻辑内容了,玩2048很少会深入思考到这个逻辑,编写程序却非常重要。我们总共需要判定三个游戏状态,格子满没满?盘面动没动?还有没有相同数字贴在一起?格子满了,且没有相邻一样的数字,代表游戏结束,盘面动了,代表我们可以生成一个新的2/4元素。

判断格子是否满了容易实现,统计非0的格子即可。

盘面动没动的判定需要借助辅助过程,数字移动操作前后各扫描一下盘面状态,对比两个数组(b/c)得出结论

相同数字相邻的判定,我们需要用嵌套循环,逐行逐列,然后逐个相邻格子对比,如果有相同的数字,则跳出所有循环(exit for),返回一个true就够了,这里节约算力,不需要遍历所有相邻格子(遍历需要3*4*2=24次相邻格比较)。为了方便理解代码中嵌套循环的比较过程,附图一张:

Private Function Check() '检查是不是格子满了,返回格子总数就是满了

Dim i As Integer = 0

Dim m, n As Integer

For m = 0 To sqr - 1

For n = 0 To sqr - 1

If a(m, n) <> 0 Then

i += 1

End If

Next

Next

Return i

End Function

Private Function Check2() '检查一次操作后盘面是否有变动,变动过则返回true

Dim i As Boolean = False

Dim r As Integer

For r = 0 To sqr ^ 2 - 1

If b(r) <> c(r) Then

i = True

Exit For

End If

Next

Return i

End Function

Private Function Check3() '检查相邻两格是否有可合并的数字,如果没有,返回false

Dim same As Boolean = False

Dim i, j As Integer

For i = 0 To sqr - 1

For j = 0 To sqr - 2

If a(i, j) = a(i, j + 1) Then

same = True

Exit For

End If

If a(j, i) = a(j + 1, i) Then

same = True

Exit For

End If

Next

If same = True Then

Exit For

End If

Next

Return same

End Function

以下是生成2/4新元素的功能模块,随机选择一个位置,并塞入随机2或4的数字。随机选位置功能由于我早期的算法设计能力“不强”(更屑),用的是个简单粗暴枚举循环的逻辑,1~16随机数不停生成,直到找到对应无数字的格子进行填写,好在16个单元格并不会增加很大计算负载,后续体量稍大的游戏,我统一使用了Fisher-Yates设计的填充算法,届时若用到会具体描述其优势。

随后就是生成2、4的逻辑,这一个细节只有在真正做程序才会发现,玩家只管移动数字,而我们程序员需要考察到底2、4占据怎样的比例游戏体验更高,为此,我专门单独开一个章节讨论这个问题,详见我的第六章节:创新点。初学者如果不深入探讨2048的游戏逻辑,可以默认一个3:1的比例分别生成2和4,不需要引入我设计的diff变量调节难度。生成2、4算法上(最后一行),也可以直接简化为随机生成数字,根据这个数字大小来选择2、4的if then结构(要好几行代码才能实现,先出数,再选择),容我装个杯,写了一个数学表达式来直接区分生成结果了(好处是就用了一行代码),如果各位读者想进一步魔改2048,改成存在生成8的可能性,则需要老老实实用if then来重构一下最后一行代码。

Private Sub Add() '加一个新的数字进入盘面

Dim x, y As Integer

Randomize()

Do

x = Int(Rnd() * sqr)

y = Int(Rnd() * sqr)

Loop Until a(x, y) = 0

a(x, y) = 2 * (Int(Rnd() * (diff + 1) / diff) + 1) '2或4的生成概率比例会影响2048难度,这里默认按75%出现2,25%出现4设定

End Sub

以下是2048另一块核心逻辑,盘面数据移动时的计算规则。经过我大学上课长时间“测试”(摸鱼)2048的移动结果,我将这个过程慢动作化来介绍,首先四个方向,使用的移动、合并逻辑都是一样的,我们只需要研究单向即可。对于一个方向的数字,首先软件会把它们全部沉底(也就是移动方向),比如:

[2]-[0]-[0]-[0]向右,得[0]-[0]-[0]-[2];

[0]-[2]-[0]-[0]向右,得[0]-[0]-[0]-[2];

[2]-[0]-[2]-[0]向右,得[0]-[0]-[2]-[2];

[4]-[2]-[0]-[2]向右,得[0]-[4]-[2]-[2];

不难看出,这个过程最多执行2048的阶数次,前半段沉底代码一共三重嵌套循环,首先逐行/列扫描(变量m/n),然后当前行/列扫描4次(4阶2048,变量i),最后当前行/列相邻格对比(变量n/m),前置位0格把下一格数字格复制,下一格数字格清0。

下一步动作是合并运算,经过多次试玩,我们得出结论,一次移动的合并运算,仅仅会对当前行/列的所有所见数字,执行一次合并,不会递归合并,如何理解,如下(数据经过第一环节,已沉底):

[2]-[2]-[2]-[2]向右,得[0]-[0]-[4]-[4],而不是[0]-[0]-[0]-[8];

[0]-[2]-[2]-[2]向右,得[0]-[0]-[2]-[4],而不是[0]-[0]-[0]-[8],也不是 [0]-[0]-[4]-[2];

[0]-[0]-[2]-[2]向右,得[0]-[0]-[0]-[4];

[8]-[4]-[4]-[2]向右,得[0]-[8]-[8]-[2],而不是[0]-[0]-[16]-[2];

基本上可能看到的情况都已经列出,设计循环逻辑时,还是逐行/列扫描,与移动方向相反,倒序依次扫描相邻格数字,如果可合并,则前置位数字翻倍,后置位数字归零,后续数字依次前移(再次执行一次沉底)。至此,我们就完整解析了一次移动所需要的逻辑运算过程,并用代码呈现出来。

Private Sub Upmove()

Dim m, n, i As Integer

For m = 0 To sqr - 1 '数字沉底,排出空位

For i = 1 To sqr - 1

For n = 0 To sqr - 2

If a(n, m) = 0 Then

a(n, m) = a(n + 1, m)

a(n + 1, m) = 0

End If

Next

Next

Next

For m = 0 To sqr - 1 '数字合并,算分,再平移沉底

For n = 0 To sqr - 2

If a(n, m) = a(n + 1, m) Then

score += a(n, m)

a(n, m) *= 2

For i = n + 1 To sqr - 2

a(i, m) = a(i + 1, m)

Next

a(sqr - 1, m) = 0

End If

Next

Next

End Sub

Private Sub Downmove()

Dim m, n, i As Integer

For m = 0 To sqr - 1 '数字沉底,排出空位

For i = 1 To sqr - 1

For n = sqr - 1 To 1 Step -1

If a(n, m) = 0 Then

a(n, m) = a(n - 1, m)

a(n - 1, m) = 0

End If

Next

Next

Next

For m = 0 To sqr - 1 '数字合并,算分,再平移沉底

For n = sqr - 1 To 1 Step -1

If a(n, m) = a(n - 1, m) Then

score += a(n, m)

a(n, m) *= 2

For i = n - 1 To 1 Step -1

a(i, m) = a(i - 1, m)

Next

a(0, m) = 0

End If

Next

Next

End Sub

Private Sub Rightmove()

Dim m, n, i As Integer

For m = 0 To sqr - 1 '数字沉底,排出空位

For i = 1 To sqr - 1

For n = sqr - 1 To 1 Step -1

If a(m, n) = 0 Then

a(m, n) = a(m, n - 1)

a(m, n - 1) = 0

End If

Next

Next

Next

For m = 0 To sqr - 1 '数字合并,算分,再平移沉底

For n = sqr - 1 To 1 Step -1

If a(m, n) = a(m, n - 1) Then

score += a(m, n)

a(m, n) *= 2

For i = n - 1 To 1 Step -1

a(m, i) = a(m, i - 1)

Next

a(m, 0) = 0

End If

Next

Next

End Sub

Private Sub Leftmove()

Dim m, n, i As Integer

For m = 0 To sqr - 1 '数字沉底,排出空位

For i = 1 To sqr - 1

For n = 0 To sqr - 2

If a(m, n) = 0 Then

a(m, n) = a(m, n + 1)

a(m, n + 1) = 0

End If

Next

Next

Next

For m = 0 To sqr - 1 '数字合并,算分,再平移沉底

For n = 0 To sqr - 2

If a(m, n) = a(m, n + 1) Then

score += a(m, n)

a(m, n) *= 2

For i = n + 1 To sqr - 2

a(m, i) = a(m, i + 1)

Next

a(m, sqr - 1) = 0

End If

Next

Next

End Sub

以下是盘面文本框着色的逻辑,这里就会看到对16个文本框编组的重要性,通过一个1~16的循环,即可对逐个文本框选定颜色并显示,如果不编组,需要对每一个文本框单独定义一个textchange事件,单独写一遍选择颜色的代码,同样一段代码要写16遍。。。我根据原版2048的选色,用VB.net自带的颜色参数复刻了一下,考虑到硬核(开挂)玩家的需求,我从0到65536均配置了独特的颜色显示,其余数字则统统显示为黑色。

Private Sub Setcolor() '不同数字不同颜色区分,当年不会控件编组,枚举了16遍,16遍!

Dim i As Integer

For i = 0 To sqr ^ 2 - 1

Select Case tzfe(i).Text

Case 0

tzfe(i).BackColor = Color.Silver

tzfe(i).ForeColor = Color.Black

Case 2

tzfe(i).BackColor = Color.Ivory

tzfe(i).ForeColor = Color.Black

Case 4

tzfe(i).BackColor = Color.LemonChiffon

tzfe(i).ForeColor = Color.Black

Case 8

tzfe(i).BackColor = Color.Khaki

tzfe(i).ForeColor = Color.Black

Case 16

tzfe(i).BackColor = Color.Coral

tzfe(i).ForeColor = Color.Black

Case 32

tzfe(i).BackColor = Color.Tomato

tzfe(i).ForeColor = Color.Black

Case 64

tzfe(i).BackColor = Color.OrangeRed

tzfe(i).ForeColor = Color.Black

Case 128

tzfe(i).BackColor = Color.Red

tzfe(i).ForeColor = Color.Black

Case 256

tzfe(i).BackColor = Color.Yellow

tzfe(i).ForeColor = Color.Black

Case 512

tzfe(i).BackColor = Color.Gold

tzfe(i).ForeColor = Color.Black

Case 1024

tzfe(i).BackColor = Color.Orange

tzfe(i).ForeColor = Color.Black

Case 2048

tzfe(i).BackColor = Color.DarkOrange

tzfe(i).ForeColor = Color.Black

Case 4096

tzfe(i).BackColor = Color.GreenYellow

tzfe(i).ForeColor = Color.Black

Case 8192

tzfe(i).BackColor = Color.YellowGreen

tzfe(i).ForeColor = Color.Black

Case 16384

tzfe(i).BackColor = Color.DarkTurquoise

tzfe(i).ForeColor = Color.Black

Case 32768

tzfe(i).BackColor = Color.CornflowerBlue

tzfe(i).ForeColor = Color.Black

Case 65536

tzfe(i).BackColor = Color.Plum

tzfe(i).ForeColor = Color.Black

Case Else

tzfe(i).BackColor = Color.Black

tzfe(i).ForeColor = Color.White

End Select

Next

End Sub

两个Label控件的触发事件以及一个隐藏的Timer控件,组成了两个隐藏功能,这是基于2048传统玩法额外增加的功能。

第一个Click事件,将所有文本框的enabled属性改为true,这样可以自行键入数字了,比如敲进去一个3作为障碍物什么的,或者开挂直接敲一个2048达到目标,相应做了一个辅助变量cheat来记录开挂模式的开启关闭状态。

第二个MouseHover事件,鼠标悬停在那个2048标签上一会,会触发autoplay功能,启动timer控件开始tick,并设置为半秒一次tick,每次tick会触发后续的移动指令,这里不想额外定义变量名了,于是单纯用timer的interval属性来记录aotuplay的开启状态,如果是1000(1秒),证明当前秒表是停止的,将interval属性设置为500(半秒)并启动秒表,如果是500,证明当前秒表正在运行,将interval属性设置为1000并停止秒表,最后做一次启动判定,仅在游戏可以继续的情况下(nomove=false)开启秒表。

Timer控件的tick会按顺序触发“上右下左”顺序的移动指令,仔细端详一下,不难看出就是把先前键盘的keydown事件对应代码抄过来了,并用turn变量记录接下来应该移动的方向,总共4个方向,turn每次移动后自加1,除4取余数就代表了0、1、2、3四个方位代号,根据方位代号调用移动函数即可,代替了键盘的“上下左右”。

Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click

Dim i As Integer

If cheat = False Then

For i = 0 To sqr ^ 2 - 1

tzfe(i).Enabled = True

Next

cheat = True

Else

For i = 0 To sqr ^ 2 - 1

tzfe(i).Enabled = False

Next

cheat = False

End If

End Sub

Private Sub Label1_MouseHover(sender As Object, e As EventArgs) Handles Label1.MouseHover

If Timer1.Interval = 500 Then

Timer1.Stop()

turn = turn Mod 4 'autoplay跑久了turn变量太大,停下来时压缩一下

Timer1.Interval = 1000

Else

If nomove = False Then

Timer1.Interval = 500

Timer1.Start()

End If

End If

End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick '半秒一次移动

If nomove = True Then

Timer1.Stop()

Timer1.Interval = 1000

turn = 0

Else

Input()

Copy()

Select Case turn Mod 4

Case 0

Upmove()

Case 1

Rightmove()

Case 2

Downmove()

Case 3

Leftmove()

End Select

Copy2()

If Check2() = True Then '盘面挪动了,证明空出来一个格子,继续随机塞入数字

Add()

End If

Output()

Setcolor()

Theend()

turn += 1

End If

End Sub

以下代码分别对应四个按钮的单击触发事件,Button1对应的是“更改难度”(输入新的难度数值,判定是否合法,然后更换diff变量),Button2对应的是“清空记录”(清零计分文件的数据),Button3对应的是“关于作者”(一系列放飞自我的弹窗,顺便介绍游戏规则和隐藏功能),这三个按钮都是辅助功能,删去不影响2048游戏的核心玩法。

Button4对应的是“重新开始游戏”,功能比较单一,点击后调用了一次restart()过程,将游戏初始化了。

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

Dim exp As String

Dim diff2 As Byte

exp = InputBox("2048难度可以改动,默认是7级,可以输入新的难度等级(1-9级,等级越高,难度越高),后续游戏体验会出现细微变化", "难度设定", 7,,)

If exp = "" Then

Else

diff2 = Val(exp)

If diff2 >= 1 And diff2 <= 9 Then

diff = 10 - diff2

Else

MsgBox("修改方案无法实现,请重新输入参数")

End If

End If

End Sub

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

IO.File.WriteAllText(Application.StartupPath & "\score", 0)

MsgBox("记录已清空")

End Sub

Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click

Restart()

End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click

MsgBox("软件作者:菡萏芳菲")

MsgBox("本软件所有代码由本人所编,版权所有,不得抄袭")

MsgBox("软件免费,祝各位玩的开心")

MsgBox("[>---游戏规则---<]")

MsgBox("游戏初始,方格内会出现2或者4这两个小数字")

MsgBox("玩家只需要上下左右(方向键控制)其中一个方向来移动出现的数字")

MsgBox("所有的数字就会向滑动的方向靠拢")

MsgBox("而滑出的空白方块就会随机出现一个数字")

MsgBox("相同的数字相撞时会叠加")

MsgBox("然后一直这样,不断的叠加最终拼凑出2048这个数字就算成功,当然,分数多多益善")

MsgBox("你的最高分数将会被记录")

MsgBox("点击2048进入作弊模式,鼠标悬停在2048上一段时间后进入自动移动模式")

MsgBox("2048,创造游戏新潮流!")

End Sub

End Class

<——<代码搬运结束>——>

六、创新点

未来的每一款软件出专栏,我也都会列举一些我编程过程中发现的问题,经过查询论坛、网站均没发现很完整的论述后,我会自行调参做一点点研究。2048这个游戏逻辑比较简单,我中途仅发现了一个特别的讨论论题,就是2、4出现频次的概率分布,注:后续所称X:Y的比例,意为2的出现次数X与4的出现次数Y的比值,不考虑出现8的异种2048版本。

为此,我调整1~9的参数,经历了漫长的一下午2048爆搓,瞌睡过后,从实践中找到了这个参数的影响力。随后又蒙特卡洛模拟了一下,稍微对我总结出的理论做了一点点建模验证,可以得出一个能说出一点点道理的结论了。

网上对这个概率分布可谓是几乎只字不提,估计也很少程序员认真到考虑代码的每一条参数了。我没有看过源代码的详细算法,但据网上的只言片语描述,好像使用的是1:9比例生成,实际比较流行的移动端2048游戏生成比例我实际玩感觉在1:6的水平,而最早期我不假思索写的比例是1:1(后来看一些教学短篇文章,也很多是不假思索写了1:1),游玩过程发现了莫名的体验差异,才发现了这个论题。

本篇教学,我给了3:1的生成比例,是我经过理论推理,感觉可能是比较好玩的一个比例了。原因大体是这样的:

生成2和4比例会影响接下来可持续游戏的概率

在近乎填满的状态下,2和4交替频繁易导致游戏失败,直观感受是“冒不出自己想要的数字”

在空缺较多的状态下,2或4重复出现易导致游戏策略性降低,直观感受是“不停朝一个方向移动”

2048的难度根据这个比例会发生微妙的变化,在上一步2+2=4后,希望生成4进一步合并,当没有2+2时,希望下一步生成2去合并

以上两种情况到底那种多,又和玩游戏策略有关,难以界定,所以难度也不是线性的,具体分析其特征,作者称之为《2048理论》。

选择3/1理由:

首先,直观推理可得,2+2得4,那么此时生成4最不卡手,2、2、4序列,是2/1的配置,令人满意

2、4、2、4交替会比较卡手,2、2、4、4交替比较舒服,可以发现1/1配置两极分化

我们从1/1到9/1分别作了模拟数据,详见数据表(专栏这里我就不放了,是我做的一个乱七八糟的excel模型,可读性为0),发现了一些有趣的规律

把可能出现的组合拆分为ABA、AAB与ABB、AAA三种配列

ABA 242 424 劣 劣

AAB 224 442 优 劣

ABB 244 422 劣 优

AAA 222 444 优 优

模拟1000次结果,可得这三种模型次数累计加起来是998次,其中三种模型出现次数存在不同分布,按5的倍数,做了一下频率比例近似

ABA:(AAB+ABB):AAA

对于1/1,25:50:25

对于2/1,25:45:30

对于3/1,20:40:40

对于4/1,15:30:55

对于5/1,15:25:60

对于6/1,15:20:65

对于7/1,10:25:65

对于8/1,10:20:70

对于9/1,10:15:75

真正玩起来,就能发现端倪了

ABA太多,会经常卡手,会经常出现“局点”的紧迫环节,导致频繁破局思考,心累,令人沮丧;

AAA太多,大量的2让这个游戏高度可预测,缺乏盘面变化,一直2+2=4推,玩着枯燥,推着推着就极限了,缺少悬念,万一真偶尔蹦个4,心态爆炸;

ABB两级分化,224或422,雪中送碳,442或244,后续乏力,超级卡手,游戏体验55开;

这样我们就有个倾向性了,可以初步设立几条原则

1. 避免ABA占比太大

2. ABB、AAA合理穿插带来乐趣,AAA提供正反馈,ABB/AAB提供盘面变数

然后看看模拟数据表总结的比例结果

ABA从3/1后占比迅速下降,前几种比例分布中,尤其是1/1的变数很多很杂,不可取,完美解释了当时第一版2048做出来后,玩不顺畅的原因

AAA从3/1后占比迅速上升,可预测性直线增加

综上,我发现3/1比较舒服,ABA下降得差不多了,但又不是很少见,游戏难度保证,ABA和AAA占比类似,实际AAA还高一点,劳逸结合,保证游戏体验和正反馈。

七、结语

至此我们的《2048》编程教学就告一段落了,如有疏漏还请各位读者指正,如果有不错的建议,我会在下一期教学中调整我的内容框架。如果读者你还是一个刚选修程序课的初学者,请尽情“参考”本专栏内容用来交作业,希望你不是直接抄走了代码就交了~这个程序加上我另外开发的一个“小”游戏为我带来了一个100分的VB课选修成绩,还是很满意的,希望也对你们现在的课程有帮助(现在应该没人学VB了吧,吧?)

未来预告,截至本期专栏,我手里累计开发了7款游戏/应用程序,有2048、铺地板、数独、贪吃蛇、德州扑克发牌器兼计算器、拼豆图案设计器、塔罗牌占卜板,都是闲得冒泡的时期拍脑袋拍出来的,现在可能没那么闲再开发新游戏了(主要是人菜),它们涉及到更多的逻辑算法、更复杂的UI交互、更多的创新论题和分析成果,写起来着实体量庞大,我尽力陆续把它们写成教学专栏呈现出来,敬请期待,我们“明年”专栏再见啦(我发现2048都要写好长的篇幅,还这么一点点功能,带彩蛋功能一共就446行代码,后续真是不一定写得动呀~咕咕咕咕咕)!

标签: 功能模块 游戏结束 这个游戏

x 广告
金融
x 广告

Copyright ©  2015-2022 南极租赁网版权所有  备案号:粤ICP备2022077823号-13   联系邮箱: 317 493 128@qq.com