全部答案

2011-12-13 20:04:28

•   百度里就有的
  直接复制下面代码到代码框中后运行程序即可：
  Option Explicit
  Private WithEvents Timer1 As Timer
  Private WithEvents Label1 As Label
  Dim GFangXiang As Boolean
  Dim HWB As Single
  Dim She() As ShenTi
  Dim X As Long, Y As Long
  Dim ZhuangTai(23, 23) As Long
  Private Type ShenTi
  F As Long
  X As Long
  Y As Long
  End Type
  Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim C As Long
  If KeyCode = 27 Then End
  If KeyCode = 32 Then
  If Timer1。
    Enabled = True Then
  Timer1。Enabled = False
  Label1。Visible = True
  Else
  Timer1。Enabled = True
  Label1。Visible = False
  End If
  End If
  C = UBound(She)
  If GFangXiang = True Then Exit Sub
  Select Case KeyCode
  Case 37
  If She(C)。
    F = 2 Then Exit Sub
  She(C)。F = 0
  GFangXiang = True
  Case 38
  If She(C)。F = 3 Then Exit Sub
  She(C)。F = 1
  GFangXiang = True
  Case 39
  If She(C)。
    F = 0 Then Exit Sub
  She(C)。F = 2
  GFangXiang = True
  Case 40
  If She(C)。F = 1 Then Exit Sub
  She(C)。F = 3
  GFangXiang = True
  End Select
  End Sub
  Private Sub Form_Load()
  Me。
    AutoRedraw = True
  Me。BackColor = &HC000&
  Me。FillColor = 255
  Me。FillStyle = 0
  Me。ScaleWidth = 24
  Me。ScaleHeight = 24
  Me。
    WindowState = 2
  Set Timer1 = Controls。Add("VB。Timer", "Timer1")
  Set Label1 = Controls。Add("VB。Label", "Label1")
  Label1。
    AutoSize = True
  Label1。BackStyle = 0
  Label1 = "暂停"
  Label1。ForeColor = RGB(255, 255, 0)
  Label1。FontSize = 50
  ChuShiHua
  End Sub
  Private Sub Form_Resize()
  On Error GoTo 1:
  With Me
  If 。
    WindowState <> 1 Then
  。Cls
  。ScaleMode = 3
  HWB = 。ScaleHeight / 。ScaleWidth
  。ScaleWidth = 24
  。ScaleHeight = 24
  Label1。
    Move (Me。ScaleWidth - Label1。Width) / 2, (Me。ScaleHeight - Label1。Height) / 2
  HuaTu
  Me。Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF
  End If
  End With
  1:
  End Sub
  Private Sub Timer1_Timer()
  Dim C As Long, I As Long
  On Error GoTo 2:
  QingChu
  C = UBound(She)
  Select Case She(C)。
    F
  Case 0
  If ZhuangTai(She(C)。X - 1, She(C)。Y) = 2 Then
  C = C + 1
  ReDim Preserve She(C)
  She(C)。F = She(C - 1)。F
  She(C)。
    X = She(C - 1)。X - 1
  She(C)。Y = She(C - 1)。Y
  ChanShengShiWu
  GoTo 1:
  ElseIf ZhuangTai(She(C)。X - 1, She(C)。Y) = 1 Then
  GoTo 2:
  End If
  Case 1
  If ZhuangTai(She(C)。
    X, She(C)。Y - 1) = 2 Then
  C = C + 1
  ReDim Preserve She(C)
  She(C)。F = She(C - 1)。F
  She(C)。X = She(C - 1)。X
  She(C)。Y = She(C - 1)。
    Y - 1
  ChanShengShiWu
  GoTo 1:
  ElseIf ZhuangTai(She(C)。X, She(C)。Y - 1) = 1 Then
  GoTo 2:
  End If
  Case 2
  If ZhuangTai(She(C)。
    X + 1, She(C)。Y) = 2 Then
  C = C + 1
  ReDim Preserve She(C)
  She(C)。F = She(C - 1)。F
  She(C)。X = She(C - 1)。X + 1
  She(C)。
    Y = She(C - 1)。Y
  ChanShengShiWu
  GoTo 1:
  ElseIf ZhuangTai(She(C)。X + 1, She(C)。Y) = 1 Then
  GoTo 2:
  End If
  Case 3
  If ZhuangTai(She(C)。
    X, She(C)。Y + 1) = 2 Then
  C = C + 1
  ReDim Preserve She(C)
  She(C)。F = She(C - 1)。F
  She(C)。X = She(C - 1)。X
  She(C)。Y = She(C - 1)。
    Y + 1
  ChanShengShiWu
  GoTo 1:
  ElseIf ZhuangTai(She(C)。X, She(C)。Y + 1) = 1 Then
  GoTo 2:
  End If
  End Select
  ZhuangTai(She(0)。
    X, She(0)。Y) = 0
  For I = 0 To C
  Select Case She(I)。F
  Case 0
  She(I)。X = She(I)。X - 1
  Case 1
  She(I)。Y = She(I)。Y - 1
  Case 2
  She(I)。
    X = She(I)。X + 1
  Case 3
  She(I)。Y = She(I)。Y + 1
  End Select
  Next
  TiaoZheng
  1:
  GFangXiang = False
  ZhuangTai(She(C)。
    X, She(C)。Y) = 1
  HuaTu
  Exit Sub
  2:
  If MsgBox("游戏结束，点“是”重新开始游戏，点“否”", vbYesNo, "贪吃蛇") = vbYes Then
  ChuShiHua
  Else
  End
  End If
  End Sub
  Private Sub ChuShiHua()
  Me。
    Cls
  Timer1。Enabled = True
  Timer1。Interval = 200
  Erase ZhuangTai
  ReDim She(2)
  She(0)。F = 2
  She(0)。X = 9
  She(0)。Y = 11
  ZhuangTai(9, 11) = 1
  She(1)。
    F = 2
  She(1)。X = 10
  She(1)。Y = 11
  ZhuangTai(10, 11) = 1
  She(2)。F = 2
  She(2)。X = 11
  She(2)。Y = 11
  ZhuangTai(11, 11) = 1
  HuaTu
  ChanShengShiWu
  End Sub
  Private Sub QingChu()
  Dim I As Long
  For I = 0 To UBound(She)
  Me。
    Line (She(I)。X, She(I)。Y)-(She(I)。X + 1, She(I)。Y + 1), Me。BackColor, BF
  Next
  End Sub
  Private Sub HuaTu()
  Dim I As Long
  For I = 0 To UBound(She)
  Me。
    Circle (She(I)。X + 0。5, She(I)。Y + 0。5), 0。49, RGB(255, 255, 0), , , HWB
  Next
  End Sub
  Private Sub TiaoZheng()
  Dim I As Long
  For I = 0 To UBound(She) - 1
  She(I)。
    F = She(I + 1)。F
  Next
  End Sub
  Private Sub ChanShengShiWu()
  Randomize Timer
  1:
  X = Int(Rnd * 24)
  Y = Int(Rnd * 24)
  If ZhuangTai(X, Y) > 0 Then GoTo 1:
  ZhuangTai(X, Y) = 2
  Me。
    Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF
  End Sub。

  全部
  

  墙***

  2011-12-13 20:04:28

  65 11 评论

  分享
  提交评论