请教贪吃蛇小游戏代码注释,谢谢
Enum enMenuIndexm_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