Wrox Programmer Forums

Need to download code?

View our list of code downloads.

| FAQ | Members List | Search | Today's Posts | Mark Forums Read
Beginning VB 6 For coders who are new to Visual Basic, working in VB version 6 (not .NET).
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Beginning VB 6 section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old November 4th, 2013, 09:16 AM
Registered User
Points: 3, Level: 1
Points: 3, Level: 1 Points: 3, Level: 1 Points: 3, Level: 1
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Nov 2013
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Arrow 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

Last edited by ricx; November 4th, 2013 at 09:18 AM..
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Running a VB 2005 exe file on a system without VB dilionyi Pro Visual Basic 2005 3 September 21st, 2009 07:37 PM
VB.NET 2003 Appendix B convert to VB 2008 Express Edition brucechess BOOK: Beginning VB.NET Databases 10 February 5th, 2009 12:52 PM
How do I write this vb 6 code to work in vb 2008? sanderson Visual Basic 2008 Essentials 3 June 10th, 2008 01:46 PM
Converting the DTS file execution from vb to vb . ankur.nagdeve .NET Framework 2.0 0 February 27th, 2008 05:12 AM
convert dsr file from vb to vb.net Shashi001 VB Components 1 September 22nd, 2006 12:24 PM



All times are GMT -4. The time now is 09:32 PM.


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