home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD57855142000.psc / GForm.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-05-14  |  4.5 KB  |  165 lines

  1. VERSION 5.00
  2. Begin VB.Form GForm 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Si's Super Snakes - Visit www.VBgames.co.uk for more games!!!"
  5.    ClientHeight    =   5664
  6.    ClientLeft      =   36
  7.    ClientTop       =   312
  8.    ClientWidth     =   7464
  9.    FillColor       =   &H0000FF00&
  10.    FillStyle       =   6  'Cross
  11.    KeyPreview      =   -1  'True
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   472
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   622
  18.    StartUpPosition =   2  'CenterScreen
  19.    Begin VB.PictureBox PB 
  20.       BackColor       =   &H00000000&
  21.       BorderStyle     =   0  'None
  22.       FillStyle       =   0  'Solid
  23.       ForeColor       =   &H00000000&
  24.       Height          =   5400
  25.       Left            =   120
  26.       ScaleHeight     =   450
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   600
  29.       TabIndex        =   0
  30.       Top             =   120
  31.       Width           =   7200
  32.       Begin VB.Timer FrameCountT 
  33.          Interval        =   1000
  34.          Left            =   240
  35.          Top             =   240
  36.       End
  37.    End
  38. Attribute VB_Name = "GForm"
  39. Attribute VB_GlobalNameSpace = False
  40. Attribute VB_Creatable = False
  41. Attribute VB_PredeclaredId = True
  42. Attribute VB_Exposed = False
  43. Dim Snake(1 To 4) As New Snake
  44. Dim FrameCount As Integer
  45. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  46. Select Case KeyCode
  47.   Case vbKeyEscape
  48.     EscapeNow = True
  49.     GameOver (0)
  50.   Case vbKeyUp
  51.     Snake(1).Turn (NORTH)
  52.   Case vbKeyRight
  53.     Snake(1).Turn (EAST)
  54.   Case vbKeyDown
  55.     Snake(1).Turn (SOUTH)
  56.   Case vbKeyLeft
  57.     Snake(1).Turn (WEST)
  58.   Case vbKeyW
  59.     Snake(2).Turn (NORTH)
  60.   Case vbKeyS
  61.     Snake(2).Turn (EAST)
  62.   Case vbKeyZ
  63.     Snake(2).Turn (SOUTH)
  64.   Case vbKeyA
  65.     Snake(2).Turn (WEST)
  66. End Select
  67. End Sub
  68. Private Sub Form_Load()
  69. CreateSnakes
  70. MainLoop
  71. End Sub
  72. Public Sub MainLoop()
  73. PlayerNo = PlayerNo + 1
  74. DoEvents
  75. FrameCount = FrameCount + 1
  76. For i3 = PlayerNo To 4
  77.   Snake(i3).Think
  78. For i3 = 1 To 4
  79.     Select Case Snake(i3).Move
  80.       Case GREEN
  81.         Snake(i3).Kill
  82.         ReplaceSnake i3
  83.         If i3 <> GREEN Then Snake(GREEN).Grow (GrowthRate)
  84.       Case RED
  85.         Snake(i3).Kill
  86.         ReplaceSnake i3
  87.         If i3 <> RED Then Snake(RED).Grow (GrowthRate)
  88.       Case CYAN
  89.         Snake(i3).Kill
  90.         ReplaceSnake i3
  91.         If i3 <> CYAN Then Snake(CYAN).Grow (GrowthRate)
  92.       Case YELLOW
  93.         Snake(i3).Kill
  94.         ReplaceSnake i3
  95.         If i3 <> YELLOW Then Snake(YELLOW).Grow (GrowthRate)
  96.       Case WALL
  97.         Snake(i3).Kill
  98.         ReplaceSnake i3
  99.     End Select
  100. Loop Until EscapeNow = True
  101. Set GForm = Nothing
  102. Visible = False
  103. End Sub
  104. Private Sub Form_Unload(Cancel As Integer)
  105. EscapeNow = True
  106. End Sub
  107. Private Sub FrameCountT_Timer()
  108. If FrameCount = 0 Then
  109.   Visible = False
  110.   Set GForm = Nothing
  111.   End
  112. End If
  113. Caption = "Si's Super Snakes - Visit www.VBgames.co.uk for more games!!! - FPS = " & FrameCount
  114. FrameCount = 0
  115. i2 = 0
  116. For i = 1 To 4
  117.   If Snake(i).IsDead Then i2 = i2 + 1
  118. If i2 = 3 Then
  119.   For i = 1 To 4
  120.   i3 = i
  121.     If Snake(i).IsDead = False Then
  122.       GameOver i3
  123.     End If
  124.   Next
  125. End If
  126. End Sub
  127. Public Sub GameOver(WhoWon As Byte)
  128. Select Case WhoWon
  129.   Case 0
  130.     MsgBox "Game Quitted", vbExclamation, "Game Over!"
  131.   Case GREEN
  132.     MsgBox "The GREEN snake has won!!!", vbInformation, "Game Over!"
  133.   Case RED
  134.     MsgBox "The RED snake has won!!!", vbInformation, "Game Over!"
  135.   Case CYAN
  136.     MsgBox "The CYAN snake has won!!!", vbInformation, "Game Over!"
  137.   Case YELLOW
  138.     MsgBox "The YELLOW snake has won!!!", vbInformation, "Game Over!"
  139. End Select
  140.    MsgBox "Thankyou for playing, to download loads more games visit www.VBgames.co.uk"
  141. EscapeNow = True
  142. Set GForm = Nothing
  143. End Sub
  144. Private Sub PB_Paint()
  145. PB.FillColor = vbBlack
  146. PB.Line (0, 0)-(PBWIDTH - 1, PBHEIGHT - 1), vbWhite, B
  147. PB.FillColor = vbGreen
  148. End Sub
  149. Private Sub CreateSnakes()
  150. For i3 = 1 To 4
  151.   ReplaceSnake i3
  152. End Sub
  153. Private Sub ReplaceSnake(Color As Byte)
  154. Select Case Color
  155.   Case GREEN
  156.     Snake(GREEN).Create vbGreen, NORTH, PBWIDTH \ 2, PBHEIGHT - 5
  157.   Case RED
  158.     Snake(RED).Create vbRed, SOUTH, PBWIDTH \ 2, 5
  159.   Case CYAN
  160.     Snake(CYAN).Create vbCyan, EAST, 5, PBHEIGHT \ 2
  161.   Case YELLOW
  162.     Snake(YELLOW).Create vbYellow, WEST, PBWIDTH - 5, PBHEIGHT \ 2
  163. End Select
  164. End Sub
  165.