p2p.wrox.com Forums

p2p.wrox.com Forums (http://p2p.wrox.com/index.php)
-   Beginning VB 6 (http://p2p.wrox.com/forumdisplay.php?f=75)
-   -   vb 6.0 (http://p2p.wrox.com/showthread.php?t=91428)

ricx November 4th, 2013 09:16 AM

vb 6.0
 
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


All times are GMT -4. The time now is 04:43 PM.

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.