good day evey one! i want to edit a code in
vb 6.0 snake game but i can't figure it out on how the snake will go back to the line that he started to run in the form pls help me.thanks...
code
Option Explicit
Private Const vbBackground As Long = &HC0E0FF
Private Const vbGridColour As Long = vbBlack
Private Const vbWallColour As Long = vbRed
Private Const vbBonusColour As Long = vbBlue
Private Const vbSnakeColour As Long = vbGreen
Private doLoop As Boolean, gotBonus As Boolean, facingUp As Boolean, facingDown As Boolean
Private facingLeft As Boolean, facingRight As Boolean, lastTickCount As Long, occupiedSquares() As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
If facingRight Then Exit Sub
facingLeft = True: facingRight = False: facingUp = False: facingDown = False
Case vbKeyRight
If facingLeft Then Exit Sub
facingRight = True: facingLeft = False: facingUp = False: facingDown = False
Case vbKeyUp
If facingDown Then Exit Sub
facingUp = True: facingDown = False: facingLeft = False: facingRight = False
Case vbKeyDown
If facingUp Then Exit Sub
facingDown = True: facingUp = False: facingLeft = False: facingRight = False
End Select
End Sub
Private Sub Form_Load()
Dim i As Long: BackColor = vbGridColour: box(0).BackColor = vbBackground
AutoRedraw = True: loadBoard: facingLeft = False: ReDim occupiedSquares(2)
For i = 0 To 2
occupiedSquares(i) = 400 + (5 - i)
box(occupiedSquares(i)).BackColor = vbSnakeColour
Next
Me.Show: SetFocus: doGameLoop
End Sub
Private Sub addBonus()
Dim n As Long
lblRetry:
n = (Int((870 - 29 + 1) * Rnd + 29))
If (box(n).BackColor = vbWallColour) Or (box(n).BackColor = vbSnakeColour) Then GoTo lblRetry:
box(n).BackColor = vbBonusColour
End Sub
Private Sub loadBoard()
Dim i As Long
For i = 1 To 899
Load box(i)
With box(i)
.Move 9 + (Int((i Mod 30) * .Width)), 9 + (Int((i / 30)) * .Height)
.Visible = True
End With
Next
For i = 0 To 899
If (i <= 29) Or (i >= 870) Then box(i).BackColor = vbWallColour
Next
addBonus
End Sub
Private Sub doGameLoop()
doLoop = True
Do While doLoop
DoEvents
If (GetTickCount - lastTickCount) >= Timer1.Interval Then
lastTickCount = GetTickCount
Select Case True
Case facingUp:
If (Not box(occupiedSquares(0) - 30).BackColor = vbWallColour) And (Not box(occupiedSquares(0) - 30).BackColor = vbSnakeColour) Then
If Not box(occupiedSquares(0) - 30).BackColor = vbBonusColour Then
doodleBackSquare
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) - 30).BackColor = vbSnakeColour
shiftDownArray occupiedSquares, occupiedSquares(0) - 30
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).Back Color = vbSnakeColour
addBonus
End If
Else
doLoop = False
End If
Case facingDown:
If (Not box(occupiedSquares(0) + 30).BackColor = vbWallColour) And (Not box(occupiedSquares(0) + 30).BackColor = vbSnakeColour) Then
If Not box(occupiedSquares(0) + 30).BackColor = vbBonusColour Then
doodleBackSquare
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) + 30).BackColor = vbSnakeColour
shiftDownArray occupiedSquares, occupiedSquares(0) + 30
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).Back Color = vbSnakeColour
addBonus
End If
Else
doLoop = False
End If
Case facingLeft:
If (Not box(occupiedSquares(0) - 1).BackColor = vbWallColour) And (Not box(occupiedSquares(0) - 1).BackColor = vbSnakeColour) Then
If Not box(occupiedSquares(0) - 1).BackColor = vbBonusColour Then
doodleBackSquare
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) - 1).BackColor = vbSnakeColour
shiftDownArray occupiedSquares, occupiedSquares(0) - 1
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).Back Color = vbSnakeColour
addBonus
End If
Else
doLoop = False
End If
Case facingRight:
If (Not box(occupiedSquares(0) + 1).BackColor = vbWallColour) And (Not box(occupiedSquares(0) + 1).BackColor = vbSnakeColour) Then
If Not box(occupiedSquares(0) + 1).BackColor = vbBonusColour Then
doodleBackSquare
Else
ReDim Preserve occupiedSquares(UBound(occupiedSquares) + 1)
gotBonus = True
End If
box(occupiedSquares(0) + 1).BackColor = vbSnakeColour
shiftDownArray occupiedSquares, occupiedSquares(0) + 1
If gotBonus Then
gotBonus = False
box(occupiedSquares(UBound(occupiedSquares))).Back Color = vbSnakeColour
addBonus
End If
Else
doLoop = False
End If
End Select
End If
Loop
End Sub
Private Sub doodleBackSquare()
box(occupiedSquares(UBound(occupiedSquares))).Back Color = vbBackground
End Sub
Private Sub shiftDownArray(ByRef arr() As Long, ByVal newTopIndexValue As Long)
Dim i As Long, x() As Long: x = arr
For i = 1 To UBound(arr)
arr(i) = x(i - 1)
Next
arr(0) = newTopIndexValue
End Sub
vb 6.0
