simpliest snakes
Private Declare Function GetTickCount Lib "kernel32" () As Long 'this function lets us not use timer
'timers are bad :)
'main body... each part of the snake has X and Y
Private Type Part
X As Integer
Y As Integer
End Type
'Dynamic array to store part coordinates
Dim Part() As Part
'Velocity in X and Y direction of the snake
Dim vX As Integer, vY As Integer
Dim i As Integer 'for loops
Dim CS As Single 'cell size
Dim FX As Integer, FY As Integer 'food coordinates
Dim X As Integer, Y As Integer
Dim bRunning As Boolean, died As Boolean
Private Sub Form_Load()
Randomize 'random generation
'Initialize controls******************
Picture1.BackColor = vbWhite
Picture1.ScaleMode = 3 'pixels
CS = 20 'cell size in pixels
X = Int(Picture1.ScaleWidth / CS)
Y = Int(Picture1.ScaleHeight / CS)
Picture1.AutoRedraw = True
Picture1.ScaleWidth = X * CS
Picture1.ScaleHeight = Y * CS
Me.WindowState = 2
Me.Show
DrawGrid Picture1, CS
'*************************************
died = False
'set up the game
ReDim Part(0)
Part(0).X = 0
Part(0).Y = 0
FX = Int(Rnd * X)
FY = Int(Rnd * Y)
'go to main loop
bRunning = True
MainLoop
End Sub
Sub MainLoop()
Do While bRunning = True
Update
Draw
WAIT (50) 'increasing this number makes game slower
Loop
Unload Me
End Sub
Sub Update()
'MOVE PARTS
For i = UBound(Part) To 1 Step -1
Part(i).X = Part(i - 1).X
Part(i).Y = Part(i - 1).Y
Next i
'MOVE HEAD
Part(0).X = Part(0).X + vX
Part(0).Y = Part(0).Y + vY
'HAS HE GONE OUT OF BOUNDS ?
If Part(0).X <>= X Or Part(0).Y <>= Y Then
died = True
End If
'HAS HE CRASHED INTO HIMSELF ?
For i = 1 To UBound(Part)
If Part(i).X = Part(0).X And Part(i).Y = Part(0).Y Then
died = True
End If
Next i
'DID HE EAT FOOD ?
If Part(0).X = FX And Part(0).Y = FY Then
ReDim Preserve Part(UBound(Part) + 1)
Part(UBound(Part)).X = -CS
Part(UBound(Part)).Y = -CS
FX = Int(Rnd * X)
FY = Int(Rnd * Y)
Form1.Caption = "Parts: " & UBound(Part)
End If
'IS HE DEAD ?
If died = True Then NewGame
End Sub
Sub Draw()
'DRAW WHITENESS
Rectangle 0, 0, X * CS, Y * CS, vbWhite
'DRAW SNAKE. PARTS IN BLUE, HEAD IN GREEN
For i = 1 To UBound(Part)
Rectangle Part(i).X * CS, Part(i).Y * CS, Part(i).X * CS + CS, Part(i).Y * CS + CS, vbBlue
Next i
Rectangle Part(0).X * CS, Part(0).Y * CS, Part(0).X * CS + CS, Part(0).Y * CS + CS, vbGreen
'DRAW FOOD
Rectangle FX * CS, FY * CS, FX * CS + CS, FY * CS + CS, vbRed
DrawGrid Picture1, CS
End Sub
Sub Rectangle(X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer, color As Long)
Picture1.Line (X1, Y1)-(X2, Y2), color, BF
End Sub
Sub NewGame()
'SET UP NEW GAME
died = False
ReDim Part(0)
Part(0).X = 0
Part(0).Y = 0
vX = 0
vY = 0
FX = Int(Rnd * X)
FY = Int(Rnd * Y)
End Sub
Sub DrawGrid(Pic As Control, CS As Single)
'**************************************************************************
'DRAW GRID
'**************************************************************************
Dim i As Integer, Across As Single, Up As Single
Across = Pic.ScaleWidth / CS
Up = Pic.ScaleHeight / CS
For i = 0 To Across
Pic.Line (i * CS, 0)-(i * CS, Up * CS)
Next i
For i = 0 To Up
Pic.Line (0, i * CS)-(Across * CS, i * CS)
Next i
End Sub
Sub WAIT(Tim As Integer)
'**************************************************************************
'WAIT FUNCTION
'**************************************************************************
Dim LastWait As Long
LastWait = GetTickCount
Do While Tim > GetTickCount - LastWait
DoEvents
Loop
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
'USER KEYPRESSES HANDLED HERE
Select Case KeyCode
Case vbKeyRight
vX = 1
vY = 0
Case vbKeyLeft
vX = -1
vY = 0
Case vbKeyUp
vX = 0
vY = -1
Case vbKeyDown
vX = 0
vY = 1
End Select
End Sub
Private Sub Picture1_KeyPress(KeyAscii As Integer)
'27 is ESC. IF user presses ESC, QUIT
If KeyAscii = 27 Then bRunning = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'This function can be left out
End
End Sub
Private Declare Function GetTickCount Lib "kernel32" () As Long 'this function lets us not use timer
'timers are bad :)
'main body... each part of the snake has X and Y
Private Type Part
X As Integer
Y As Integer
End Type
'Dynamic array to store part coordinates
Dim Part() As Part
'Velocity in X and Y direction of the snake
Dim vX As Integer, vY As Integer
Dim i As Integer 'for loops
Dim CS As Single 'cell size
Dim FX As Integer, FY As Integer 'food coordinates
Dim X As Integer, Y As Integer
Dim bRunning As Boolean, died As Boolean
Private Sub Form_Load()
Randomize 'random generation
'Initialize controls******************
Picture1.BackColor = vbWhite
Picture1.ScaleMode = 3 'pixels
CS = 20 'cell size in pixels
X = Int(Picture1.ScaleWidth / CS)
Y = Int(Picture1.ScaleHeight / CS)
Picture1.AutoRedraw = True
Picture1.ScaleWidth = X * CS
Picture1.ScaleHeight = Y * CS
Me.WindowState = 2
Me.Show
DrawGrid Picture1, CS
'*************************************
died = False
'set up the game
ReDim Part(0)
Part(0).X = 0
Part(0).Y = 0
FX = Int(Rnd * X)
FY = Int(Rnd * Y)
'go to main loop
bRunning = True
MainLoop
End Sub
Sub MainLoop()
Do While bRunning = True
Update
Draw
WAIT (50) 'increasing this number makes game slower
Loop
Unload Me
End Sub
Sub Update()
'MOVE PARTS
For i = UBound(Part) To 1 Step -1
Part(i).X = Part(i - 1).X
Part(i).Y = Part(i - 1).Y
Next i
'MOVE HEAD
Part(0).X = Part(0).X + vX
Part(0).Y = Part(0).Y + vY
'HAS HE GONE OUT OF BOUNDS ?
If Part(0).X <>= X Or Part(0).Y <>= Y Then
died = True
End If
'HAS HE CRASHED INTO HIMSELF ?
For i = 1 To UBound(Part)
If Part(i).X = Part(0).X And Part(i).Y = Part(0).Y Then
died = True
End If
Next i
'DID HE EAT FOOD ?
If Part(0).X = FX And Part(0).Y = FY Then
ReDim Preserve Part(UBound(Part) + 1)
Part(UBound(Part)).X = -CS
Part(UBound(Part)).Y = -CS
FX = Int(Rnd * X)
FY = Int(Rnd * Y)
Form1.Caption = "Parts: " & UBound(Part)
End If
'IS HE DEAD ?
If died = True Then NewGame
End Sub
Sub Draw()
'DRAW WHITENESS
Rectangle 0, 0, X * CS, Y * CS, vbWhite
'DRAW SNAKE. PARTS IN BLUE, HEAD IN GREEN
For i = 1 To UBound(Part)
Rectangle Part(i).X * CS, Part(i).Y * CS, Part(i).X * CS + CS, Part(i).Y * CS + CS, vbBlue
Next i
Rectangle Part(0).X * CS, Part(0).Y * CS, Part(0).X * CS + CS, Part(0).Y * CS + CS, vbGreen
'DRAW FOOD
Rectangle FX * CS, FY * CS, FX * CS + CS, FY * CS + CS, vbRed
DrawGrid Picture1, CS
End Sub
Sub Rectangle(X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer, color As Long)
Picture1.Line (X1, Y1)-(X2, Y2), color, BF
End Sub
Sub NewGame()
'SET UP NEW GAME
died = False
ReDim Part(0)
Part(0).X = 0
Part(0).Y = 0
vX = 0
vY = 0
FX = Int(Rnd * X)
FY = Int(Rnd * Y)
End Sub
Sub DrawGrid(Pic As Control, CS As Single)
'**************************************************************************
'DRAW GRID
'**************************************************************************
Dim i As Integer, Across As Single, Up As Single
Across = Pic.ScaleWidth / CS
Up = Pic.ScaleHeight / CS
For i = 0 To Across
Pic.Line (i * CS, 0)-(i * CS, Up * CS)
Next i
For i = 0 To Up
Pic.Line (0, i * CS)-(Across * CS, i * CS)
Next i
End Sub
Sub WAIT(Tim As Integer)
'**************************************************************************
'WAIT FUNCTION
'**************************************************************************
Dim LastWait As Long
LastWait = GetTickCount
Do While Tim > GetTickCount - LastWait
DoEvents
Loop
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
'USER KEYPRESSES HANDLED HERE
Select Case KeyCode
Case vbKeyRight
vX = 1
vY = 0
Case vbKeyLeft
vX = -1
vY = 0
Case vbKeyUp
vX = 0
vY = -1
Case vbKeyDown
vX = 0
vY = 1
End Select
End Sub
Private Sub Picture1_KeyPress(KeyAscii As Integer)
'27 is ESC. IF user presses ESC, QUIT
If KeyAscii = 27 Then bRunning = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'This function can be left out
End
End Sub
