Excel实现贪吃蛇

天天写报表工具，感觉Excel越用越烦，看着Sheet里的格子，我突然想到了以前他们说用VBA做游戏的想法。

Excel工作表里的格子，天生就适合用来做俄罗斯方块、贪吃蛇这样的小游戏啊，想到了就做，于是有了以下。

先说一下实现方式。

蛇的运动通过user32.dll的SetTimer实现，蛇的组成即一个一维数组，数组存放自定义类型，包含横纵坐标。

蛇、食物通过填充Excel单元格实现。

下面贴VBA的源码。

模块：

Public Direction As Integer '蛇的方向 1左2上3右4下
Public SnakeBody(1 To 676) As PosSnake
Public SnakeBodyCount As Integer
Public PosX '横坐标集合
Public lTimerID As Long
Public Food As PosSnake#If VBA7 And Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#Else
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End IfSub Drawing(pos As String, bl As Boolean)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
If bl Thenranges.Interior.Color = 65535
Elseranges.Interior.Color = 5287936
End If
End SubSub DrawingFood(pos As String)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
ranges.Interior.Color = 14951936
End SubSub NotDrawing(pos As String)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
ranges.Interior.Color = 16777215
End SubSub button1_Click()
On Error Resume Next
If Not Direction = 4 Then
Direction = 2
End If
End SubSub button2_Click()
On Error Resume Next
If Not Direction = 3 Then
Direction = 1
End If
End Sub
Sub button3_Click()
On Error Resume Next
If Not Direction = 1 Then
Direction = 3
End If
End Sub
Sub button4_Click()
On Error Resume Next
If Not Direction = 2 Then
Direction = 4
End If
End SubSub button5_Click()
PosX = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")For i = 0 To 25
For j = 1 To 26
NotDrawing (PosX(i) + Str(j))
Next
NextSnakeBodyCount = 1
Dim pos As New PosSnake
Direction = 3
pos.X = 0
pos.Y = 12
Set SnakeBody(1) = pos
createFood
StartTimer (200) '蛇开始运动
End Sub'启动定时器，IDuration是定时器触发的时间，单位为毫秒
Sub StartTimer(lDuration As Long)
If Not lTimerID = 0 Then
lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
Else
Call StopTimer
lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
End If
End Sub'停止定时器的函数
Sub StopTimer()
KillTimer 0&, lTimerID
End Sub'OnTime函数
Sub OnTime()Dim spot As New PosSnakeOn Error GoTo BeforeExitNotDrawing (PosX(SnakeBody(SnakeBodyCount).X) + Str(SnakeBody(SnakeBodyCount).Y)) '擦除最后一格For i = 1 To 767If i = 1 Thenspot.X = SnakeBody(i).X   '蛇头spot.Y = SnakeBody(i).YIf spot.X > 25 Or spot.Y > 26 ThenReturnEnd IfIf Direction = 1 Thenspot.X = spot.X - 1End IfIf Direction = 2 Thenspot.Y = spot.Y - 1End IfIf Direction = 3 Thenspot.X = spot.X + 1End IfIf Direction = 4 Thenspot.Y = spot.Y + 1End IfIf Food.X = spot.X And Food.Y = spot.Y Then '判断是否吃到了食物Set SnakeBody(SnakeBodyCount + 1) = New PosSnake'SnakeBody(SnakeBodyCount + 1).X = SnakeBody(SnakeBodyCount).X'SnakeBody(SnakeBodyCount + 1).Y = SnakeBody(SnakeBodyCount).YSnakeBodyCount = SnakeBodyCount + 1createFoodEnd IfElseSnakeBody(SnakeBodyCount - i + 2).X = SnakeBody(SnakeBodyCount - i + 1).XSnakeBody(SnakeBodyCount - i + 2).Y = SnakeBody(SnakeBodyCount - i + 1).YEnd IfIf i >= SnakeBodyCount ThenExit ForEnd IfNextSnakeBody(1).X = spot.XSnakeBody(1).Y = spot.YIf spot.X > 25 Or spot.X < 0 Or spot.Y > 26 Or spot.Y < 0 Then '判断是否撞到墙了Call StopTimerMsgBox ("GG")End IfFor i = 2 To SnakeBodyCount  '判断是否咬到了自己If spot.X = SnakeBody(i).X And spot.Y = SnakeBody(i).Y ThenCall StopTimerMsgBox ("GG")End IfNextFor i = 1 To SnakeBodyCountDim pos As Stringpos = PosX(SnakeBody(i).X) + Str(SnakeBody(i).Y)If i = 1 Then  '蛇头画不一样的颜色Drawing pos, TrueElseDrawing pos, FalseEnd IfNext
BeforeExit:
End SubSub createFood()Set Food = New PosSnakeDim Y As IntegerDim X As IntegerY = Int((26 * Rnd) + 1)X = Int((25 * Rnd) + 0)Food.X = XFood.Y = YDrawingFood (PosX(Food.X) + Str(Food.Y))
End SubFunction KillSpace(Expression)
Dim tmpS
For i = 1 To Len(Expression)
tmpT = Mid(Expression, i, 1)
If tmpT <> " " Then tmpS = tmpS & tmpT
Next i
KillSpace = tmpS
End Function

类 PosSnake：

Private ix As IntegerPrivate iy As IntegerProperty Let X(i As Integer)
ix = i
End PropertyProperty Let Y(i As Integer)
iy = i
End PropertyProperty Get X() As Integer
X = ix
End Property
Property Get Y() As Integer
Y = iy
End Property

规矩转载。

Excel实现贪吃蛇相关推荐

用Excel制作贪吃蛇
此文章最先发布于我的博客废话不多说,先放成果.在GitHub上查看源代码 . 开始编写阅读此教程,你需要了解什么是VBA,对VBA初步了解如何在Excel中编辑VBA,并启用它否则请另行百度 ...
13行代码AC_2017年省赛C组蓝桥杯第一题贪吃蛇长度（考查文件读取）
励志用少的代码做高效表达题目描述 ±------------------------------------------------+ | | | H###### #### | | # # # | ...
C/C++小游戏 ——贪吃蛇
文章目录案例一案例二案例三案例四案例五案例六案例七案例八案例九案例一 #include <stdio.h>#include <windows.h>#incl ...
c++编写手机小游戏代码_玩过自己开发的贪吃蛇吗？点这里，教你用Python写一个贪吃蛇小游戏！（附源代码）...
后台回复'0816',加入Python交流群~ 往日回顾:Python必读好书,这9本份量十足~ 本文代码的实现效果,获取源代码,请直接滑到文末~都说Python除了生孩子,什么都能干.咱们今天,就用 ...
天才啊！仅用四个整数编写一个贪吃蛇游戏！
作者 | Andrei Cioban 译者 | 弯月出品 | CSDN(ID:CSDNnews) 记得上次编写贪吃蛇游戏还是很多年以前的事,如今我打算尽己所能,在一些很特别的方面做到极致: 将游戏的 ...
一步步教你怎么用Python写贪吃蛇游戏
(图片下载自视觉中国) 作者 | 上海小胖来源 | Python专栏(ID:xpchuiit) 目录 0 引言 1 环境 2 需求分析 3 代码实现 4 后记 0 引言前几天,星球有人提到贪吃蛇, ...
如何用java语言编写小游戏？（贪吃蛇）
自己做了个贪吃蛇,效果图如下" 素材和图片是网上找的,在做这游戏的过程中其实最麻烦的是像素的调整,需要一点点去试....所以大家做的时候像素方面自己试就行了,根据自己的实际情况判断. 先说一 ...
手把手教你用C++写贪吃蛇
最近女朋友挺无聊的(不是左手,也不是右手),决定用C++写一个贪吃蛇的游戏给他玩玩.顺便更新一下博客,把思路记下来. 相信看这篇博客的人都用过诺基亚的手机,玩过贪吃蛇(不接受反驳).贪吃蛇的玩法就是一 ...
用html编写一个贪吃蛇,HTML编写的贪吃蛇代码
<HTML编写的贪吃蛇代码>由会员分享,可在线阅读,更多相关<HTML编写的贪吃蛇代码(14页珍藏版)>请在人人文库网上搜索. 1.使用表格 var fangxiang;fan ...

Excel实现贪吃蛇

Excel实现贪吃蛇相关推荐

最新文章

热门文章