我用VB做了个贪吃蛇的游戏 - vb吧

level 5

slippermummy 楼主

2010年08月17日 12点08分 1

level 5

slippermummy 楼主

'！！！注意了,先把窗体的BorderStyle属性设为0-None(否则有bug),然后直接粘贴代即可
'游戏控制:ESC键退出游戏.←,↑,→,↓或A,W,D,S键控制方向,暂停还没想好怎么写
'本想将程序美化后再发出来(比如给字符上上色,加点菜单或按钮什么的),但这对于代码的交流似乎没有好处...(没有按书写规范,见谅)
'代码中如有bug希望大家指出
'代码若能优化或简化之处请高手指点,非常感谢
'本人业余爱好者,QQ:305349746
Option Explicit
Option Base 1
Dim WithEvents Tim As Timer '计时器
Dim row, col As Integer '行,列数
Dim r As Single '步距(字符高度)
Dim Txt As String '句子
Dim Word() As String '单字
Dim A() '字符的地址
Dim PNum As Integer '实时显示字符数
Dim n As Integer   '计数器
Dim DirCode As Integer '决定着蛇头的运动方向
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = 27) Then End '按ESC键退出游戏
Select Case DirCode
Case 37, 39, 65, 68 '当按下←或→键是再按←→键无效
     Select Case KeyCode
     Case 38, 40, 87, 83
     DirCode = KeyCode
     End Select
Case 38, 40, 87, 83 '当按下↑或↓键是再按↑↓键无效
     Select Case KeyCode
     Case 37, 39, 65, 68
     DirCode = KeyCode
     End Select
End Select
End Sub
Private Sub Form_Load()
Randomize (Timer)
Me.Caption = "▲您应该先把form1的BorderStyle属性设为0-None,否则有小bug--lyxue)"
Me.AutoRedraw = True
Set Tim = Controls.Add("VB.Timer", "Tim", Me) '计时器
Tim.Interval = 250 '游戏速度相关
Me.FontName = "黑体" '字体
Me.FontSize = 15 '字符大小
r = Me.TextHeight("蛇") '步距大小(字高)
row = 31: col = 15 '行,列数(点阵数=行*列)
Me.Width = r * row: Me.Height = r * col '场地大小
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 '居中显示
Dim t '输入一句话,化成一条蛇:
Do
Txt = ""
t = InputBox("游戏开始前,先在下框中输入一句您想说的话吧:" & Chr(13) & Chr(13) & "**下框中的汉字可能无法正常显示,但游戏开始后恢复正常**", "游戏开始前", "君不见*垓下帐里虞姬伤*章台柳下摇满霜*长恨歌里恨见长*沈园小径空留香*又何妨*苦乐相参本无常*知音能得几回赏*明月沟渠各一方*戍客何必尽望乡")
For n = 1 To Len(t)
Txt = Txt & IIf(Mid(t, n, 1) = " ", "", Mid(t, n, 1))
Next n
If Txt = "" Then
End
ElseIf Len(Txt) < 3 Then
n = MsgBox(Len(Txt) & "个字符也太少了点吧,请您重新输入" & Chr(13) & Chr(13) & "       (不计空格,至少要输入3个字符)", 0, "提示")
End If
Loop While Len(Txt) < 3
ReDim Word(Len(Txt)), A(Len(Txt), 2) '根据字符个数把蛇分为若干段(数组变量A(num1,num2)用于存储每段蛇身的坐标,其中num1说明是蛇身的第几截,num2若为1,表示X坐标,若为2,表示Y坐标)
For n = 1 To Len(Txt)
Word(n) = Mid(Txt, n, 1) '把句子中的每个字符赋予变量(句子中每个字符都是蛇身的一部分)
Next n
A(1, 1) = 0: A(1, 2) = 0 '蛇头的初始地址
DirCode = 39 '决定初始方向
PNum = 2 '刚开始只显示两个字符
Call Food '添加第2个字符(第一个食物)
End Sub
Sub Food() '添加新食物,这段循环让我崇拜自己好一阵...(高手别笑)
Do
A(PNum, 1) = Int(Rnd * row) * r: A(PNum, 2) = Int(Rnd * col) * r '随机分配新食物的位置
For n = 1 To PNum - 1
If (A(PNum, 1) = A(n, 1)) * (A(PNum, 2) = A(n, 2)) Then Exit For '逐个检查,若食物刚好落在蛇身上,则重新机选食物的位置
Next n
Loop Until n = PNum   '若食物没落在蛇身上则退出循环
End Sub
Private Sub Tim_Timer()
'刷新显示
Cls
For n = 1 To PNum
CurrentX = A(n, 1): CurrentY = A(n, 2)
Print Word(n)
Next n
If (A(1, 1) + r <= 0) + (A(1, 2) + r <= 10) + (A(1, 1) >= Me.Width) + (A(1, 2) >= Me.Height) Then GameOver ("您的蛇蛇撞破头了--lyxue")   '如果撞墙则游戏结束
'蛇头与其它字符相接触判断:如果撞到蛇身则游戏结束,如果吃到到食物就把食物变成新的尾巴
For n = 2 To PNum
If (A(1, 1) = A(n, 1)) * (A(1, 2) = A(n, 2)) Then
If n <> PNum Then '撞到蛇身则游戏结束
GameOver ("您的蛇蛇把自己给咬了--lyxue")
ElseIf n = Len(Txt) Then '游戏胜利
GameOver ("恭喜，您胜利啦！")
ElseIf n = PNum Then '吃到食物则显示的字符数加1(新的食物)
PNum = PNum + 1
Call Food '添加新食物
End If
End If
Next n
'蛇身向前移动一格
For n = PNum - 2 To 1 Step -1
A(n + 1, 1) = A(n, 1): A(n + 1, 2) = A(n, 2)
Next n
'决定蛇头运动方向:
Select Case DirCode
Case 37, 65
A(1, 1) = A(1, 1) - r '向左运动
Case 38, 87
A(1, 2) = A(1, 2) - r '向上运动
Case 39, 68
A(1, 1) = A(1, 1) + r '向右运动
Case 40, 83
A(1, 2) = A(1, 2) + r '向下运动
End Select
End Sub
Sub GameOver(t As String)
Tim.Interval = 0
Cls
Me.FontSize = 30
Me.ForeColor = vbRed
CurrentX = (Me.Width - Me.TextWidth(t)) / 2
CurrentY = (Me.Height - Me.TextHeight(t)) / 2
Print t
End Sub

2010年08月17日 12点08分 2

level 5

slippermummy 楼主

对了,现在想添加个暂停功能,就是按下空格键后暂停
如果只是把计时器设为0会有bug
大家支支招

2010年08月17日 12点08分 3

level 5

slippermummy 楼主

奇怪了,为何全编译执行都通过,生成exe却不能运行.
这是为何

2010年08月17日 12点08分 4

level 5

vlarmg◎

2010年08月18日 03点08分 5

level 5

slippermummy 楼主

'更新一下代码,能够鼠标控制,增加了关闭按钮,修改bug
'[email protected]
'！！！应该先把Form1的BorderStyle属性设为0-None！！！
Option Explicit
Dim WithEvents Tim As Timer '计时器
Dim row, col As Integer '行,列数
Dim r As Single '步距
Dim WordSize As Integer '字体大小
Dim Txt As String '句子
Dim Word() As String '单字
Dim A() As Single   '字符的地址
Dim PNum As Integer '实时显示字符数
Dim n As Integer   '计数器
Dim DirCode As Integer '决定着蛇头的运动方向
Dim Q(1) As Integer 'Q(0)控制关闭按钮颜色,Q(1)
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = 27) Then End '按ESC键退出游戏
Select Case DirCode
Case 37, 39, 65, 68 '当按下←或→键是再按←→键无效
     Select Case KeyCode
     Case 38, 40, 87, 83
     DirCode = KeyCode
     End Select
Case 38, 40, 87, 83 '当按下↑或↓键是再按↑↓键无效
     Select Case KeyCode
     Case 37, 39, 65, 68
     DirCode = KeyCode
     End Select
End Select
End Sub
Private Sub Form_Load()
Dim t '输入一句话,化成一条蛇:
Do
Txt = ""
t = InputBox("游戏开始前,先在下框中输入一句您想说的话吧:", "游戏开始前", "I LOVE YOU")
For n = 1 To Len(t)
Txt = Txt & IIf(Mid(t, n, 1) = " ", "", Mid(t, n, 1))
Next n
If Txt = "" Then
End
ElseIf Len(Txt) < 3 Then
n = MsgBox(Len(Txt) & "个字符也太少了点吧,请您重新输入" & Chr(13) & Chr(13) & "       (不计空格,至少要输入3个字符)", 0, "提示")
End If
Loop While Len(Txt) < 3
Randomize (Timer)
Me.Caption = "▲您应该先把form1的BorderStyle属性设为0-None,否则有小bug--lyxue)"
Me.AutoRedraw = True
Set Tim = Controls.Add("VB.Timer", "Tim", Me) '计时器
Tim.Interval = 250 '游戏速度相关
WordSize = 15
Me.FontSize = WordSize '字符大小
r = Me.TextHeight("蛇") '步距大小(字高)
row = 31: col = 15 '行,列数(点阵数=行*列)
Me.Width = r * row: Me.Height = r * col '场地大小
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 '居中显示
ReDim Word(Len(Txt)), A(Len(Txt), 1 To 2) '根据字符个数把蛇分为若干段(数组变量A(num1,num2)用于存储每段蛇身的坐标,其中num1说明是蛇身的第几截,num2若为1,表示X坐标,若为2,表示Y坐标)
For n = 1 To Len(Txt)
Word(n) = Mid(Txt, n, 1) '把句子中的每个字符赋予变量(句子中每个字符都是蛇身的一部分)
Next n
'创建关闭按钮:
Word(0) = "×"
Q(0) = 0 '状态
Q(1) = r * 2 '大小
A(0, 1) = Me.Width - Q(1)
A(0, 2) = 0
A(1, 1) = 0: A(1, 2) = 0 '蛇头的初始地址
DirCode = 39 '决定初始方向
PNum = 2 '刚开始只显示两个字符
Call Food '添加第2个字符(第一个食物)
End Sub
Sub Food() '添加新食物,这段循环让我崇拜自己好一阵...(高手别笑)
Do
A(PNum, 1) = Int(Rnd * row) * r: A(PNum, 2) = Int(Rnd * col) * r '随机分配新食物的位置
For n = 1 To PNum - 1
If (A(PNum, 1) = A(n, 1)) * (A(PNum, 2) = A(n, 2)) Then Exit For '逐个检查,若食物刚好落在蛇身上,则重新机选食物的位置

2010年08月18日 03点08分 6

想念怎如相见

大神，可以加个暂停么.. [呵呵]

2017年06月26日 12点06分

🌴菠萝蜜🌴

@想念怎如相见以前写来自己玩的，带暂停功能

2017年06月26日 14点06分

level 5

slippermummy 楼主

Next n
Loop Until n = PNum '若食物没落在蛇身上则退出循环
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (X > A(0, 1)) * (Y < Q(1)) Then End '点击关闭按钮时结束游戏
'用鼠标控制移动:
Select Case DirCode
Case 38, 40, 87, 83
DirCode = IIf(X - A(1, 1) > 0, 39, 37)
Case 37, 39, 65, 68
DirCode = IIf(Y - A(1, 2) > 0, 40, 38)
End Select
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'鼠标指向关闭按钮时显亮
If (X > A(0, 1)) * (Y < Q(1)) Then
Q(0) = 1
Call Qcmd
Else
Q(0) = 0
End If
End Sub
Private Sub Tim_Timer()
Cls '刷新显示
Call Qcmd '显示关闭按钮
'显示蛇:
Me.FontSize = WordSize
For n = 1 To PNum
Me.ForeColor = vbBlack
CurrentX = A(n, 1): CurrentY = A(n, 2)
Print Word(n)
Next n
If (A(1, 1) < 0) + (A(1, 2) < 0) + (A(1, 1) = Me.Width) + (A(1, 2) = Me.Height) Then GameOver ("您的蛇蛇撞破头了--lyxue") '如果撞墙则游戏结束
'蛇头与其它字符相接触判断:如果撞到蛇身则游戏结束,如果吃到到食物就把食物变成新的尾巴
For n = 2 To PNum
If (A(1, 1) = A(n, 1)) * (A(1, 2) = A(n, 2)) Then
If n <> PNum Then '撞到蛇身则游戏结束
GameOver ("您的蛇蛇把自己给咬了--lyxue")
ElseIf n = Len(Txt) Then '游戏胜利
GameOver ("恭喜，您胜利啦！")
ElseIf n = PNum Then '吃到食物则显示的字符数加1(新的食物)
PNum = PNum + 1
Call Food '添加新食物
End If
End If
Next n
'蛇身向前移动一格
For n = PNum - 2 To 1 Step -1
A(n + 1, 1) = A(n, 1): A(n + 1, 2) = A(n, 2)
Next n
'决定蛇头运动方向:
Select Case DirCode
Case 37, 65
A(1, 1) = A(1, 1) - r '向左运动
Case 38, 87
A(1, 2) = A(1, 2) - r '向上运动
Case 39, 68
A(1, 1) = A(1, 1) + r '向右运动
Case 40, 83
A(1, 2) = A(1, 2) + r '向下运动
End Select
End Sub
Sub GameOver(t As String)
Tim.Interval = 0
Cls
Qcmd
Me.FontSize = WordSize * 2
Me.ForeColor = vbRed
CurrentX = (Me.Width - Me.TextWidth(t)) / 2
CurrentY = (Me.Height - Me.TextHeight(t)) / 2
Print t
End Sub
Sub Qcmd()
If Q(0) = 0 Then Me.ForeColor = RGB(180, 180, 180) Else Me.ForeColor = vbBlue
Me.FontSize = WordSize * 2
CurrentX = A(0, 1)
CurrentY = A(0, 2)
Print Word(0)
End Sub

2010年08月18日 03点08分 7