i=i+1
Loop
Ifi=N*NThen
MsgBox"祝贺你!
你成功了!
"&vbCrLf&_
"一共用了"&Bs&"步!
"&vbCrLf&_
"一共用用时"&Format(Now-STime,"h:
m:
s"),,PW
Running=False
EndIf
EndIf
EndIf
EndIf
Else
down=MsgBox("游戏还未进行,是否开始?
",vbYesNo,"提示-"&PW)
Ifdown=vbYesThenGameStar
EndIf
EndSub
四:
跑跑卡丁车.xls
网上到处可下!
注:
打开Excel后,若不能玩,点菜单栏上的工具→宏→安全性,将安全级别设为低,便可以玩了
五:
贪吃蛇源码
首先要解决游戏显示的问题。
对我们来说,小游戏最好的平台是Excel的工作区,由于大小可调、颜色可填的单元格操作方便,我们完全可以把它们当像素来使用。
于是我们的贪吃蛇游戏就有了以单元格为基础的像素形式的显示方式了。
其次是游戏的控制方法。
在这里我摸索了好久,其中走了弯路不说,我最后的结论是在Excel中要实现按键事件的方法是引入窗体,然后在窗体中响应Keydown与Keypress事件。
这样的话,既可以快速响应还可以根据情况修改对应按键。
最后是游戏的定时问题。
所有的游戏事实上都是在一个时间大循环里面定时接收输入信息更新状态的程序,我们的小游戏都不例外。
老实说,我写这个游戏大部分的思考时间就浪费在如何实现游戏定时这里。
Excel的VBA中与定时有关的只有onTime函数,没有其他相关函数提供了,onTime函数可以实现某一事件在指定时间发生,但只能以秒为最小单位,对我们要在一秒内更新数十次信息的小游戏不适合,我们只能另找方法。
用过VB的人都知道VB控件中有个定时控件,用它来实现游戏定时是最好的,但在Excel中却没有,难道我要把VB中的定时控件移植到VBA中?
这也是个很值得研究的课题,但是我想到了另外的方法。
VB的程序员都知道要想VB程序发挥大作用一定离不开调用系统的API,于是我查看了系统相关API的帮助,发现系统API中实现相应功能的有settimer与killtimer函数,具体定义和用法大家可以参考相关帮助,但从字面大家都已经可以知道它们就是我们要找的东西了。
那么现在的问题就是如何在vba环境下调用系统API。
心想微软称vba就是office中的vb,那么在vba中调用系统API应该也与在VB中的一样。
一试,呵呵,果然非虚,这微软真不是盖的(后在msdn中发现msofficevba从2000版本开始支持调用系统API,大家可以拓展office应用了)。
就这样游戏输入、输出、逻辑定时的问题都解决了,我们的吃蛇游戏就仅剩下算法逻辑部分了。
我们的游戏逻辑是,游戏初始化后,启动定时器。
在每次定时循环中,程序分别实现蛇头移动与蛇尾移动。
首先是移动蛇头,游戏判断在移动方向上蛇头下一个的位置是否为空格,若是则把这位置的空格填上颜色(蛇头移动),蛇尾移动标志设为真;如果蛇头下一个位置不是空格(即有食物),则把这位置的空格填上颜色(蛇头移动)后把蛇尾移动标志设为假。
接着到蛇尾移动部分,若蛇尾移动标志为真则把蛇尾原所在单元格填回白色(蛇尾移动),并更新蛇尾位置;如果蛇尾移动标志为假,则什么都不做(蛇尾不动蛇头动,蛇身长了)。
对于整个游戏来说,效率的瓶颈在于像素操作(对单元格频繁填色)。
但从以上算法可以看到,在每次循环中程序只需处理蛇头及蛇尾所在单元格;如果贪吃蛇吃到食物,则只需要更新蛇头单元格。
每个时间循环里较少的数据处理量实现了游戏较快的响应速度,贪吃蛇游戏在Excel中实现也有了实际意义。
游戏还是以宏的形式实现。
大家新建一个宏,输入如下代码。
'熟悉VB的程序员知道首先是对调用系统API的声明
PublicDeclareFunctionSetTimerLib"user32"(ByValhwndAsLong,ByValnIDEventAsLong,ByValuElapseAsLong,ByVallpTimerFuncAsLong)AsLong
PublicDeclareFunctionKillTimerLib"user32"(ByValhwndAsLong,ByValnIDEventAsLong)AsLong
'定义数据结构
Typepos_
rowAsLong
colAsLong
EndType
PublictimersetAsLong'SetTimer函数的返回值,用以标记已存在的Timer,KillTimer以此为参数销毁所标记的Timer
PublicgamingAsBoolean
PublicpulsedAsBoolean
Publichead_movementAsLong'蛇头新移动方向标志,1、2、3、4代表右上左下
Publictail_movementAsLong'蛇尾移动方向标志,意义同上
Publicoldhead_movementAsLong'蛇头旧有移动方向标志
DimtailmoveAsBoolean'蛇尾移动标志
Dimorigin_sizeAsLong'贪吃蛇原始大小
PublicscoreAsLong
DimstepsAsLong
DimcleanAsBoolean
DimsthAspos_
DimheadrowAsLong'蛇头所在行位置
DimheadcolAsLong'蛇头所在列位置
DimtailrowAsLong'蛇尾所在行位置
DimtailcolAsLong'蛇尾所在列位置
DimstartposAspos_'贪吃蛇起始位置
DimcolorAsLong
ConstleftAsL5'游戏区域左边边界
ConstrightAsL30'游戏区域右边边界
ConsttopAsL3'游戏区域上边边界
ConstbottomAsL25'游戏区域下边边界
Functionmain()'主函数
gaming=False
IfWorksheets.Count<2Then
ActiveWorkbook.Sheets.Addafter:
=Worksheets(Worksheets.Count)
ElseIf(MsgBox("Doyouwanttorunitinanewblankworksheet?
",vbOKCancel,"?
?
?
?
?
")=vbOK)Then
ActiveWorkbook.Sheets.Addafter:
=Worksheets(Worksheets.Count)
Else
Worksheets(Worksheets.Count).Select
EndIf
LoadUserForm1'引入窗体
UserForm1.Show
EndFunction
Functiongame_initial()'游戏初始化函数
'初始化游戏界面
color=5
IfNotgamingThen
Cells.ColumnWidth=1
Cells.RowHeight=10
Range(Cells(top,left),Cells(top,right)).Interior.ColorIndex=1
Range(Cells(top+1,left),Cells(bottom-1,left)).Interior.ColorIndex=1
Range(Cells(bottom,left),Cells(bottom,right)).Interior.ColorIndex=1
Range(Cells(top+1,right),Cells(bottom-1,right)).Interior.ColorIndex=1
Range(Cells(top+1,left+1),Cells(bottom-1,right-1)).Font.ColorIndex=color
EndIf
'贪吃蛇初始化
origin_size=5
tail_movement=1
head_movement=1
oldhead_movement=head_movement
startpos.row=(top+bottom)\2'initializedas16
startpos.col=(left+right)\2'initailizedas20
pulsed=False
tailmove=True
headrow=startpos.row
headcol=startpos.col
tailrow=startpos.row
tailcol=startpos.col-origin_size+1
clean=True
steps=0
score=0
Fori=0Toorigin_size-1
Cells(startpos.row,startpos.col-i).Interior.ColorIndex=color
Nexti
gaming=True
'游戏初始化结束
EndFunction
Subsnake_move()
IfgamingThen
DimnextcolAsLong
DimnextrowAsLong
IfcleanThen
steps=steps+1
'贪吃蛇食物生成,这里食物的生成过程很简单,蛇每前进6步就生成一块食物
Ifsteps>=6Then
steps=0
Randomize
sth.row=Int((bottom-top)*Rnd)+top+1
Randomize
sth.col=Int((right-left)*Rnd)+left+1
DoWhilesth.row>=bottom
sth.row=sth.row-(bottom-top)+1
Loop
DoWhilesth.col>=right
sth.col=sth.col-(right-left)+1
Loop
Cells(sth.row,sth.col)="*"
clean=False
EndIf
EndIf
''''''蛇头移动部分
tailmove=True
Ifoldhead_movement<>head_movementThen
IfAbs(oldhead_movement-head_movement)<>2Then
oldhead_movement=head_movement
Cells(headrow,headcol)=head_movement'当方向改变时在蛇头当前单元格记下前进方向,待蛇尾运行至此时可以按正确方向前进。
本来应该用个数组记录,但我懒得再琢磨了。
EndIf
EndIf
SelectCaseoldhead_movement
Case1'right
nextrow=headrow
nextcol=headcol+1
Case2'up
nextcol=headcol
nextrow=headrow-1
Case3'left
nextrow=headrow
nextcol=headcol-1
Case4'down
nextcol=headcol
nextrow=headrow+1
EndSelect
'看是否超出游戏区域了。
Ifnextcol=leftThen
nextcol=right-1
ElseIfnextcol=rightThen
nextcol=left+1
EndIf
Ifnextrow=topThen
nextrow=bottom-1
ElseIfnextrow=bottomThen
nextrow=top+1
EndIf
IfCells(nextrow,nextcol).Interior.ColorIndex=colorThen'蛇头碰到蛇身了,游戏结束
Callgame_over:
ExitSub
EndIf
IfCells(nextrow,nextcol)="*"Then
Callscore_
Cells(nextrow,nextcol).ClearContents
EndIf
Cells(nextrow,nextcol).Interior.ColorIndex=color
headrow=nextrow
headcol=nextcol
''''''蛇尾移动部分
IftailmoveThen
SelectCasetail_movement
Case1'right
nextrow=tailrow
nextcol=tailcol+1
Case2'up
nextrow=tailrow-1
nextcol=tailcol
Case3'left
nextrow=tailrow
nextcol=tailcol-1
Case4'down
nextcol=tailcol
nextrow=tailrow+1
EndSelect
Ifnextcol=leftThen
nextcol=right-1
ElseIfnextcol=rightThen
nextcol=left+1
EndIf
Ifnextrow=topThen
nextrow=bottom-1
ElseIfnextrow=bottomThen
nextrow=top+1
EndIf
IfCells(nextrow,nextcol)<>0Then
If(Asc(Cells(nextrow,nextcol))<>42)Then
tail_movement=Cells(nextrow,nextcol)
Cells(nextrow,nextcol).ClearContents
EndIf
EndIf
Cells(tailrow,tailcol).Interior.ColorIndex=0
tailrow=nextrow
tailcol=nextcol
EndIf
EndIf
EndSub
Functiongame_over()
Iftimerset<>0Then
timerset=KillTimer(0,timerset)
pulsed=False
EndIf
IfMsgBox("Gameover...temporarily.Tryagain?
",vbOKCancel,"?
?
?
?
?
")=vbOKThen
Range(Cells(top+1,left+1),Cells(bottom-1,right-1)).Interior.ColorIndex=0
Range(Cells(top+1,left+1),Cells(bottom-1,right