Advertisement
Tony041010

貪食蛇Snake (Auto Snake)

Jul 15th, 2021
598
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Dim snk As String '記錄蛇身體所有的位置
  2. Dim sdir As Integer  '行進方向
  3. Dim shead As Integer  '頭的座標
  4. Dim apple As Integer   '蘋果座標
  5.  
  6. Private Sub Form_Load()
  7.     For i = 0 To 360
  8.         If i > 0 Then
  9.             Load Command1(i)  'load可以動態產生物件
  10.            If i Mod 19 = 0 Then
  11.                 Command1(i).Left = Command1(0).Left
  12.                 Command1(i).Top = Command1(i - 9).Top + Command1(i).Height
  13.             Else
  14.                 Command1(i).Left = Command1(i - 1).Left + Command1(i - 1).Width
  15.                 Command1(i).Top = Command1(i - 1).Top
  16.  
  17.             End If
  18.         End If
  19.         If i Mod 2 = 0 Then
  20.             Command1(i).BackColor = RGB(115, 167, 12)
  21.         Else
  22.             Command1(i).BackColor = RGB(162, 209, 73)
  23.         End If
  24.        ' Command1(i).Caption = i
  25.        Command1(i).Visible = True
  26.     Next
  27.     For i = 0 To 18
  28.         Command1(i).BackColor = vbBlack
  29.     Next
  30.     For i = 342 To 360
  31.         Command1(i).BackColor = vbBlack
  32.     Next
  33.     For i = 0 To 342 Step 19
  34.         Command1(i).BackColor = vbBlack
  35.     Next
  36.     For i = 18 To 360 Step 19
  37.         Command1(i).BackColor = vbBlack
  38.     Next
  39.    
  40. End Sub
  41.  
  42. Private Sub NewApple()
  43.     apple = -1
  44.     Do
  45.         x = Int(Rnd * 361)
  46.         If Command1(x).BackColor <> vbBlack And Command1(x).BackColor <> vbBlue Then
  47.             apple = x
  48.         End If
  49.     Loop Until apple <> -1
  50.     Command1(apple).BackColor = vbRed
  51.     Command1(apple).Picture = Image2
  52. End Sub
  53.  
  54. Private Sub Label1_Click()
  55.     Command1(175).BackColor = vbBlue
  56.     Command1(176).BackColor = vbBlue
  57.     Command1(177).BackColor = vbBlue
  58.     snk = ChrW(175) & ChrW(176) & ChrW(177)
  59.     sdir = 1            '一開始預設向右
  60.    shead = 177         '一開始預設蛇首117
  61.    NewApple
  62.    
  63.     Timer1.Interval = 400
  64. End Sub
  65.  
  66. '第一題,完成方向鍵
  67. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  68.     If KeyCode = vbKeyUp Then
  69.         sdir = -19
  70.     ElseIf KeyCode = vbKeyDown Then
  71.         sdir = 19
  72.     ElseIf KeyCode = vbKeyLeft Then
  73.         sdir = -1
  74.     ElseIf KeyCode = vbKeyRight Then
  75.         sdir = 1
  76.     End If
  77.  
  78. End Sub
  79.  
  80. Private Sub Timer1_Timer()
  81.     shead = shead + sdir
  82.    
  83.     '第二題,撞牆
  84.    If Command1(shead).BackColor = vbBlack Then
  85.         MsgBox "hit wall, game over"
  86.         Timer1.Interval = 0
  87.     End If
  88.     '第二題,咬到自己
  89.    If Command1(shead + sdir).BackColor = vbBlue Then
  90.         MsgBox ("bite self")
  91.         Timer1.Interval = 0
  92.     End If
  93.  
  94.     '第三題,吃蘋果len+1
  95.    '更新snk座標,
  96.    '如果吃到蘋果,長度+1,留住最後一截尾巴,
  97.    '若沒吃到,消掉最後一截尾巴
  98.    If shead = apple Then
  99.         Command1(apple).Picture = LoadPicture()
  100.         If apple Mod 2 = 0 Then
  101.             Command1(apple).BackColor = RGB(115, 167, 12)
  102.         Else
  103.             Command1(apple).BackColor = RGB(162, 209, 73)
  104.         End If
  105.         snk = snk & ChrW(apple)
  106.         NewApple
  107.        
  108.     Else
  109.         '先記錄尾巴座標
  110.        stail = AscW(Mid(snk, 1, 1))
  111.         snk = Mid(snk, 2, Len(snk)) & ChrW(shead)  'snk削掉尾巴最後一格
  112.        '繪圖,snk削掉尾巴最後一格,還是要符合馬賽克磚
  113.        i = stail
  114.         If i Mod 2 = 0 Then
  115.             Command1(i).BackColor = RGB(115, 167, 12)
  116.         Else
  117.             Command1(i).BackColor = RGB(162, 209, 73)
  118.         End If
  119.    
  120.     End If
  121.     If Int(shead / 19) > Int(apple / 19) And Command1(shead - 19).BackColor <> vbBlue Then
  122.         sdir = -19
  123.     ElseIf Int(shead / 19) < Int(apple / 19) And Command1(shead + 19).BackColor <> vbBlue Then
  124.         sdir = 19
  125.     ElseIf shead Mod 19 > apple Mod 19 And Command1(shead - 1).BackColor <> vbBlue Then
  126.         sdir = -1
  127.     ElseIf shead Mod 19 < apple Mod 19 And Command1(shead + 1).BackColor <> vbBlue Then
  128.         sdir = 1
  129.     End If
  130.    
  131.    
  132.     '繪圖,頭前進一格
  133.    Command1(shead).BackColor = vbBlue
  134.    
  135.     Label2 = Len(snk) '目前蛇的長度
  136. End Sub
  137.  
  138.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement