1. 程式人生 > >VBA實現貪食蛇遊戲

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