excel做游戏

MicroSoft Excel 2000 暗藏赛车游戏,很好玩喔!试试看吧:
1.开启Excel之后随便开一新文档,将它『另存成Web画面 』,按下发布后再将“添加交互对象”打勾,将档
案储存为car.htm(文件名可自取)。
2.在IE中开启car.htm,你应该会看到电子表格出现在网页中央
3.在这个工作表中,先用PageDown键移动工作表的矩形光标直至第2000行,注意只能用PageDown键,用鼠
标选中该行,然后用Tab键横向向右移动光标直至WC列,也是只能用键操作,到此,所有的准备工作已经
完毕,该是调出游戏的时候了。
4.同时按住Shift+Crtl+Alt 然后点选左上方的 Office logo 。
5.开始玩了
6.玩法提示: 玩游戏的时候,被你控制的是那一辆浅蓝的汽车,操作的主要是四个箭头按键。作用是:
左右箭头可以控制汽车的方向:向上箭头可以加速, 向下的箭头减速;如果汽车运行到了夜间,可用H键
打开车灯,空格键子弹打前后的车。
绝对好玩!
Excel下实现贪吃蛇小游戏
上次我们在Excel下实现了一个 div:eq(0) > div:eq(3) > table:eq(2) > tbody:eq(0) > tr:eq(0) > td:eq(0) > div:eq(0) > #content:eq(0)" anchorType="parent" jQuery1248062665640="7">华容道 式的小游戏,使用了Excel中的小部分属性和功能,不到100行语句就完成了。这次我们要把贪吃蛇搬到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中发现ms office vba从2000版本开始支持调用系统API,大家可以拓展office应用了)。
  就这样游戏输入、输出、逻辑定时的问题都解决了,我们的吃蛇游戏就仅剩下算法逻辑部分了。我们的游戏逻辑是,游戏初始化后,启动定时器。在每次定时循环中,程序分别实现蛇头移动与蛇尾移动。首先是移动蛇头,游戏判断在移动方向上蛇头下一个的位置是否为空格,若是则把这位置的空格填上颜(蛇头移动),蛇尾移动标志设为真;如果蛇头下一个位置不是空格(即有食物),则把这位置的空格填上颜(蛇头移动)后把蛇尾移动标志设为假。接着到蛇尾移动部分,若蛇尾移动标志为真则把蛇尾原所在单元格填回白(蛇尾移动),并更新蛇尾位置;如果蛇尾移动标志为假,则什么都不做(蛇尾不动蛇头动,蛇身长了)。对于整个游戏来说,效率的瓶颈在于像素操作(对单元格频繁填)。但从以上算法可以看到,在每次循环中程序只需处理蛇头及蛇尾所在单元格;如果贪吃蛇吃到食物,则只需要更新蛇头单元格。每个时间循环里较少的数据处理量实现了游戏较快的响应速度,贪吃蛇游戏在Excel中实现也有了实际意义。
  游戏还是以宏的形式实现。大家新建一个宏,输入如下代码。
  ' 熟悉VB的程序员知道首先是对调用系统API的声明
  Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As L
ong
  ' 定义数据结构
  Type pos_
  row As Long
  col As Long
  End Type
  Public timerset As Long ' SetTimer函数的返回值,用以标记已存在的Timer,KillTimer以此为参数销毁所标记的Timer
  Public gaming As Boolean
  Public pulsed As Boolean
  Public head_movement As Long '蛇头新移动方向标志,1、2、3、4代表右上左下
  Public tail_movement As Long '蛇尾移动方向标志,意义同上
  Public oldhead_movement As Long '蛇头旧有移动方向标志
  Dim tailmove As Boolean '蛇尾移动标志
  Dim origin_size As Long '贪吃蛇原始大小
  Public score As Long
  Dim steps As Lon
g
  Dim clean As Boolean
  Dim sth As pos_
  Dim headrow As Long '蛇头所在行位置
  Dim headcol As Long '蛇头所在列位置
  Dim tailrow As Long '蛇尾所在行位置
  Dim tailcol As Long '蛇尾所在列位置
  Dim startpos As pos_ '贪吃蛇起始位置
  Dim color As Long
  Const left As Long = 5 '游戏区域左边边界
  Const right As Long = 30 '游戏区域右边边界
  Const top As Long = 3 '游戏区域上边边界
  Const bottom As Long = 25 '游戏区域下边边界
  Function main() '主函数
  gaming = False
  If Worksheets.Count < 2 Then
  ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
  ElseIf (MsgBox("Do you want to run it in a new blank worksheet ?", vbOKCancel, "?????") = vbOK) Then
  ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
  Else
  Worksheets(Worksheets.Count).Select
  End If
章子怡个人档案
  Load UserForm1 '引入窗体
  UserForm1.Show
  End Function
  Function game_initial() '游戏初始化函数
  '初始化游戏界面
  color = 5
  If Not gaming Then
  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
  End If
  '贪吃蛇初始化
  origin_size = 5
  tail_movement = 1
  head_movement = 1
  oldhead_movement = head_movement
  w = (top + bottom) \ 2 'initialized as 16
  l = (left + right) \ 2 'initailized as 20
  pulsed = False
  tailmove = True
  headrow = w
  headcol = l
  tailrow = w
  tailcol = l - origin_size + 1
  clean = True
  steps = 0
  score = 0
桶装水管理系统  For i = 0 To origin_size - 1
  w, l - i).Interior.ColorIndex = color
  Next i
  gaming = True
  '游戏初始化结束
  End Function
  Sub snake_move()
  If gaming Then
  Dim nextcol As Long
  Dim nextrow As Long
  If clean Then
  steps = steps + 1
  '贪吃蛇食物生成,这里食物的生成过程很简单,蛇每前进6步就生成一块食物
  If steps >= 6 Then
  steps = 0
  Randomize
  w = Int((bottom - top) * Rnd) + top + 1
  Randomize
  l = Int((right - left) * Rnd) + left + 1
  Do w >= bottom
  w = w - (bottom - top) + 1
  Loop
  Do l >= right
  l =
l - (right - left) + 1
  Loop
  w, l) = "*"
  clean = False
  End If
  End If
  ''''''蛇头移动部分
  tailmove = True
  If oldhead_movement <> head_movement Then
  If Abs(oldhead_movement - head_movement) <> 2 Then
  oldhead_movement = head_movement
  Cells(headrow, headcol) = head_movement '当方向改变时在蛇头当前单元格记下前进方向,待蛇尾运行至此时可以按正确方向前进。本来应该用个数组记录,但我懒得再琢磨了。
  End If
  End If
  Select Case oldhead_movement
  Case 1 'right
  nextrow = headrow
  nextcol = headcol + 1
  Case 2 'up
  nextcol = headcol
  nextrow = headrow - 1
  Case 3 'left
  nextrow = headrow
  nextcol = headcol - 1
  Case 4 'down
  nextcol = headcol
  nextrow = headrow + 1
  End Select
  '看是否超出游戏区域了。
好乐宝博客  If nextcol = left Then
  nextcol = right - 1
  ElseIf nextcol = right Then
  nextcol = left + 1
  End If
  If nextrow = top Then
  nextrow = bottom - 1
  ElseIf nextrow = bottom Then
  nextrow = top + 1
  End If
  If Cells(nextrow, nextcol).Interior.ColorIndex = color Then '蛇头碰到蛇身了,游戏结束
  Call game_over: Exit Sub
  End If
  If Cells(nextrow, nextcol) = "*" Then
  Call score_
  Cells(nextrow, nextcol).ClearContents
  End If
  Cells(nextrow, nextcol).Interior.ColorIndex = color
  headrow = nextrow
  headcol = nextcol
  ''''''蛇尾移动部分
  If tailmove Then
  Select Case tail_movement
  Case 1 'right
  nextrow = tailrow
  nextcol = tailcol + 1
  Case 2 'up
  nextrow = tailrow - 1
  nextcol = tailcol
  Case 3 'left
  nextrow = tailrow
  nextcol = tailcol - 1
安全责任 重在落实  Case 4 'down
  nextcol = tailcol
  nextrow = tailrow + 1
  End Select
  If nextcol = left Then
  nextcol = right - 1
  ElseIf nextcol = right Then
  nextcol = left + 1
  End If
  If nextrow = top Then
  nextrow = bottom - 1
  ElseIf nextrow = bottom Then
  nextrow = top + 1
  End If
  If Cells(nextrow, nextcol) <> 0 Then
  If (Asc(Cells(nextrow, nextcol)) <> 42) Then
  tail_movement = Cells(nextrow, nextcol)
  Cells(nextrow, nextcol).ClearContents
  End If
  End If
  Cells(tailrow, tailcol).Interior.ColorIndex = 0
  tailrow = nextrow
  tailcol = nextcol
  End If
  End If
  End Sub
  Function game_over()
  If timerset <> 0 Then
  timerset = KillTimer(0, timerset)
  pulsed = False
  End If
  If MsgBox("porarily. Try again?", vbOKCancel, "?????") =
vbOK Then
  Range(Cells(top + 1, left + 1), Cells(bottom - 1, right - 1)).Interior.ColorIndex = 0
  Range(Cells(top + 1, left + 1), Cells(bottom - 1, right - 1)).ClearContents
  Call game_initial
  Else
  Cells.ClearContents
  Cells.Interior.ColorIndex = 0
  gaming = False
  SendKeys "%{F4}" '这句很关键,当引入窗体后要在程序中退出窗体就要用Alt+F4
  End If
  End Function
  Function score_()
  clean = True
  score = score + 50
  tailmove = False
  UserForm1.Label2.Caption = "Now you have the score of " + Str(score)
  End Function
  上边是 div:eq(0) > div:eq(3) > table:eq(2) > tbody:eq(0) > tr:eq(0) > td:eq(0) > div:eq(0) > #content:eq(0) > br:eq(214)" anchorType="previous" jQuery1248062665640="6">主程序 (宏)部分,以下是窗体代码部分。在工程中引入用户窗体,名为UserForm1,拖入两个label控件名为Label1、2,再在窗体属性窗口调整好窗体在Excel中出现的位置。完成后在窗体代码窗口键入如下代码:
  Private Sub UserForm_Initialize() '窗体初始化事件
  Call game_initial
  If gaming Then
  UserForm1.Label1.Caption = "NO PLAY , NO GAME"
  UserForm1.Label2.Caption = "Arrow keys to move. P key to pause the game E key to end the game"
  Else
  UserForm1.Label1.Caption = "Something happened !"
  End If
复合材料论文  End Sub
  Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) '响应窗体KeyDown事件
  If gaming Then
  If Not pulsed Then
  pulsed = True
  timerset = SetTimer(0, 0, 150, AddressOf snake_move) '启动定时器,这里时间间隔为150毫秒,大家可以加入一些代码用来实现越来越快的游戏速度
  UserForm1.Label2.Caption = "Arrow keys to move. P key to pause the game E key to end the game"
  End If
  Select Case KeyCode
  Case vbKeyUp
  head_movement = 2
  Case vbKeyDown
  head_movement = 4
  Case vbKeyLeft
  head_movement = 3
  Case vbKeyRight
  head_movement = 1
  Case vbKeyP '这里是通过销毁定时器实现游戏暂停
  If timerset <> 0 Then
  timerset = KillTimer(0, timerset)
  pulsed = False
  End If
  UserForm1.Label2.Caption = "Game paused. Any key to resume. "
  Case vbKeyE
  Call game_over
  End Select
  End If
  End Sub
  Private Sub UserForm_Terminate() '窗体销毁事件,这里是通过主程序发出Alt+F4按键事件引发
  If timerset <> 0 Then
  timerset = KillTimer(0, timerset)
  pulsed = False
  End If
  MsgBox ("You have finished the game with the score of " + Str(score))
  End Sub
  不过还没完,我们要个地方启动整个程序。在工作表sheet1中个地方拖入一个按钮用作总开关

本文发布于:2024-09-22 01:10:52,感谢您对本站的认可!

本文链接:https://www.17tex.com/xueshu/244867.html

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系,我们将在24小时内删除。

标签:游戏   移动   蛇尾   蛇头   实现   窗体   系统   程序
留言与评论(共有 0 条评论)
   
验证码:
Copyright ©2019-2024 Comsenz Inc.Powered by © 易纺专利技术学习网 豫ICP备2022007602号 豫公网安备41160202000603 站长QQ:729038198 关于我们 投诉建议