上次那个发表的贪吃蛇程序有bug，事实上是对这去年已经完成的程序的思路模糊了，在加入用户交互界面时产生了bug。今次略作修改，大家把下面的语句覆盖原来版本中同名函数和过程应该可以了。老实说，我对这vba还是不太熟悉。我在修改程序时曾使Excel产生错误退出后不论怎么改都是程序崩溃，一气之下新建一个文件，把代码复制过去，居然又正常了！对这样的东西还是没有多大信心，大家还是帮我多多debug吧。
首先是在宏里面的代码。
Function main()
gaming = False
If Worksheets.Count < 2 Then
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
Else
Worksheets(Worksheets.Count).Select
End If
Load UserForm1
UserForm1.Show
End Function
Function game_over()
If timerset <> 0 Then
timerset = KillTimer(0, timerset)
pulsed = False
End If
If MsgBox("Game over...temporarily. Try again?", vbOKCancel, "?????") = vbOK Then
Range(Cells(top + 1, left + 1), Cells(bottom - 1, right - 1)).Interior.ColorIndex = 0
Range(Cells(top + 1, left + 1), Cells(bottom - 1, right - 1)).ClearContents
Call game_initial
Else
Cells.ClearContents
Cells.Interior.ColorIndex = 0
gaming = False
SendKeys "%{F4}"
End If
End Function
以下是窗口事件处理代码。
Private Sub UserForm_Initialize()
UserForm1.Label1.Caption = "NO PLAY , NO GAME"
Call game_initial
If gaming Then
UserForm1.Label2.Caption = "Arrow keys to move. P key to pause the game E key to end the game"
Else
UserForm1.Label1.Caption = "Something happened !"
Call game_over
End If
End Sub
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If gaming Then
If Not pulsed Then
pulsed = True
timerset = SetTimer(0, 0, 150, AddressOf snake_move)
UserForm1.Label2.Caption = "Arrow keys to move. P key to pause the game E key to end the game"
End If
Select Case KeyCode
Case vbKeyUp
head_movement = 2
Case vbKeyDown
head_movement = 4
Case vbKeyLeft
head_movement = 3
Case vbKeyRight
head_movement = 1
Case vbKeyP
If timerset <> 0 Then
timerset = KillTimer(0, timerset)
pulsed = False
End If
UserForm1.Label2.Caption = "Game paused. Any key to resume. "
Case vbKeyE
Call game_over
End Select
End If
End Sub
Private Sub UserForm_Terminate()
MsgBox ("You have finished the game with the score of " + Str(score))
Worksheets(1).Select
End Sub
最后是把这三个Excel程序在我机子上运行的截图发一发。
