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 Collectionmystop = 0 '初始化值MoveDir = 0 '移动方向初始化'添加蛇Pos_X = 8Pos_Y = 5Dim snakeUnit As New CSnakeUnitsnakeUnit.Pos_X = Pos_XsnakeUnit.Pos_Y = Pos_Ysnake_body.Add snakeUnit'画布的偏移位置offset_x = 2offset_y = 3'画布实际位置CST_Area_X = 20 + offset_xCST_Area_Y = 20 + offset_yMoveDir = "Right"'游戏画布数组初始化For i = 0 To 22    For j = 0 To 22        game_map(i, j) = 0    Next jNext i'蛇长度初始化snake_length = 1ThisWorkbook.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) + 1Loop Until game_map(food_x, food_y) = 0game_map(food_x, food_y) = 1ThisWorkbook.Worksheets("Game").Cells(food_x + offset_x, food_y + offset_y).Interior.ColorIndex = 10eat_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 IfEnd IfCall 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 + 1Else    Call snake_removeEnd IfThisWorkbook.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 = xsnakeUnit.Pos_Y = ysnake_body.Add snakeUnit, , 1'蛇移动到的位置，游戏MAP 执为1game_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_Xpos_y_last = snakeUnit_last.Pos_YThisWorkbook.Worksheets("Game").Cells(pos_x_last, pos_y_last).Interior.ColorIndex = 0snake_body.Remove snake_body.Count'蛇向前移动后，蛇尾位置的游戏MAP 执为0game_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 giveFoodEnd 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