Dim l As Integer
Dim dead As Boolean
Dim waiting As Boolean
 
Public HighScore As Integer
 
Private Const MLEFT = 0
Private Const MRIGHT = 1
Private Const MUP = 2
Private Const MDOWN = 3
 
Private Const NORM_MODE = 0
Private Const FAST_MODE = 1
Private Const SUPER_MODE = 2
 
Private Const NORM_SPEED = 75
Private Const FAST_SPEED = 45
Private Const SUPER_SPEED = 25
 
 
Private Const NORM_SCORE = 6
Private Const FAST_SCORE = 12
Private Const SUPER_SCORE = 24
 
 '   119
 ' 97  100
 '   115
 '
 
 '   105
 ' 106  108
 '   107
 '
 
Private Const KEY_LEFT_1 = 97
Private Const KEY_RIGHT_1 = 100
Private Const KEY_UP_1 = 119
Private Const KEY_DOWN_1 = 115
 
Private Const KEY_LEFT_2 = 106
Private Const KEY_RIGHT_2 = 108
Private Const KEY_UP_2 = 105
Private Const KEY_DOWN_2 = 107
 
Dim KEY_RIGHT, KEY_LEFT, KEY_UP, KEY_DOWN As Integer
 
Dim pval As Integer
Dim score As Integer
 
Dim speed As Double
 
Dim sdir As Integer
 
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As _
  Integer
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Sub Form_Load()
sdir = MUP
body(0).Tag = "up"
speed = 10
score = 0
dead = False
waiting = True
l = 4
ChangeMode NORM_MODE
SetControls 1
GetHighScore
End Sub
 
Function GetHighScore()
On Error Resume Next
fFile = FreeFile
 Open App.Path & "\hscore.hs" For Input As #fFile
  If Err Then
   HighScore = 0
   Close #fFile
   fFile = FreeFile
   Open App.Path & "\hscore.hs" For Output As #fFile
    Print #fFile, "0"
   Close #fFile
   Exit Function
  Else
   Input #1, temp
   HighScore = temp
  End If
 Close #fFile
End Function
 
Function SetControls(ByVal num As Integer)
 Select Case num
  Case 1
   KEY_LEFT = KEY_LEFT_1
   KEY_RIGHT = KEY_RIGHT_1
   KEY_UP = KEY_UP_1
   KEY_DOWN = KEY_DOWN_1
   Case 2
   KEY_LEFT = KEY_LEFT_2
   KEY_RIGHT = KEY_RIGHT_2
   KEY_UP = KEY_UP_2
   KEY_DOWN = KEY_DOWN_2
 End Select
End Function
 
Function ChangeMode(ByVal level As Integer)
 Select Case level
  Case NORM_MODE
   Timer1.Interval = NORM_SPEED
   pval = NORM_SCORE
  Case FAST_MODE
   Timer1.Interval = FAST_SPEED
   pval = FAST_SCORE
  Case SUPER_MODE
   Timer1.Interval = SUPER_SPEED
   pval = SUPER_SCORE
 End Select
End Function
 
Private Sub Form_KeyPress(KeyAscii As Integer)
 If KeyAscii = 112 And dead = False Then
  lblScore.Caption = "Score: " & score
  If waiting = True Then
   waiting = False
   fPaused.Visible = False
   lblHighScore.Visible = False
   lblScore.Visible = False
  Else
   waiting = True
   fPaused.Visible = True
   lblHighScore.Visible = True
   lblScore.Visible = True
   ' paused
  End If
 End If
 
 If KeyAscii = KEY_RIGHT And sdir <> MLEFT Then
   sdir = MRIGHT
   MoveSnake "right"
 End If
 If KeyAscii = KEY_LEFT And sdir <> MRIGHT Then
   sdir = MLEFT
   MoveSnake "left"
 End If
 If KeyAscii = KEY_UP And sdir <> MDOWN Then
   sdir = MUP
   MoveSnake "up"
 End If
 If KeyAscii = KEY_DOWN And sdir <> MUP Then
   sdir = MDOWN
   MoveSnake "down"
 End If
End Sub
 
 
 
Function NewSeg()
 l = l + 1
 Load body(l)
 body(l).Visible = True
 body(l).BackColor = &H0&
 body(l).Left = body(l - 1).Left
 body(l).Top = body(l - 1).Top
  Select Case body(l - 1).Tag
   Case "left"
    body(l).Tag = "left"
    body(l).Left = body(l - 1).Left + body(l - 1).Width
    body(l).Top = body(l - 1).Top
   Case "right"
    body(l).Tag = "right"
    body(l).Left = body(l - 1).Left - body(l - 1).Width
    body(l).Top = body(l - 1).Top
   Case "down"
    body(l).Tag = "down"
    body(l).Left = body(l - 1).Left
    body(l).Top = body(l - 1).Top - body(l - 1).Height
   Case "up"
    body(l).Tag = "up"
    body(l).Left = body(l).Left
    body(l).Top = body(l - 1).Top + body(l - 1).Height
  End Select
End Function