用VB写一个贪吃蛇游戏_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
用VB写一个贪吃蛇游戏
&&所有代码都在里面哦~
阅读已结束，下载文档到电脑
想免费下载本文？
定制HR最喜欢的简历
下载文档到电脑，方便使用
还剩8页未读，继续阅读
定制HR最喜欢的简历
你可能喜欢我用VB做了个贪吃蛇的游戏【vb吧】_百度贴吧
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&签到排名：今日本吧第个签到，本吧因你更精彩，明天继续来努力！
本吧签到人数：0成为超级会员，使用一键签到本月漏签0次！成为超级会员，赠送8张补签卡连续签到：天&&累计签到：天超级会员单次开通12个月以上，赠送连续签到卡3张
关注：103,243贴子：
我用VB做了个贪吃蛇的游戏收藏
vb 编程培训选择达内的理由1,企业级开发环境2,项目实战教学3,net课程可选4,金牌讲师授课5,周末/业余班任选.vb 编程培训首选达内--美国上市公司!
'！！！注意了,先把窗体的BorderStyle属性设为0-None(否则有bug),然后直接粘贴代即可'游戏控制:ESC键退出游戏.←,↑,→,↓或A,W,D,S键控制方向,暂停还没想好怎么写'本想将程序美化后再发出来(比如给字符上上色,加点菜单或按钮什么的),但这对于代码的交流似乎没有好处...(没有按书写规范,见谅)'代码中如有bug希望大家指出'代码若能优化或简化之处请高手指点,非常感谢'本人业余爱好者,QQ:Option ExplicitOption Base 1Dim 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 DirCodeCase 37, 39, 65, 68 '当按下←或→键是再按←→键无效&&&& Select Case KeyCode&&&& Case 38, 40, 87, 83&&&& DirCode = KeyCode&&&& End SelectCase 38, 40, 87, 83 '当按下↑或↓键是再按↑↓键无效&&&& Select Case KeyCode&&&& Case 37, 39, 65, 68&&&& DirCode = KeyCode&&&& End SelectEnd SelectEnd SubPrivate Sub Form_Load()Randomize (Timer)Me.Caption = "▲您应该先把form1的BorderStyle属性设为0-None,否则有小bug--lyxue)"Me.AutoRedraw = TrueSet 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 '输入一句话,化成一条蛇:DoTxt = ""t = InputBox("游戏开始前,先在下框中输入一句您想说的话吧:" & Chr(13) & Chr(13) & "**下框中的汉字可能无法正常显示,但游戏开始后恢复正常**", "游戏开始前", "君不见*垓下帐里虞姬伤*章台柳下摇满霜*长恨歌里恨见长*沈园小径空留香*又何妨*苦乐相参本无常*知音能得几回赏*明月沟渠各一方*戍客何必尽望乡")For n = 1 To Len(t)Txt = Txt & IIf(Mid(t, n, 1) = " ", "", Mid(t, n, 1))Next nIf Txt = "" ThenEndElseIf Len(Txt) & 3 Thenn = MsgBox(Len(Txt) & "个字符也太少了点吧,请您重新输入" & Chr(13) & Chr(13) & "&&&&&& (不计空格,至少要输入3个字符)", 0, "提示")End IfLoop While Len(Txt) & 3ReDim 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 nA(1, 1) = 0: A(1, 2) = 0 '蛇头的初始地址DirCode = 39 '决定初始方向PNum = 2 '刚开始只显示两个字符Call Food '添加第2个字符(第一个食物)End SubSub Food() '添加新食物,这段循环让我崇拜自己好一阵...(高手别笑)DoA(PNum, 1) = Int(Rnd * row) * r: A(PNum, 2) = Int(Rnd * col) * r '随机分配新食物的位置For n = 1 To PNum - 1If (A(PNum, 1) = A(n, 1)) * (A(PNum, 2) = A(n, 2)) Then Exit For '逐个检查,若食物刚好落在蛇身上,则重新机选食物的位置Next nLoop Until n = PNum&& '若食物没落在蛇身上则退出循环End SubPrivate Sub Tim_Timer()'刷新显示ClsFor n = 1 To PNumCurrentX = A(n, 1): CurrentY = A(n, 2)Print Word(n)Next nIf (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 PNumIf (A(1, 1) = A(n, 1)) * (A(1, 2) = A(n, 2)) ThenIf n && PNum Then '撞到蛇身则游戏结束GameOver ("您的蛇蛇把自己给咬了--lyxue")ElseIf n = Len(Txt) Then '游戏胜利GameOver ("恭喜，您胜利啦！")ElseIf n = PNum Then '吃到食物则显示的字符数加1(新的食物)PNum = PNum + 1Call Food '添加新食物End IfEnd IfNext n'蛇身向前移动一格For n = PNum - 2 To 1 Step -1A(n + 1, 1) = A(n, 1): A(n + 1, 2) = A(n, 2)Next n'决定蛇头运动方向:Select Case DirCodeCase 37, 65A(1, 1) = A(1, 1) - r '向左运动Case 38, 87A(1, 2) = A(1, 2) - r '向上运动Case 39, 68A(1, 1) = A(1, 1) + r '向右运动Case 40, 83A(1, 2) = A(1, 2) + r '向下运动End SelectEnd SubSub GameOver(t As String)Tim.Interval = 0ClsMe.FontSize = 30Me.ForeColor = vbRedCurrentX = (Me.Width - Me.TextWidth(t)) / 2CurrentY = (Me.Height - Me.TextHeight(t)) / 2Print tEnd Sub
对了,现在想添加个暂停功能,就是按下空格键后暂停如果只是把计时器设为0会有bug大家支支招
奇怪了,为何全编译执行都通过,生成exe却不能运行.这是为何
'更新一下代码,能够鼠标控制,增加了关闭按钮,修改bug''！！！应该先把Form1的BorderStyle属性设为0-None！！！Option ExplicitDim 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 DirCodeCase 37, 39, 65, 68 '当按下←或→键是再按←→键无效&&&& Select Case KeyCode&&&& Case 38, 40, 87, 83&&&& DirCode = KeyCode&&&& End SelectCase 38, 40, 87, 83 '当按下↑或↓键是再按↑↓键无效&&&& Select Case KeyCode&&&& Case 37, 39, 65, 68&&&& DirCode = KeyCode&&&& End SelectEnd SelectEnd SubPrivate Sub Form_Load()Dim t '输入一句话,化成一条蛇:DoTxt = ""t = InputBox("游戏开始前,先在下框中输入一句您想说的话吧:", "游戏开始前", "I LOVE YOU")For n = 1 To Len(t)Txt = Txt & IIf(Mid(t, n, 1) = " ", "", Mid(t, n, 1))Next nIf Txt = "" ThenEndElseIf Len(Txt) & 3 Thenn = MsgBox(Len(Txt) & "个字符也太少了点吧,请您重新输入" & Chr(13) & Chr(13) & "&&&&&& (不计空格,至少要输入3个字符)", 0, "提示")End IfLoop While Len(Txt) & 3Randomize (Timer)Me.Caption = "▲您应该先把form1的BorderStyle属性设为0-None,否则有小bug--lyxue)"Me.AutoRedraw = TrueSet Tim = Controls.Add("VB.Timer", "Tim", Me) '计时器Tim.Interval = 250 '游戏速度相关WordSize = 15Me.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) = 0A(1, 1) = 0: A(1, 2) = 0 '蛇头的初始地址DirCode = 39 '决定初始方向PNum = 2 '刚开始只显示两个字符Call Food '添加第2个字符(第一个食物)End SubSub Food() '添加新食物,这段循环让我崇拜自己好一阵...(高手别笑)DoA(PNum, 1) = Int(Rnd * row) * r: A(PNum, 2) = Int(Rnd * col) * r '随机分配新食物的位置For n = 1 To PNum - 1If (A(PNum, 1) = A(n, 1)) * (A(PNum, 2) = A(n, 2)) Then Exit For '逐个检查,若食物刚好落在蛇身上,则重新机选食物的位置
Next nLoop Until n = PNum&& '若食物没落在蛇身上则退出循环End SubPrivate 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 DirCodeCase 38, 40, 87, 83 DirCode = IIf(X - A(1, 1) & 0, 39, 37)Case 37, 39, 65, 68DirCode = IIf(Y - A(1, 2) & 0, 40, 38)End SelectEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)'鼠标指向关闭按钮时显亮If (X & A(0, 1)) * (Y & Q(1)) ThenQ(0) = 1Call QcmdElseQ(0) = 0End IfEnd SubPrivate Sub Tim_Timer()Cls '刷新显示Call Qcmd '显示关闭按钮'显示蛇:Me.FontSize = WordSizeFor n = 1 To PNumMe.ForeColor = vbBlackCurrentX = A(n, 1): CurrentY = A(n, 2)Print Word(n)Next nIf (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 PNumIf (A(1, 1) = A(n, 1)) * (A(1, 2) = A(n, 2)) ThenIf n && PNum Then '撞到蛇身则游戏结束GameOver ("您的蛇蛇把自己给咬了--lyxue")ElseIf n = Len(Txt) Then '游戏胜利GameOver ("恭喜，您胜利啦！")ElseIf n = PNum Then '吃到食物则显示的字符数加1(新的食物)PNum = PNum + 1Call Food '添加新食物End IfEnd IfNext n'蛇身向前移动一格For n = PNum - 2 To 1 Step -1A(n + 1, 1) = A(n, 1): A(n + 1, 2) = A(n, 2)Next n'决定蛇头运动方向:Select Case DirCodeCase 37, 65A(1, 1) = A(1, 1) - r '向左运动Case 38, 87A(1, 2) = A(1, 2) - r '向上运动Case 39, 68A(1, 1) = A(1, 1) + r '向右运动Case 40, 83A(1, 2) = A(1, 2) + r '向下运动End SelectEnd SubSub GameOver(t As String)Tim.Interval = 0ClsQcmdMe.FontSize = WordSize * 2Me.ForeColor = vbRedCurrentX = (Me.Width - Me.TextWidth(t)) / 2CurrentY = (Me.Height - Me.TextHeight(t)) / 2Print tEnd SubSub Qcmd()If Q(0) = 0 Then Me.ForeColor = RGB(180, 180, 180) Else Me.ForeColor = vbBlueMe.FontSize = WordSize * 2CurrentX = A(0, 1)CurrentY = A(0, 2)Print Word(0)End Sub
好棒，给我发一个：
呵呵呵，顶顶顶！
通用管理软件不合适,定做管理软件太昂贵,自己开发太难,何不试试vb编程工具FoxTable?
这是我做的
回复：12楼不行啊运行以后就会这样
楼主求助~~~
楼主。求助
十五字十五字十五字十五字十五字
顶 十五字十五字十五字十五字十五字
求吧主把程序发我一份，，，，我头都大了也搞不出来
楼主，可以发一份源代码吗？谢谢啦。
Option Explicit　Dim sheet(), key, snake(), lastkey, block(1 To 2), moving As Boolean, pause As Boolean, tm　Private Sub Form_Activate()　　Caption = &贪吃蛇简易版 By pt98　(SPACE-开始或暂停,Q-退出,F-手工添加青蛙　带加速减速功能)&　　AutoRedraw = True: BackColor = vbBlack: ForeColor = vbGreen '定义form属性　　block(1) = &■&: block(2) = &¤& '蛇身及食物标志End Sub　Function initsnake()　　Dim x, y　　ReDim sheet(1 To 50, 1 To 50) '定义表格尺寸　　x = Int(UBound(sheet, 1) / 2): y = Int(UBound(sheet, 2) / 2) '第一次蛇身出现位置　　ReDim Preserve snake(1 To 2)　　snake(1) = x: snake(2) = y: sheet(x, y) = block(1)　　Randomize: key = 37 + Int(Rnd * 4) '随机产生移动方向　　lastkey = key: addfood 1: tm = 200End Function　Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)　　If KeyCode = 70 Then Randomize: addfood Int(Rnd * 10 + 1) '手工添加五只青蛙　　If KeyCode = 81 Then End　　If KeyCode = 32 Then　　　　If moving Then　　　　　　pause = Not pause '移动中pause轮流切换　　　　Else　　　　　　moving = True: initsnake: movestep '非移动中直接开始游戏　　　　End If　　End If　　If KeyCode &= 37 And KeyCode &= 40 And moving Then '有效键　　　　If Abs(KeyCode - lastkey) = 2 Then tm = 600: Exit Sub '连续方向键为相反方向就减速　　　　If KeyCode = lastkey Then '连续方向键相同方向就加速　　　　　　If tm &= 60 Then tm = tm - 20　　　　Else　　　　　　tm = 200 '复位速度　　　　End If　　　　key = KeyCode: lastkey = key　　End IfEnd Sub　Function movestep()　　Dim i, j, s, t, foodflag As Boolean　　Do　　　　Select Case key　　　　Case 38, 40 '上、下　　　　　　If snake(1) = IIf(key = 38, 1, UBound(sheet, 1)) Then Exit Do '碰壁　　　　　　If sheet(snake(1) + IIf(key = 38, -1, 1), snake(2)) = block(1) Then Exit Do '吃到自己　　　　　　If sheet(snake(1) + IIf(key = 38, -1, 1), snake(2)) = block(2) Then foodflag = True '吃到青蛙　　　　　　resizesnake foodflag '重定义蛇身　　　　　　snake(1) = snake(1) + IIf(key = 38, -1, 1): If UBound(snake) &= 4 Then snake(2) = snake(4) '蛇头移动　　　　Case 37, 39 '左、右　　　　　　If snake(2) = IIf(key = 37, 1, UBound(sheet, 2)) Then Exit Do　　　　　　If sheet(snake(1), snake(2) + IIf(key = 37, -1, 1)) = block(1) Then Exit Do　　　　　　If sheet(snake(1), snake(2) + IIf(key = 37, -1, 1)) = block(2) Then foodflag = True　　　　　　resizesnake foodflag　　　　　　snake(2) = snake(2) + IIf(key = 37, -1, 1): If UBound(snake) &= 4 Then snake(1) = snake(3)　　　　End Select　　　　sheet(snake(1), snake(2)) = block(1): printscreen　　　　Do While pause: DoEvents: Loop '暂停　　　　t = Timer: Do: DoEvents　　　　Loop Until Timer - t &= tm / 1000 '移动速度　　　　Randomize: If Int(Rnd * tm) + 1 = 1 Then addfood Int(Rnd * 2) + 1 '随机产生青蛙　　Loop　　moving = False: MsgBox &Game Over!& & vbNewLine & &吃到青蛙数：& & UBound(snake) / 2 - 1, vbCritical, &贪吃蛇&End Function　Function resizesnake(foodflag)　　Dim i　　If foodflag Then　　　　ReDim Preserve snake(1 To UBound(snake) + 2): foodflag = False '蛇身增加一块　　Else　　　　sheet(snake(UBound(snake) - 1), snake(UBound(snake))) = vbNullString　　End If　　For i = UBound(snake) To 3 Step -1: snake(i) = snake(i - 2): Next '移动蛇身坐标End Function　Function printscreen()　　Dim i, j, s　　For i = 1 To UBound(sheet, 1)　　　　For j = 1 To UBound(sheet, 2)　　　　　　s = s & IIf(sheet(i, j) = vbNullString, Space(2), sheet(i, j))　　　　Next　　　　s = s & vbNewLine　　Next　　Me.Cls: Print sEnd Function　Function addfood(n)　　Dim x, y, i　　For i = 1 To n　　　　Randomize　　　　x = Int(Rnd * UBound(sheet, 1)) + 1: y = Int(Rnd * UBound(sheet, 2)) + 1　　　　If sheet(x, y) = vbNullString Then sheet(x, y) = block(2) Else: i = i - 1　　　　DoEvents　　NextEnd Function　Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)　　EndEnd Sub　Private Sub Form_Resize()　　If WindowState = vbMaximized Then WindowState = vbNormal　　Height = 9550: Width = 9250End Sub
登录百度帐号推荐应用