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