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 If


Sub Drawing(pos As String, bl As Boolean)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
If bl Then
    ranges.Interior.Color = 65535
Else
    ranges.Interior.Color = 5287936
End If
End Sub

Sub DrawingFood(pos As String)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
ranges.Interior.Color = 14951936
End Sub

Sub NotDrawing(pos As String)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
ranges.Interior.Color = 16777215
End Sub

Sub button1_Click()
On Error Resume Next
If Not Direction = 4 Then
Direction = 2
End If
End Sub

Sub 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 Sub

Sub 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
Next

SnakeBodyCount = 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 PosSnake
    
    On Error GoTo BeforeExit
    NotDrawing (PosX(SnakeBody(SnakeBodyCount).X) + Str(SnakeBody(SnakeBodyCount).Y)) '擦除最后一格
    For i = 1 To 767
        If i = 1 Then
            spot.X = SnakeBody(i).X   '蛇头
            spot.Y = SnakeBody(i).Y
            If spot.X > 25 Or spot.Y > 26 Then
            Return
            End If
            If Direction = 1 Then
            spot.X = spot.X - 1
            End If
            If Direction = 2 Then
            spot.Y = spot.Y - 1
            End If
            If Direction = 3 Then
            spot.X = spot.X + 1
            End If
            If Direction = 4 Then
            spot.Y = spot.Y + 1
            End If
            
            If 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).Y
            SnakeBodyCount = SnakeBodyCount + 1
            createFood
            End If
        Else
            SnakeBody(SnakeBodyCount - i + 2).X = SnakeBody(SnakeBodyCount - i + 1).X
            SnakeBody(SnakeBodyCount - i + 2).Y = SnakeBody(SnakeBodyCount - i + 1).Y
        End If
        If i >= SnakeBodyCount Then
        Exit For
        End If
    Next
    SnakeBody(1).X = spot.X
    SnakeBody(1).Y = spot.Y
    If spot.X > 25 Or spot.X < 0 Or spot.Y > 26 Or spot.Y < 0 Then '判断是否撞到墙了
    Call StopTimer
    MsgBox ("GG")
    End If
    For i = 2 To SnakeBodyCount  '判断是否咬到了自己
    If spot.X = SnakeBody(i).X And spot.Y = SnakeBody(i).Y Then
    Call StopTimer
    MsgBox ("GG")
    End If
    Next
    
    For i = 1 To SnakeBodyCount
    
    Dim pos As String
    pos = PosX(SnakeBody(i).X) + Str(SnakeBody(i).Y)
    If i = 1 Then  '蛇头画不一样的颜色
    Drawing pos, True
    Else
    Drawing pos, False
    End If
    
    Next
BeforeExit:
End Sub

Sub createFood()
    Set Food = New PosSnake
    Dim Y As Integer
    Dim X As Integer
    Y = Int((26 * Rnd) + 1)
    X = Int((25 * Rnd) + 0)
    Food.X = X
    Food.Y = Y
    DrawingFood (PosX(Food.X) + Str(Food.Y))
End Sub

Function 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 Integer

Private iy As Integer


Property Let X(i As Integer)
ix = i
End Property

Property Let Y(i As Integer)
iy = i
End Property

Property Get X() As Integer
X = ix
End Property
Property Get Y() As Integer
Y = iy
End Property

规矩转载。