环境:
office 2013
win7 64位
初学VBA,做了个东西自娱自乐,顺便在这记录下,而且,原版没认真研究喔,希望大家不要喷...
本文顺序:
核心算法逻辑分析以及代码实现
excel设置准备
此版本的逻辑分析
试玩
正文:
1.核心算法逻辑分析以及代码实现
1.1算法逻辑分析
以上图为例,从第一行分析:
从右往左移动的时候(只分析第一行),现在只考虑位置移动时的各种情况,并把B下64的位置叫左B,C下8的位置叫C,D下8的位置叫D,E下16的位置叫E:右往左移动时,整体的移动顺序为:
C移动到B后,D再从到C到B,最后E到D到C到B。
每次移动时,如果(相邻位置指BC,CD,DE,因为每次移动都可以拆分成相邻的移动。如D到C到B,先是D到C移动,再):
(1)相邻位置的值都不为0且相等时,那么左边的值乘以2,右边的值清零(清零是为了符合第三条规律);
(2)相邻位置都不为0且数值不相等时,不移动;
(3)相邻位置左边为0,右边不为0时,右边的值给左边(记住是右往左滑动),右边的值清零(其实也可以认为是左右的值互换);
其他情况都不需要进行移动和值的更改,比如相邻都是0;相邻时左边不为0,右边为0;相邻左右都不为零且都不相等,等等。
颜色的话在数值改变的同时更改就好了,人为的设定好了每个数值对应什么颜色。
以上面的第一行从右往左为例:
先是C移动到B:
由于B和C都不为零且都不相等,所以不需要移动,这时BCDE的数值为(由于对位问题,加-以示间隔):
B----C----D----E
64---8----8----16
接着D到C到B:
先分析D到C,大家都是8,符合第一种情况,于是C的值变为16(颜色也改变,颜色改变下文不再重复叙述,只要格子的值有变化(无论是0到非零,非零到0,当前值乘以2,等等),都会进行对应的颜色设置),D的值改变为0,这时BCDE的值为(由于对位问题,加-以示间隔):
B----C----D----E
64---16---0----16
然后C到B进行判断BC都不为零且不相等,不需要移动,这时BCDE的值为(由于对位问题,加-以示间隔):
B----C----D----E
64---16---0---16
最后就E到D到C到B的移动了(由于对位问题,加-以示间隔):
先是E到D,符合第三种情况:左边为0,右边不为零0,D的值给C后,D清0,这时BCDE的值为:
B----C----D----E
64---16--16--0
然后D到C判断,符合第一种情况,于是C的值乘以2,D清零,这时BCDE的值为:
B----C----D----E
64---32---0----0
接着判断C到B,左右不为0且不相等,不用移动,最终BCDE的值为:
B----C----D----E
64---32---0----0
以上只是分析了第一行,其他三行如此类推。
以上只是分析了从右往左移动时的情况,其他方向如此类推。
1.2代码实现
上面说的这里再总结一下,先是黎近的目标(如上面的C到B)先移动,接着远一点的逐个移动判断,接着再远一点的逐个移动到目标,逐个判断。然后这是其中的一行,其他三行如法炮制。
代码还是以右往左为例
For k = 0 To 3
kLoop = k * 3 + 1
For j = 0 To 2
For i = 0 To j
cur = j + 3 - i
pre = j + 2 - i
Call gameRunLeftAndRight(kLoop, cur, pre)
Next
Next
Next
这里用了3层for-next循环,先分析最中间的for j = 0 to 2分析(稍微普及基础:VBA是从j等于0开始,每循环一次j会加1,然后一直到j大于2才结束循环,0到2就是循环3次了),就是对于上面的C到B,D到C到B,E到D到C到B的3次大的移动。
然后每次移动,又可以这样分为小的移动:j为0时,C到B,移动1次;j为1时,D到C,C到B,共2次;j为2时,E到D,D到C,C到B,共3次;
是不是发现点小规律了?j为0时移动1次,为1时移动2次,为2时移动3次,于是就有了最里面的for i = 0 to j 的循环。(j为0时,i的取值是0到0,也就是执行1次;j为1时,i的取值是0到1,共2次;j为2的时候i的取值为0到2,共3次。)
最外层的for k = 0 to 3就是对每一行进行循环了,每一次对应一行进行判断。
判断的逻辑在最里面的for i 里进行即可。
先提及一下基础,如上图B下64的位置,是把原来的B1:B3的格进行了合并,那么问题来了,怎么表示这个格的位置了,B1 ? 还是B2 ? 或者是B3 ?
这时点一下这个格,发现
原来是B1,对应用VBA的cells(x,y)表示的话,就是cells(1,2),表示第一行第二列的格子,注意A1是cells(1,1),不是从(0,0)开始。
右往左移动:
cur = j + 3 - i
pre = i + 2 - i
cur当前移动的目标,pre表示当前移动目标的前一个,举个例子如上图的C移动到B,cur就是C,pre就是B。
先看for j 循环的移动,以最远目标为例(如D到C到B,最远就是D;E到D到C到B最远就是E),如下表(由于对位问题,加-以示间隔):
坐标----j=0-------1--------2
最远
C-------(3,1)
D ---------------(4,1)
E--------------------------(5,1)
那很明显规律就是cur 的X就是 j +3,cur的前一个pre就是 j +2,
然后再分析for i 循环,每次j包含的小移动,以j=2时:
i为0时,最远就是E,也就是(5,1),移动到pre(也就是D),也就是(4,1);
接着i = 1,D移动到C,(4,1)到(3,1);
最后(3,1)到(2,1)。
由此可见每次小的移动cur = j + 3 - i,pre = j + 2 - i
最后,每行的行数为1,4,7,10,也就是y的值,因为每3行进行了合并单元格,而循环的k是从0递增到3,所以在循环中y的对应值的表达式为k*3 +1(用kLoop变量表示y)。
至于逻辑判断为调用函数:
Call gameRunLeftAndRight(kLoop, cur, pre)
以下为该函数的实现:
Public Function gameRunUpAndDown(kL%, cu%, pr%)
If Cells(cu, kL).Value <> 0 Then
If Cells(pr, kL).Value <> 0 Then
If Cells(cu, kL).Value = Cells(pr, kL).Value Then 'equal
Cells(pr, kL).Value = Cells(pr, kL).Value * 2
Cells(pr, kL).Interior.ColorIndex = arrColor(Log(Cells(pr, kL).Value) / Log(2))
'resunme the before one
Cells(cu, kL).Value = 0
Cells(cu, kL).Interior.ColorIndex = arrColor(0)
End If
Else
Cells(pr, kL).Value = Cells(cu, kL).Value 'the left is empty
Cells(pr, kL).Interior.ColorIndex = Cells(cu, kL).Interior.ColorIndex
'resunme the before one
Cells(cu, kL).Value = 0
Cells(cu, kL).Interior.ColorIndex = arrColor(0)
End If
End If
End Function
其实也就对应一开始分析的情况,如C到B,结合上述代码先分析当前的cur,也就是C,为8,判断是否为0,不为零再判断前面的B是否为0,若B不为0再进行是否相等的判断,若B为0进行对应操作。其他情况不用处理。
这里再说一下这个的意思:
Log(Cells(pr, kL).Value) / Log(2)
Log函数为自然对数,也就是e为底,也就是lnX,要是求log2(8),这样也可以求出:ln(8)/ln(2),用上Log函数就是Log(8)/Log(2)。用一个数组保存颜色的索引值,因为当前格子非0的时候的数必然为2的N次方,所以用当前格子的值求2的对数,对应数组下标即可。
每次4行都向一个方向移动完,把剩下为0的格子随机变成2:
Public Function randomToNew()
Dim cellX%, cellY%, randomNumber%
For i = 0 To 15
cellX = Int(i / 4) * 3 + 1
cellY = i Mod 4 + 2
If Cells(cellX, cellY).Value = 0 Then
If Round(Rnd() * 15) > 13 Then
randomNumber = Round(Rnd() * 1)
Cells(cellX, cellY).Value = randomNumber * 2
Cells(cellX, cellY).Interior.ColorIndex = arrColor(randomNumber)
End If
End If
Next
End Function
每个格子的行,也就是X,取值为:1,4,7,10(因为每3行的格子进行了合并),数列为3n+1(注意循环从0开始,不是1)
每个格子的列,也就是Y,取值为:2,3,4,5,数列为n+2(循环从0开始,不是1)
用一个循环,0到15表示的话,如果进行如下这样标记的话(由于对位问题,加-以示间隔):
(1,2)---(1,3)--(1,4)---(1,5)
(4,2)---(4,3)--(4,4)---(4,5)
(7,2)---(7,3)--(7,4)---(7,5)
(10,2) (10,3) (10,4) (10,5)
X的话,每4个i改变一次,所以n等于 i除以4,取整(直接i/4有小数,估计是i没有定义为整型,又或者是其他机制,没认真研究)。
Y的话,都是2,3,4,5重复出现4次,每个4个循环出现,所以n等于i跟4求余数,也就是 i Mod 4。
接着就是从0到15求一个随机数,为14或者15时,再从0和1中随机一次,为1时把为0的格子的值改为2,顺便改对应颜色的索引值。
2.excel设置准备:
引用别人的好了O(∩_∩)O~
http://www.cnblogs.com/ebs-blog/archive/2013/02/05/2892565.html
3.此版本的逻辑分析
对于合并并居中的操作,纯手动喔,没有用代码= =
全局变量以及颜色数组初始化对应的颜色索引值
Public arrColor As Variant
Public cur%, pre%, kLoop%
Public Function init()
arrColor = Array(40, 44, 45, 46, 38, 53, 54, 36, 34, 15, 20, 5, 25)
End Function
颜色索引值表:
重置模块,就是重新开始一局,对应的代码:
Sub bb()
Call init
Dim r1%
For i = 0 To 3
For j = 0 To 3
Cells((j * 3) + 1, i + 2).Value = 0
Cells((j * 3) + 1, i + 2).Interior.ColorIndex = arrColor(0)
Next
Next
For i = 0 To 3
r1 = Round(Rnd() * 15)
Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Value = 2
Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Interior.ColorIndex = arrColor(1)
Next
For i = 0 To 1
r1 = Round(Rnd() * 15)
Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Value = 4
Cells((Int(r1 / 4) * 3 + 1), ((r1 Mod 4) + 2)).Interior.ColorIndex = arrColor(2)
Next
End Sub
先是调用颜色数组初始化,把全部的值改为0和数组下标为0时的颜色,接着随机生成最多4个格子数值为2的格子,然后再从这16个中再随机生成最多2个数值为4的格子。
上下移动判断的函数:
Public Function gameRunUpAndDown(kL%, cu%, pr%)
If Cells(cu, kL).Value <> 0 Then
If Cells(pr, kL).Value <> 0 Then
If Cells(cu, kL).Value = Cells(pr, kL).Value Then 'equal
Cells(pr, kL).Value = Cells(pr, kL).Value * 2
Cells(pr, kL).Interior.ColorIndex = arrColor(Log(Cells(pr, kL).Value) / Log(2))
'resunme the before one
Cells(cu, kL).Value = 0
Cells(cu, kL).Interior.ColorIndex = arrColor(0)
End If
Else
Cells(pr, kL).Value = Cells(cu, kL).Value 'the left is empty
Cells(pr, kL).Interior.ColorIndex = Cells(cu, kL).Interior.ColorIndex
'resunme the before one
Cells(cu, kL).Value = 0
Cells(cu, kL).Interior.ColorIndex = arrColor(0)
End If
End If
End Function
左右移动判断的函数:
Public Function gameRunLeftAndRight(kL%, cu%, pr%)
If Cells(kL, cu).Value <> 0 Then
If Cells(kL, pr).Value <> 0 Then
If Cells(kL, cu).Value = Cells(kL, pr).Value Then 'equal
Cells(kL, pr).Value = Cells(kL, pr).Value * 2
Cells(kL, pr).Interior.ColorIndex = arrColor(Log(Cells(kL, pr).Value) / Log(2))
'resunme the before one
Cells(kL, cu).Value = 0
Cells(kL, cu).Interior.ColorIndex = arrColor(0)
End If
Else
Cells(kL, pr).Value = Cells(kL, cu).Value 'the left is empty
Cells(kL, pr).Interior.ColorIndex = Cells(kL, cu).Interior.ColorIndex
'resunme the before one
Cells(kL, cu).Value = 0
Cells(kL, cu).Interior.ColorIndex = arrColor(0)
End If
End If
End Function
把数值为0的格子改为数值为2并改变对应颜色:
Public Function randomToNew()
Dim cellX%, cellY%, randomNumber%
For i = 0 To 15
cellX = Int(i / 4) * 3 + 1
cellY = i Mod 4 + 2
If Cells(cellX, cellY).Value = 0 Then
If Round(Rnd() * 15) > 13 Then
randomNumber = Round(Rnd() * 1)
Cells(cellX, cellY).Value = randomNumber * 2
Cells(cellX, cellY).Interior.ColorIndex = arrColor(randomNumber)
End If
End If
Next
End Function
上面讲过就不说了喔
向上移动模块:
Sub up()
Call init
For k = 0 To 3
kLoop = k + 2
For j = 0 To 2
For i = 0 To j
cur = 3 * (j - i) + 4
pre = 3 * (j - i) + 1
Call gameRunUpAndDown(kLoop, cur, pre)
Next
Next
Next
Call randomToNew
End Sub
向下移动模块
Sub down()
Call init
For k = 0 To 3
kLoop = k + 2
For j = 0 To 2
For i = 0 To j
cur = 7 - 3 * (j - i)
pre = 10 - 3 * (j - i)
Call gameRunUpAndDown(kLoop, cur, pre)
Next
Next
Next
Call randomToNew
End Sub
向左移动模块:
Sub left()
Call init
For k = 0 To 3
kLoop = k * 3 + 1
For j = 0 To 2
For i = 0 To j
cur = j + 3 - i
pre = j + 2 - i
Call gameRunLeftAndRight(kLoop, cur, pre)
Debug.Print i
Next
Next
Next
Call randomToNew
End Sub
向右移动模块:
Sub right()
Call init
For k = 0 To 3
kLoop = k * 3 + 1
For j = 0 To 2
For i = 0 To j
cur = 4 - j + i
pre = 5 - j + i
Call gameRunLeftAndRight(kLoop, cur, pre)
Next
Next
Next
Call randomToNew
End Sub
最后,移动不了判定为输的逻辑没有做,到了2048就赢的逻辑没有做,分数没有做。。。。。。好多都没做= =...
4.试玩
先对照第2步进行设置,链接再放一次:
http://www.cnblogs.com/ebs-blog/archive/2013/02/05/2892565.html
其实本人只是把开发工具弄了出来,没有启用宏那些设置,只是保存带宏的excel时表格和vba文件要分开保存,略显麻烦。
源文件下载地址:http://download.csdn.net/detail/et_sandy/8211429
解压后打开2048改.xlsx,然后打开VB编辑器
接着导入VBA文件
要是想看代码就双击这里的模块1
如无意外就能玩了,如果按键的宏丢失,这样进行绑定就可以了:右键按钮,选指定宏
指定模块的名字
重置按钮对应bb
方向按钮名字对应模块名字的上下左右即可
喔,对了,没有研究能不能禁止表格的输入操作,于是,excel嘛,你可以直接修改表格的数值- -|||