VBA实现贪食蛇游戏

说明:
用excel画出20 x 20的区域，
添加三个按钮：游戏开始，游戏停止，清空区域
游戏快捷键：
按PgUp按键，加快速度
按PgDn按键：减慢速度
  按Ctrl按键：游戏暂停

Option Explicit
Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Dim mystop As Integer ‘开关
Dim MoveDir As String ‘移动方向

Dim CST_Area_X As Integer ’ 画布大小 x
Dim CST_Area_Y As Integer ‘画布大小 y

Dim Pos_X As Integer ‘当前位置 行
Dim Pos_Y As Integer ‘当前位置 列

Dim snake_body As Collection

Dim game_map(22, 22) As Integer ‘画布状态
Dim offset_x As Integer ‘画布偏移x
Dim offset_y As Integer

Dim eat_flg As Integer ‘食物是否被吃掉 标识
Dim food_x As Integer ‘食物坐标
Dim food_y As Integer

Dim snake_length As Integer ‘蛇的长度

Dim snake_speed As Integer ‘蛇运行速度

Dim stop_flg As Integer ‘游戏暂停 标识

‘游戏开始按钮
Private Sub START_Click()
‘游戏参数初始化
Call Game_init

'添加第一个食物
Call giveFood

'游戏开始
Call GameStart

End Sub

‘开始按钮按下后，触发的监控事件
Private Sub START_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
‘判断按下的按键，上下左右中哪一个
Select Case KeyCode
Case 37 ‘left pressed
MoveDir = “Left”
Case 38 ‘up pressed
MoveDir = “Up”
Case 39 ‘right pressed
MoveDir = “Right”
Case 40 ‘down pressed
MoveDir = “Down”
Case 33 ’ PgUp pressed
snake_speed = snake_speed - 50 ‘游戏速度调快
Case 34 ’ PgDn pressed
snake_speed = snake_speed + 50 ‘游戏速度调慢
Case 17 ’ ctrl pressed
Call Game_Pause
Case Else
Debug.Print KeyCode & “:” & Shift
End Select

’ Debug.Print KeyCode & “:” & Shift
End Sub

‘游戏停止按钮
Private Sub Game_Stop_Click()
mystop = 1
End Sub

‘清空按钮
Private Sub clear_Click()
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells(1, 1).Select
End Sub

‘游戏开始，参数初始化
Sub Game_init()
Dim i As Integer
Dim j As Integer

Set snake_body = New Collection

mystop = 0 '初始化值
MoveDir = 0 '移动方向初始化

'添加蛇
Pos_X = 8
Pos_Y = 5
Dim snakeUnit As New CSnakeUnit

snakeUnit.Pos_X = Pos_X
snakeUnit.Pos_Y = Pos_Y
snake_body.Add snakeUnit

'画布的偏移位置
offset_x = 2
offset_y = 3

'画布实际位置
CST_Area_X = 20 + offset_x
CST_Area_Y = 20 + offset_y

MoveDir = "Right"

'游戏画布数组初始化
For i = 0 To 22
    For j = 0 To 22
        game_map(i, j) = 0
    Next j
Next i

'蛇长度初始化
snake_length = 1
ThisWorkbook.Worksheets("Game").Range("AG8").Value = snake_length

'蛇的速度初始值
snake_speed = 500

'游戏暂停标识 初始化
stop_flg = 0

End Sub

‘随机出现食物
Sub giveFood()

Do
    food_x = Int(Rnd * 20) + 1
    food_y = Int(Rnd * 20) + 1

Loop Until game_map(food_x, food_y) = 0

game_map(food_x, food_y) = 1
ThisWorkbook.Worksheets("Game").Cells(food_x + offset_x, food_y + offset_y).Interior.ColorIndex = 10

eat_flg = 1

End Sub

‘游戏开始
Sub GameStart()
Do
VBA.DoEvents ‘转换控制权，可以进行其他程序运行或操作

    Select Case MoveDir
        Case "Left"
            Pos_Y = Pos_Y - 1
        Case "Up"
            Pos_X = Pos_X - 1
        Case "Right"
            Pos_Y = Pos_Y + 1
        Case "Down"
            Pos_X = Pos_X + 1

        Case Else

    End Select

    Call MovePos(Pos_X, Pos_Y) '位置移动

    Call MoveCheck   '检证移动后位置是否合法

    Sleep snake_speed

 Loop Until mystop = 1 '当mytop等于1时停止监控

End Sub

‘位置移动
Sub MovePos(ByVal x As Integer, ByVal y As Integer)

'check 是否撞到蛇身
If (x - offset_x <> food_x) And (y - offset_y <> food_y) Then
    If game_map(x - offset_x, y - offset_y) = 1 Then
        Call Game_Over
    End If
End If

Call snake_move(x, y)

'如果该位置有食物，蛇长度加1，食物FLG清空，否则删除蛇尾
If (x - offset_x = food_x) And (y - offset_y = food_y) Then
    eat_flg = 0
    snake_length = snake_length + 1
Else
    Call snake_remove
End If

ThisWorkbook.Worksheets("Game").Cells(x, y).Interior.ColorIndex = 36

End Sub

‘蛇移动到坐标x,y
Sub snake_move(ByVal x As Integer, ByVal y As Integer)
Dim snakeUnit As New CSnakeUnit

snakeUnit.Pos_X = x
snakeUnit.Pos_Y = y
snake_body.Add snakeUnit, , 1

'蛇移动到的位置，游戏MAP 执为1
game_map(x - offset_x, y - offset_y) = 1

End Sub

‘蛇移动后，蛇尾清空
Sub snake_remove()
Dim snakeUnit_last As CSnakeUnit
Dim pos_x_last As Integer
Dim pos_y_last As Integer

Set snakeUnit_last = snake_body.Item(snake_body.Count)
pos_x_last = snakeUnit_last.Pos_X
pos_y_last = snakeUnit_last.Pos_Y

ThisWorkbook.Worksheets("Game").Cells(pos_x_last, pos_y_last).Interior.ColorIndex = 0

snake_body.Remove snake_body.Count

'蛇向前移动后，蛇尾位置的游戏MAP 执为0
game_map(pos_x_last - offset_x, pos_y_last - offset_y) = 0

End Sub

Sub MoveCheck()
‘如果超出边界，游戏结束
If Pos_X > CST_Area_X Or Pos_Y > CST_Area_Y Or _
Pos_X <= 2 Or Pos_Y <= 3 _
Then
Call Game_Over
End If

'如果食物被吃，增加新的食物
If eat_flg = 0 Then
    Call giveFood
End If

'显示蛇的长度
ThisWorkbook.Worksheets("Game").Range("AG8").Value = snake_length

End Sub

‘游戏结束
Sub Game_Over()
Call Game_Stop_Click
MsgBox “Game is Over!!!” + vbCrLf + “Your Scores is:” + Str(snake_length)
End Sub

‘游戏暂停
Sub Game_Pause()
If stop_flg = 0 Then
stop_flg = 1
Call Game_Stop_Click
Else
stop_flg = 0
mystop = 0
Call GameStart
End If

End Sub