| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1245 人关注过本帖
标题:请教贪吃蛇小游戏代码注释,谢谢
只看楼主 加入收藏
wangyu199005
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2011-6-3
结帖率:0
收藏
已结贴  问题点数:20 回复次数:7 
请教贪吃蛇小游戏代码注释,谢谢
Enum enMenuIndex
m_Start
m_Auto
m_Fast8:43 2011-6-3
m_Bar1
m_ShowNo
m_ShowTo
m_ShowNum
m_ShowWen
m_Bar2
m_ShowRect
m_Line '此常数必须在最后,便于调试
End Enum
Enum enTo
to_Up
to_Down
to_Left
to_Right
End Enum
Dim ctTo As enTo, ctZong As Long, ctFoot As Long, ctHead As Long
Dim ctB As Long, ctSize As Long, ctH As Long, ctL As Long, ctEsc As Boolean
Dim ctDown As Long, ctRight As Long
Dim ctFen As Long, ctMaxFen As Long, ctAutoFen As Long, ctAutoMax As Long, ctAuto As Boolean
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
   Case vbKeyUp:    If ctTo <> to_Down Then ctTo = to_Up
   Case vbKeyDown: If ctTo <> to_Up Then ctTo = to_Down
   Case vbKeyLeft: If ctTo <> to_Right Then ctTo = to_Left
   Case vbKeyRight: If ctTo <> to_Left Then ctTo = to_Right
   End Select
End Sub
Private Sub ShowBack(Optional AutoSize As Boolean)
Dim W As Single, H As Single, W1 As Single, H1 As Single
   
If Not AutoSize Then GoTo Back1
   
W1 = Me.Width - Me.ScaleX(Me.ScaleWidth, Me.ScaleMode, vbTwips)   '窗口边框宽度:缇
H1 = Me.Height - Me.ScaleY(Me.ScaleHeight, Me.ScaleMode, vbTwips) '窗口标题栏高度:缇
W = ctL * ctSize + ctB * 2: H = ctH * ctSize + ctB * 2
   
W = W + Me.TextWidth("A") * 14 '留出 14 个字符的空白区,显示成绩
For I = 0 To LabTai.Count - 1
     LabTai(I).Move ctRight + ctB * 0.5, ctB + ctSize * 1.2 * (I + 1)
Next
   
W = W1 + Me.ScaleX(W, Me.ScaleMode, vbTwips)
H = H1 + Me.ScaleY(H, Me.ScaleMode, vbTwips)
   
Me.Move (Screen.Width - W) * 0.5, (Screen.Height - H) * 0.5, W, H
   
Back1:
Me.Cls
Me.Line (ctB, ctB)-(ctRight, ctDown), RGB(0, 155, 0), BF

If Not mmFast(m_Line).Checked Then Exit Sub
Dim nStr As String
Me.Font.Size = 9
W1 = Me.TextWidth("A"): H1 = (ctSize - Me.TextHeight("A")) * 0.5
For H = 0 To ctH '横线
     Me.Line (ctB, ctB + H * ctSize)-Step(ctRight - ctB, 0)
     nStr = H + 1
     Me.CurrentX = ctB - Me.TextWidth(nStr)
     Me.CurrentY = ctB + H * ctSize + H1
     If H < ctH Then Me.Print nStr
Next
   
H1 = Me.TextHeight("A")
For H = 0 To ctL '纵线
     Me.Line (ctB + H * ctSize, ctB)-Step(0, ctDown - ctB)
     nStr = H + 1
     Me.CurrentX = ctB + H * ctSize + (ctSize - Me.TextWidth(nStr)) * 0.5
     Me.CurrentY = ctB - H1
     If H < ctL Then Me.Print nStr
Next
End Sub
Private Sub KjInit()
   '初始化
   Dim I As Long, nEnd As Long, S As Long, H As Long
   
   ctFoot = 2                    '同时出现的食物数
   ctZong = 10: ctTo = to_Right '初始长度、方向
   ctHead = 0: ctFen = 0         '蛇头序号,得分
   
   ctSize = 15                   '蛇身宽度(控件大小):像素
   ctB = 20                      '边框空白区:像素
   ctH = 25: ctL = 30            '活动区行列数
   
   ctDown = ctB + ctH * ctSize   '活动区底部位置
   ctRight = ctB + ctL * ctSize '活动区右部位置
   
   Call ShowFen
   If mmFast(m_ShowRect).Checked Then LabSnake(0).BorderStyle = 1 Else LabSnake(0).BorderStyle = 0
   LabSnake(0).Alignment = 2: LabSnake(0).BackColor = 255
   
   Randomize: H = 1 + Int((ctH - 1) * Rnd) '初始出发行
   nEnd = LabSnake.Count - 1 '当前末尾序号
   S = ctZong
   If S < nEnd Then S = nEnd
   For I = 0 To S
      If I > ctZong Then
         Unload LabSnake(I)
      Else
         If I > nEnd Then Load LabSnake(I): LabSnake(I).Visible = True
         LabSnake(I).Move ctB, ctB + ctSize * H, ctSize, ctSize
         If mmFast(m_ShowNum).Checked Then LabSnake(I).Caption = I Else LabSnake(I).Caption = ""
      End If
   Next
   
   ShaFoot(0).Shape = 3: ShaFoot(0).FillStyle = 0: ShaFoot(0).FillColor = RGB(0, 0, 255)
   ShaFoot(0).Move -ctB - ctSize, 0, ctSize, ctSize
   nEnd = ShaFoot.Count - 1 '当前末尾序号
   S = ctFoot - 1
   If S < nEnd Then S = nEnd
   For I = 0 To S
      If I > ctFoot - 1 Then
         Unload ShaFoot(I)
      Else
         If I > nEnd Then Load ShaFoot(I): ShaFoot(I).Visible = True
         Call RndFoot(I)
      End If
   Next
   
End Sub
Private Sub Form_Unload(Cancel As Integer)
   ctEsc = True
   If ctAutoMax < ctAutoFen Then ctAutoMax = ctAutoFen
   If ctMaxFen < ctFen Then ctMaxFen = ctFen
   SaveSetting "Snake", "Opt", "AutoMax", ctAutoMax
   SaveSetting "Snake", "Opt", "MaxFen", ctMaxFen
End Sub
Private Function KjIndex(Index As Long, AddNum As Long)
   KjIndex = Index + AddNum
   If AddNum > 0 Then
      If KjIndex > ctZong Then KjIndex = KjIndex - ctZong - 1
   Else
      If KjIndex < 0 Then KjIndex = KjIndex + ctZong + 1
   End If
End Function
Private Sub LabTai_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Index = 0 And Button = 1 Then Me.PopupMenu mFast, , LabTai(Index).Left, LabTai(Index).Top + LabTai(Index).Height
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then Me.PopupMenu mFast
End Sub
Private Sub Form_Load()
   Dim I As Long
   Me.Caption = "贪吃蛇" 'Snake
   Me.KeyPreview = True: Me.AutoRedraw = True
   Timer1.Interval = 100 '速度
   
   Me.ScaleMode = vbPixels ' 3 像素
   Timer1.Enabled = False
   mFast.Visible = False
   For I = 1 To m_Line
      Load mmFast(I)
   Next
   
    mmFast(m_Bar1).Caption = "-": mmFast(m_Bar2).Caption = "-"
   
   mmFast(m_Start).Caption = "开始/停止"
   mmFast(m_Auto).Caption = "自动游戏"
   mmFast(m_Fast).Caption = "快速"
   
   mmFast(m_ShowNo).Caption = "空白蛇身"
   mmFast(m_ShowTo).Caption = "显示前进方向"
   mmFast(m_ShowNum).Caption = "显示数字"
   mmFast(m_ShowWen).Caption = "显示花纹"
   
   mmFast(m_ShowRect).Caption = "显示方格"
   mmFast(m_Line).Caption = "显示网格线"
   
   LabTai(0).AutoSize = True
   For I = 1 To 3
      Load LabTai(I): LabTai(I).Visible = True
   Next
   LabTai(0).Caption = "选项": LabTai(1).Caption = "双击开始游戏"
   
   ctAutoMax = GetSetting("Snake", "Opt", "AutoMax", 0)
   ctMaxFen = GetSetting("Snake", "Opt", "MaxFen", 0)
   
   Call KjInit
   Call ShowBack(True)
   Me.Font.Bold = True
   Call ShowStr("双击开始游戏", 36)
   Call ShowStr("用键盘的方向键控制蛇的运动方向", 18, 1)
End Sub
Private Sub Form_DblClick()
   Timer1.Enabled = True
   If ctAutoMax < ctAutoFen Then ctAutoMax = ctAutoFen
   If ctMaxFen < ctFen Then ctMaxFen = ctFen
   Call KjInit: Call ShowBack
   ctAutoFen = 0: ctFen = 0
   Call ShowFen
   If ctAuto Then LabTai(1).Caption = "游戏中(自动)" Else LabTai(1).Caption = "游戏中"
End Sub
Private Sub mmFast_Click(Index As Integer)
   Dim I As Long
   If ctAutoMax < ctAutoFen Then ctAutoMax = ctAutoFen
   If ctMaxFen < ctFen Then ctMaxFen = ctFen
   
   Select Case Index
   Case m_Start
      Timer1.Enabled = Not Timer1.Enabled
      If Timer1.Enabled Then Call KjInit: Call ShowBack
   Case m_Auto
      ctAuto = Not ctAuto: mmFast(Index).Checked = ctAuto
      Timer1.Enabled = ctAuto
      If Timer1.Enabled Then Call KjInit: Call ShowBack
   Case m_Fast
     mmFast(Index).Checked = Not mmFast(Index).Checked
     If mmFast(Index).Checked Then Timer1.Interval = 50 Else Timer1.Interval = 100
   Case m_Line
     mmFast(Index).Checked = Not mmFast(Index).Checked: Call ShowBack
   Case m_ShowNo, m_ShowTo, m_ShowNum, m_ShowWen
     mmFast(m_ShowNo).Checked = False: mmFast(m_ShowTo).Checked = False
     mmFast(m_ShowNum).Checked = False: mmFast(m_ShowWen).Checked = False
     mmFast(Index).Checked = True
   Case m_ShowRect
      mmFast(Index).Checked = Not mmFast(Index).Checked
      For I = 0 To LabSnake.Count - 1
         If mmFast(Index).Checked Then LabSnake(I).BorderStyle = 1 Else LabSnake(I).BorderStyle = 0
      Next
   End Select
   
   If Timer1.Enabled Then
      If ctAuto Then LabTai(1).Caption = "游戏中(自动)" Else LabTai(1).Caption = "游戏中"
      ctAutoFen = 0: ctFen = 0
   Else
      LabTai(1).Caption = "游戏已停止"
   End If
   Call ShowFen
End Sub
Private Sub Timer1_Timer()
   Dim nHead As Long, nEnd As Long, X As Long, Y As Long, I As Long
   Dim H As Long, L As Long, H1 As Long, L1 As Long
   
   If ctSize = 0 Then Exit Sub
   nHead = ctHead: nEnd = KjIndex(ctHead, 1) '当前蛇头、蛇尾序号
MoveHL:
   Call GetHL(LabSnake(nHead).Left, LabSnake(nHead).Top, H, L) '获得当前蛇头 行列号
   Select Case ctTo
   Case to_Up:    H = H - 1
   Case to_Down: H = H + 1
   Case to_Left: L = L - 1
   Case to_Right: L = L + 1
   End Select
   If L > ctL Or L < 1 Then
      If H < ctH * 0.5 Then ctTo = to_Down Else ctTo = to_Up
      GoTo MoveHL
   End If
   If H > ctH Or H < 1 Then
      If L < ctL * 0.5 Then ctTo = to_Right Else ctTo = to_Left
      GoTo MoveHL
   End If
   
   nHead = nEnd '新蛇头
   Call MoveTo(LabSnake(nHead), H, L)        '蛇尾 移到 蛇头 前
   If ctAuto Then Call AutoPlay(nHead, H, L) '自动避免碰到身体,会修改 H, L
   
   If InBody(nHead, H, L) > -1 Then
      LabSnake(nHead).ZOrder
      Timer1.Enabled = False
      LabTai(1).Caption = "游戏结束"
      Call ShowStr("Game Over", 36)
      Call ShowStr("双击重新开始", 36, 1)
      GoTo SetNewHead
   End If
     
   '是否吃到食物
   For I = 0 To ctFoot - 1
      Call GetHL(ShaFoot(I).Left, ShaFoot(I).Top, H1, L1) '获得食物 行列号
       If H = H1 And L = L1 Then
          ctZong = ctZong + 1 '蛇身增加一节
          Load LabSnake(ctZong): LabSnake(ctZong).Visible = True
          If mmFast(m_ShowNum).Checked Then LabSnake(ctZong).Caption = ctZong Else LabSnake(I).Caption = ""
          LabSnake(ctZong).Move LabSnake(0).Left, LabSnake(0).Top '新控件与序号0重叠
        ' LabSnake(ctZong).ZOrder 0
          Call ShowFen(True)
          Call RndFoot(I)     '重新设置食物的位置
          Exit For
       End If
   Next
   
SetNewHead:
'新蛇头
LabSnake(nHead).BackColor = 255
If mmFast(m_ShowWen).Checked Then
     If LabSnake(ctHead).Caption = "●" Then LabSnake(nHead).Caption = "◎" Else LabSnake(nHead).Caption = "●"
End If
'原蛇头变蛇身
LabSnake(ctHead).BackColor = RGB(0, 0, 255)
If mmFast(m_ShowNo).Checked Then LabSnake(ctHead).Caption = ""
If mmFast(m_ShowTo).Checked Then LabSnake(ctHead).Caption = ToStr(ctTo)
If mmFast(m_ShowNum).Checked Then LabSnake(ctHead).Caption = ctHead
   
ctHead = nHead
If ctAuto Then FindFoot LabSnake(ctHead).Left, LabSnake(ctHead).Top '自动查找食物,修改运动方向。
End Sub
Private Sub ShowFen(Optional AddFen As Boolean)
   Dim Adds As Long
   
   If mmFast(m_Fast).Checked Then Adds = 20 Else Adds = 10
   If ctAuto Then
      If AddFen Then ctAutoFen = ctAutoFen + Adds
      LabTai(2).Caption = "最高分 " & ctAutoMax
      LabTai(3).Caption = "得 分 " & ctAutoFen
   Else
      If AddFen Then ctFen = ctFen + Adds
      LabTai(2).Caption = "最高分 " & ctMaxFen
      LabTai(3).Caption = "得 分 " & ctFen
   End If
End Sub
Private Function ToStr(nTo As enTo) As String
   Select Case nTo
   Case to_Up:     ToStr = "↑"
   Case to_Down:   ToStr = "↓"
   Case to_Left:   ToStr = "←"
   Case to_Right: ToStr = "→"
   End Select
End Function
Private Sub MoveTo(Kj, H As Long, L As Long)
   Kj.Move ctB + ctSize * (L - 1), ctB + ctSize * (H - 1)
End Sub
Private Sub GetHL(X As Long, Y As Long, H As Long, L As Long)
   '将坐标转变为行列位置
   If ctSize = 0 Then Exit Sub
   L = 1 + Int((X - ctB) / ctSize): H = 1 + Int((Y - ctB) / ctSize)
End Sub
Private Sub ShowStr(nStr As String, Optional FontSize As Long = 9, Optional T As Single)
   Me.DrawMode = 14
   Me.Font.Size = FontSize
   Me.CurrentX = ctB + (ctRight - ctB - Me.TextWidth(nStr)) * 0.5
   If T = 0 Then Me.CurrentY = ctB + (ctDown - ctB - Me.TextHeight(nStr)) * 0.5
   Me.Print nStr
   Me.DrawMode = 13
End Sub
Private Sub AutoPlay(Head As Long, H As Long, L As Long)
   '自动避免碰到身体,Head:蛇头序号 H,L:蛇头行列位置
   '如果碰到会修改 H,L
   Dim BodyS As Long, H2 As Long, L2 As Long
   Dim Head1 As Long, H1 As Long, L1 As Long, ToH As Long, ToL As Long
   
   BodyS = InBody(Head, H, L) '碰到处的序号
   If BodyS < 0 Then Exit Sub
   
   BodyS = KjIndex(BodyS, 1) '碰到处的前面一个
   GetHL LabSnake(BodyS).Left, LabSnake(BodyS).Top, H2, L2 'H2, L2:BodyS 的行列位置
   
   Head1 = KjIndex(Head, -1) '蛇头的后面一个
   GetHL LabSnake(Head1).Left, LabSnake(Head1).Top, H1, L1 'H1, L1:Head1 的行列位置
   
   ToH = H1: ToL = L1
   If ctTo = to_Down Or ctTo = to_Up Then '---垂直运动
     If L - L2 > 0 Then ctTo = to_Right Else ctTo = to_Left
     If ctTo = to_Right Then ToL = ToL + 1 Else ToL = ToL - 1
     If ToL < 1 Then ToL = 1
     If ToL > ctL Then ToL = ctL
     If InBody(-1, ToH, ToL) > -1 Then 'ToH,ToL 处不是空白
        ToL = L1
        If L - L2 > 0 Then ToH = H1 - 1: ctTo = to_Down Else ToH = H1 + 1: ctTo = to_Up
     End If
   Else '--------------------------------------水平运动
     If H - H2 > 0 Then ctTo = to_Down Else ctTo = to_Up '首选远离 BodyS
     If ctTo = to_Down Then ToH = ToH + 1 Else ToH = ToH - 1
     If ToH < 1 Then ToH = 1
     If ToH > ctH Then ToH = ctH
     If InBody(-1, ToH, ToL) > -1 Then 'ToH,ToL 处不是空白
        ToH = H1
        If H - H2 > 0 Then ToL = L1 - 1: ctTo = to_Left Else ToL = L1 + 1: ctTo = to_Right
     End If
   End If
   
   If ToH < 1 Or ToH > ctH Then Exit Sub
   If ToL < 1 Or ToL > ctL Then Exit Sub
   If InBody(-1, ToH, ToL) > -1 Then Exit Sub
   
   Call MoveTo(LabSnake(Head), ToH, ToL)   '移动到新位置
   H = ToH: L = ToL
End Sub
Private Function InBody(NoNum As Long, H As Long, L As Long) As Long
   '返回行列处(H,L)的 LabSnake 序号(NoNum 除外),-1 表示没有 LabSnake
   Dim I As Long, H1 As Long, L1 As Long
   
   For I = 0 To ctZong
      If I <> NoNum Then
         Call GetHL(LabSnake(I).Left, LabSnake(I).Top, H1, L1)
         If H1 = H And L1 = L Then InBody = I: Exit Function
      End If
   Next
   InBody = -1
End Function
Private Sub FindFoot(X As Long, Y As Long)
   '自动查找食物,修改运动方向。 X,Y 表示当前蛇头的位置
   Dim X1 As Long, Y1 As Long, I As Long, S As Long, S1 As Long, F As Long
   
   '查找距离最近的食物序号
   F = 0
   S = Abs(X - ShaFoot(F).Left) + Abs(Y - ShaFoot(F).Top) '蛇头 与食物的距离
   For I = 1 To ctFoot - 1
      S1 = Abs(X - ShaFoot(I).Left) + Abs(Y - ShaFoot(I).Top)
      If S > S1 Then S = S1: F = I
   Next
   
   X1 = X - ShaFoot(F).Left: Y1 = Y - ShaFoot(F).Top
   If X1 = 0 Then
      If Y1 > 0 Then
         If ctTo <> to_Down Then ctTo = to_Up
      Else
         If ctTo <> to_Up Then ctTo = to_Down
      End If
   Else
      If X1 > 0 Then
        If ctTo <> to_Right Then ctTo = to_Left
      Else
        If ctTo <> to_Left Then ctTo = to_Right
      End If
   End If
End Sub
Private Sub RndFoot(I As Long)
   '随机设置食物的行列位置
   Randomize
   MoveTo ShaFoot(I), 1 + Int(Rnd * ctH), 1 + Int(Rnd * ctL)
End Sub
搜索更多相关主题的帖子: 小游戏 贪吃蛇 
2011-06-03 09:26
wangyu199005
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2011-6-3
收藏
得分:0 
????
2011-06-03 09:32
wangyu199005
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2011-6-3
收藏
得分:0 
为什么没人呢
2011-06-03 09:32
wangyu199005
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2011-6-3
收藏
得分:0 
人呢????
2011-06-03 09:35
wangyu199005
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2011-6-3
收藏
得分:0 
大家都很忙吗?没人帮我啊
2011-06-03 09:52
w123012306
Rank: 9Rank: 9Rank: 9
来 自:湖南
等 级:蜘蛛侠
威 望:4
帖 子:307
专家分:1180
注 册:2010-4-22
收藏
得分:20 
太多了!

楼上,楼下的一定要幸福开心哦!
2011-06-03 10:48
w123012306
Rank: 9Rank: 9Rank: 9
来 自:湖南
等 级:蜘蛛侠
威 望:4
帖 子:307
专家分:1180
注 册:2010-4-22
收藏
得分:0 
太多了!

楼上,楼下的一定要幸福开心哦!
2011-06-03 10:48
wangyu199005
Rank: 1
等 级:新手上路
帖 子:16
专家分:0
注 册:2011-6-3
收藏
得分:0 
回复 7楼 w123012306
那我发个少的,你帮帮我,不胜感激啊
2011-06-03 11:47
快速回复:请教贪吃蛇小游戏代码注释,谢谢
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.032617 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved