Created
April 17, 2018 07:28
-
-
Save cwt8805/70ac3efd4a495e3d94285819826c0034 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Const WIDTH = 20 | |
| Const HEIGHT = 20 | |
| Enum DATA | |
| SNAKE_DATA | |
| BACK_DATA | |
| FOOD_DATA | |
| End Enum | |
| Enum DIR | |
| UP_DIR | |
| DOWN_DIR | |
| LEFT_DIR | |
| RIGHT_DIR | |
| End Enum | |
| Dim currentDir As DIR | |
| Dim fireTime As Date | |
| Dim background(HEIGHT - 1, WIDTH - 1) As DATA | |
| Dim snake(HEIGHT * WIDTH - 1, 1) As Integer | |
| Dim snakeLen As Integer | |
| Dim score As Integer | |
| Sub start() | |
| score = 0 | |
| currentDir = DIR.RIGHT_DIR | |
| snakeLen = 0 | |
| initTable | |
| addSnakeNode 0, 0 | |
| addSnakeNode 1, 0 | |
| createFood | |
| Application.OnKey "{UP}", "'changeDir " & "1'" | |
| Application.OnKey "{DOWN}", "'changeDir " & "2'" | |
| Application.OnKey "{LEFT}", "'changeDir " & "3'" | |
| Application.OnKey "{RIGHT}", "'changeDir " & "4'" | |
| tick | |
| End Sub | |
| Sub initTable() | |
| Dim x As Integer, y As Integer | |
| For y = 0 To HEIGHT - 1 | |
| For x = 0 To WIDTH - 1 | |
| background(y, x) = DATA.BACK_DATA | |
| Next | |
| Next | |
| End Sub | |
| Sub addSnakeNode(ByVal x As Integer, ByVal y As Integer) | |
| background(y, x) = DATA.SNAKE_DATA | |
| snake(snakeLen, 0) = x | |
| snake(snakeLen, 1) = y | |
| snakeLen = snakeLen + 1 | |
| End Sub | |
| Sub createFood() | |
| Dim x As Integer, y As Integer | |
| Do | |
| x = Int(Rnd * WIDTH) | |
| y = Int(Rnd * HEIGHT) | |
| Loop Until background(y, x) <> DATA.SNAKE_DATA | |
| background(y, x) = DATA.FOOD_DATA | |
| End Sub | |
| Sub updateUI() | |
| Dim x As Integer, y As Integer | |
| For y = 0 To HEIGHT - 1 | |
| For x = 0 To WIDTH - 1 | |
| Select Case background(y, x) | |
| Case DATA.BACK_DATA | |
| Cells(y + 1, x + 1).Interior.ColorIndex = 0 | |
| Case DATA.SNAKE_DATA | |
| Cells(y + 1, x + 1).Interior.Color = vbGreen | |
| Case DATA.FOOD_DATA | |
| Cells(y + 1, x + 1).Interior.Color = vbRed | |
| End Select | |
| Next | |
| Next | |
| End Sub | |
| Sub tick() | |
| updateUI | |
| Dim newX As Integer, newY As Integer | |
| Select Case currentDir | |
| Case DIR.UP_DIR | |
| newX = snake(snakeLen - 1, 0) | |
| newY = snake(snakeLen - 1, 1) - 1 | |
| Case DIR.DOWN_DIR | |
| newX = snake(snakeLen - 1, 0) | |
| newY = snake(snakeLen - 1, 1) + 1 | |
| Case DIR.LEFT_DIR | |
| newX = snake(snakeLen - 1, 0) - 1 | |
| newY = snake(snakeLen - 1, 1) | |
| Case DIR.RIGHT_DIR | |
| newX = snake(snakeLen - 1, 0) + 1 | |
| newY = snake(snakeLen - 1, 1) | |
| End Select | |
| '出界调整 | |
| If newX < 0 Then | |
| newX = WIDTH - 1 | |
| ElseIf newX > WIDTH - 1 Then | |
| newX = 0 | |
| End If | |
| If newY < 0 Then | |
| newY = HEIGHT - 1 | |
| ElseIf newY > HEIGHT - 1 Then | |
| newY = 0 | |
| End If | |
| '移动 | |
| If background(newY, newX) = DATA.FOOD_DATA Then | |
| score = score + 1 | |
| addSnakeNode newX, newY | |
| createFood | |
| ElseIf background(newY, newX) = DATA.SNAKE_DATA Then | |
| MsgBox "游戏结束！得分 " & score | |
| End | |
| Else | |
| background(snake(0, 1), snake(0, 0)) = DATA.BACK_DATA | |
| background(newY, newX) = DATA.SNAKE_DATA | |
| For i = 0 To snakeLen - 2 | |
| snake(i, 0) = snake(i + 1, 0) | |
| snake(i, 1) = snake(i + 1, 1) | |
| Next | |
| snake(snakeLen - 1, 0) = newX | |
| snake(snakeLen - 1, 1) = newY | |
| End If | |
| fireTime = Now + TimeValue("00:00:01") | |
| Application.OnTime EarliestTime:=fireTime, Procedure:="tick", Schedule:=True | |
| End Sub | |
| Sub changeDir(dirNum) | |
| Select Case dirNum | |
| Case 1 | |
| If currentDir <> DIR.DOWN_DIR Then currentDir = DIR.UP_DIR | |
| Case 2 | |
| If currentDir <> DIR.UP_DIR Then currentDir = DIR.DOWN_DIR | |
| Case 3 | |
| If currentDir <> DIR.RIGHT_DIR Then currentDir = DIR.LEFT_DIR | |
| Case 4 | |
| If currentDir <> DIR.LEFT_DIR Then currentDir = DIR.RIGHT_DIR | |
| End Select | |
| End Sub | |
| Sub pause() | |
| Application.OnTime EarliestTime:=fireTime, Procedure:="tick", Schedule:=False | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment