home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Spacefight619883142002.psc / ModEngine.bas < prev    next >
Encoding:
BASIC Source File  |  2002-01-10  |  18.9 KB  |  734 lines
  1. Attribute VB_Name = "ModEngine"
  2. Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  3. Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength As Long, ByVal hwndCallback As Long) As Long
  4.  
  5. Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  6. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  7. Declare Function GetTickCount Lib "kernel32" () As Long
  8. Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  9. Public Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
  10. Public Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
  11. Public Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  12.  
  13. Public Const sRed = 0
  14. Public Const sBlue = 1
  15. Public Const sGreen = 2
  16. Public Const sMine = 3
  17.  
  18. Public Const pShield = 0
  19.  
  20. Type Player
  21. 'movement and placement info
  22. x As Long
  23. y As Long
  24. XS As Long
  25. YS As Long
  26. Boost As Long
  27. Rotate As Long
  28.  
  29. 'identifying properties
  30. Score As Long
  31. Band As Long
  32. Nick As String
  33. Health As Long
  34. MAXHP As Long
  35. id As Long
  36. Type As Long
  37. Act As Long
  38. Reload As Long
  39. Armor As Long
  40. ReSmoke As Long
  41.  
  42. 'powerups
  43. Shield As Long
  44. DeathBall As Long
  45. Mines As Long
  46. Superman As Long
  47.  
  48. 'AI Info
  49. Target As Long 'which player to target
  50. AI As Boolean 'determines if its a comp player
  51. BoostLeft As Long
  52. End Type
  53.  
  54. Type Shot
  55. 'movement and placement info
  56. x As Long
  57. y As Long
  58. XS As Long
  59. YS As Long
  60. Rotate As Long
  61.  
  62. 'identifying info
  63. Act As Boolean
  64. id As Long
  65. Type As Long
  66. Damage As Long 'how much damage the bullet does
  67. Count As Long 'how long it lasts
  68. End Type
  69.  
  70. Type PowerUp
  71. 'placement and animation info
  72. x As Long
  73. y As Long
  74.  
  75. 'identifying info
  76. Count As Long 'how long it has left (powerups dont stay forever ya know)
  77. Act As Long
  78. Type As Long 'type of powerup
  79. End Type
  80.  
  81. Type Explosion
  82. 'movement and placement info
  83. x As Long
  84. y As Long
  85. XS As Long
  86. YS As Long
  87.  
  88. 'anim
  89. Frame As Long 'current animation frame
  90. Frames As Long 'how many frames are in animation
  91.  
  92. 'identifying info
  93. Act As Long
  94. Type As Long
  95. End Type
  96.  
  97. Type text
  98. Major As String 'title
  99. Minor As String 'subtitle
  100. End Type
  101.  
  102. Type GameInfo ' not used
  103. VictoryType As Long 'what kind of victory
  104.  
  105. ReqScore As Long 'the required score of a player to win (if any)
  106. Time As Long 'time left in the game (if a timed game)
  107. End Type
  108.  
  109. Type Asteroid
  110. x As Long
  111. y As Long
  112. Rotate As Long
  113. XS As Long
  114. YS As Long
  115. Act As Long
  116. End Type
  117.  
  118. Public P(1 To 4) As Player
  119. Public S() As Shot
  120. Public PUP(20) As PowerUp
  121. Public Explo(1 To 30) As Explosion
  122. Public A(10) As Asteroid
  123. Public Message As text
  124. Public Running As Boolean
  125. Public Bands As Boolean
  126. Public Speed As Long
  127. 'masking hdcs for collison detection
  128. Public PMask(5) As Long, SMask(10) As Long, PUPMask(10) As Long, AMask As Long
  129. Public Playing As Boolean
  130. Public TeamName(1 To 2) As String
  131. Public i As Long
  132.  
  133. Function MakePowerup(T As Long)
  134. Dim i As Long
  135. For i = 0 To 20
  136. If PUP(i).Act = False Then
  137. PUP(i).Type = T
  138. PUP(i).x = Int(Rnd * frmGame.board.ScaleWidth)
  139. PUP(i).y = Int(Rnd * frmGame.board.ScaleHeight)
  140. PUP(i).Count = 120
  141. PUP(i).Act = True
  142. Debug.Print "Powerup MadE"
  143. Exit For
  144. End If
  145. Next i
  146. End Function
  147.  
  148. Function MakePlayer(x, y, Name, Band, PType) As Boolean
  149. Dim c As Long 'counter variable
  150.  
  151. For c = 1 To 4
  152. If P(c).Act = False Then
  153. 'set the coors
  154. P(c).x = x
  155. P(c).y = y
  156.  
  157. 'reset the props
  158. P(c).XS = 0
  159. P(c).YS = 0
  160. P(c).Rotate = 0
  161.  
  162. 'set other props
  163. P(c).id = c
  164. P(c).Type = PType
  165. P(c).Nick = Name
  166.  
  167. 'activate player
  168. P(c).Act = True
  169.  
  170. P(c).Health = 50
  171. Select Case PType
  172. Case sRed
  173. P(c).Armor = 2
  174. Case sBlue
  175. P(c).Armor = 0
  176. Case sGreen
  177. P(c).Armor = 4
  178. End Select
  179.  
  180. P(c).Shield = 30
  181. Exit For
  182. End If
  183. Next c
  184. End Function
  185.  
  186. Function TurnLeft(P As Player)
  187. P.Rotate = P.Rotate - 1: If P.Rotate < 0 Then P.Rotate = 7
  188. End Function
  189.  
  190. Function TurnRight(P As Player)
  191. P.Rotate = P.Rotate + 1: If P.Rotate > 7 Then P.Rotate = 0
  192. End Function
  193.  
  194. Function MoveForward(Player As Player)
  195. Dim Acc As Long
  196. Player.Boost = 1
  197. Select Case Player.Type
  198. Case sBlue
  199. Acc = 9
  200. Case sRed
  201. Acc = 7
  202. Case sGreen
  203. Acc = 5
  204. End Select
  205. If Player.Rotate = 0 Then: SetSpeed 0, -Acc, Player
  206. If Player.Rotate = 1 Then: SetSpeed Acc, -Acc, Player
  207. If Player.Rotate = 2 Then: SetSpeed Acc, 0, Player
  208. If Player.Rotate = 3 Then: SetSpeed Acc, Acc, Player
  209. If Player.Rotate = 4 Then: SetSpeed 0, Acc, Player
  210. If Player.Rotate = 5 Then: SetSpeed -Acc, Acc, Player
  211. If Player.Rotate = 6 Then: SetSpeed -Acc, 0, Player
  212. If Player.Rotate = 7 Then: SetSpeed -Acc, -Acc, Player
  213.  
  214. Select Case Player.Type
  215. Case sBlue
  216. If Player.XS < -20 Then Player.XS = -20
  217. If Player.XS > 20 Then Player.XS = 20
  218. If Player.YS < -20 Then Player.YS = -20
  219. If Player.YS > 20 Then Player.YS = 20
  220. Case sRed
  221. If Player.XS < -15 Then Player.XS = -15
  222. If Player.XS > 15 Then Player.XS = 15
  223. If Player.YS < -15 Then Player.YS = -15
  224. If Player.YS > 15 Then Player.YS = 15
  225. Case sGreen
  226. If Player.XS < -10 Then Player.XS = -10
  227. If Player.XS > 10 Then Player.XS = 10
  228. If Player.YS < -10 Then Player.YS = -10
  229. If Player.YS > 10 Then Player.YS = 10
  230. End Select
  231. End Function
  232.  
  233. Function Fire(Player As Player, T As Long)
  234. If Player.Reload > 0 Then Exit Function
  235. Dim c As Long
  236. For c = 0 To UBound(S())
  237. If S(c).Act = False Then
  238. S(c).x = Player.x + 37 - 15
  239. S(c).y = Player.y + 37 - 15
  240. S(c).Count = 20
  241. S(c).id = Player.id
  242. Player.Reload = 3
  243. If Player.Rotate = 0 Then: S(c).XS = 0
  244. If Player.Rotate = 1 Then: S(c).XS = 14
  245. If Player.Rotate = 2 Then: S(c).XS = 14
  246. If Player.Rotate = 3 Then: S(c).XS = 14
  247. If Player.Rotate = 4 Then: S(c).XS = 0
  248. If Player.Rotate = 5 Then: S(c).XS = -14
  249. If Player.Rotate = 6 Then: S(c).XS = -14
  250. If Player.Rotate = 7 Then: S(c).XS = -14
  251. If Player.Rotate = 0 Then: S(c).YS = -14
  252. If Player.Rotate = 1 Then: S(c).YS = -14
  253. If Player.Rotate = 2 Then: S(c).YS = 0
  254. If Player.Rotate = 3 Then: S(c).YS = 14
  255. If Player.Rotate = 4 Then: S(c).YS = 14
  256. If Player.Rotate = 5 Then: S(c).YS = 14
  257. If Player.Rotate = 6 Then: S(c).YS = 0
  258. If Player.Rotate = 7 Then: S(c).YS = -14
  259.  
  260. S(c).Type = T
  261. S(c).Act = True
  262. Select Case T
  263. Case sBlue
  264. S(c).Damage = 1
  265. S(c).Rotate = 0
  266. Case sRed
  267. S(c).Damage = 2
  268. S(c).Rotate = Player.Rotate
  269. Case sGreen
  270. S(c).Damage = 3
  271. S(c).Rotate = 0
  272. Case sMine
  273. S(c).Damage = 10
  274. S(c).Rotate = 0
  275. S(c).XS = 0
  276. S(c).YS = 0
  277. S(c).Count = 500
  278. Player.Mines = Player.Mines - 1
  279. End Select
  280.  
  281. If Player.Superman > 0 Then
  282. S(c).Damage = S(c).Damage * 1.5
  283. S(c).Count = S(c).Count + 20
  284. S(c).Type = S(c).Type + 4
  285. End If
  286. Exit For
  287. End If
  288. Next c
  289. End Function
  290.  
  291. Function SetSpeed(XSpeed, YSpeed, Player As Player)
  292. Player.XS = Player.XS + XSpeed
  293. Player.YS = Player.YS + YSpeed
  294. End Function
  295.  
  296. Function MovePlayer(Player As Player)
  297. On Error Resume Next
  298. Dim c As Long, Friction As Long, SmokeThing, i, AV
  299.  
  300. For c = 0 To 20
  301. If PUP(c).Act = True Then
  302. If CollisionDetect(Player.x, Player.y, 75, 75, Player.Rotate * 75, 0, PMask(Player.Type), PUP(c).x, PUP(c).y, 30, 30, 0, 0, PUPMask(PUP(c).Type)) = True Then
  303. PUP(c).Act = False
  304. Select Case PUP(c).Type
  305. Case 0
  306. Player.Shield = Player.Shield + 90
  307. Case 1
  308. Player.Mines = Player.Mines + 5
  309. Case 2
  310. Do
  311. Player.x = Int(Rnd * frmGame.board.ScaleWidth) - 37
  312. Player.y = Int(Rnd * frmGame.board.ScaleHeight) - 37
  313. For i = 1 To 4
  314. If P(i).id <> Player.id And CollisionDetect(Player.x, Player.y, 75, 75, Player.Rotate * 75, 0, PMask(Player.Type), P(i).x, P(i).y, 75, 75, P(i).Rotate * 75, 0, PMask(P(i).Type)) = False Then Exit Do
  315. Next i
  316. DoEvents
  317. Loop
  318. Case 3
  319. Player.Superman = Player.Superman + 150
  320. Player.Armor = Player.Armor + 2
  321. End Select
  322. End If
  323. End If
  324. Next c
  325.  
  326. If Player.Health < (Player.MAXHP * 0.7) Then
  327. SmokeThing = Player.Health \ 2 + (Player.Health \ 4)
  328. Player.ReSmoke = Player.ReSmoke + 1
  329. If Player.ReSmoke >= SmokeThing Then
  330. DoExplo Player.x + 22, Player.y + 22, IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), 5, 4
  331. Player.ReSmoke = 0
  332. End If
  333. End If
  334.  
  335. For c = 0 To UBound(S())
  336. If S(c).Act = True Then
  337. If CollisionDetect(Player.x, Player.y, 75, 75, Player.Rotate * 75, 0, PMask(Player.Type), S(c).x, S(c).y, 30, 30, 0, 0, SMask(S(c).Type)) = True And S(c).id <> Player.id Then
  338. If Player.Shield <= 0 Then Player.Health = Player.Health - S(c).Damage \ (Player.Armor + 1)
  339.  
  340. S(c).Act = False:
  341. Select Case S(c).Type
  342. Case sRed
  343. DoExplo S(c).x, S(c).y, 0, 0, 0, 5
  344. Case sBlue
  345. DoExplo S(c).x, S(c).y, 0, 0, 2, 3
  346. Case sGreen
  347. DoExplo S(c).x, S(c).y, 0, 0, 3, 4
  348. Case sMine
  349. DoExplo S(c).x, S(c).y, 0, 0, 7, 10
  350. Case 4
  351. DoExplo S(c).x, S(c).y, 0, 0, 0, 5
  352. Case 5
  353. DoExplo S(c).x, S(c).y, 0, 0, 2, 3
  354. Case 6
  355. DoExplo S(c).x, S(c).y, 0, 0, 3, 4
  356. End Select
  357.  
  358. Player.Armor = Player.Armor - 1: If Player.Armor < 0 Then Player.Armor = 0
  359. If Bands = True And Player.Band <> GetIDBand(S(c).id) Then Player.Target = S(c).id
  360. If Player.Health <= 0 Then
  361. Player.Act = False
  362.  
  363. Select Case Player.Type
  364. Case sGreen
  365. DoExplo Player.x + 20, Player.y + 20, 0, 0, 6, 6
  366. Case Else
  367. DoExplo Player.x + 20, Player.y + 20, 0, 0, 1, 6
  368. End Select
  369. End If
  370. End If
  371. End If
  372. Next c
  373.  
  374. Select Case Player.Type
  375. Case 0
  376. Friction = 2
  377. Case 1
  378. Friction = 3
  379. Case 2
  380. Friction = 1
  381. End Select
  382.  
  383. Select Case Player.XS
  384. Case Is < 0
  385. Player.XS = Player.XS + Friction
  386. Case Is > 0
  387. Player.XS = Player.XS - Friction
  388. End Select
  389. Select Case Player.YS
  390. Case Is < 0
  391. Player.YS = Player.YS + Friction
  392. Case Is > 0
  393. Player.YS = Player.YS - Friction
  394. End Select
  395.  
  396. Player.x = Player.x + Player.XS
  397. For i = 1 To 4
  398. If P(i).id <> Player.id And CollisionDetect(Player.x, Player.y, 75, 75, Player.Rotate * 75, 0, PMask(Player.Type), P(i).x, P(i).y, 75, 75, P(i).Rotate * 75, 0, PMask(P(i).Type)) = True Then
  399. Player.x = Player.x - Player.XS
  400. P(i).x = P(i).x - P(i).XS
  401. Player.XS = -(Player.XS)
  402. P(i).XS = -(P(i).XS)
  403. End If
  404. Next i
  405.  
  406. Player.y = Player.y + Player.YS
  407. For i = 1 To 4
  408. If P(i).Act = True And P(i).id <> Player.id And CollisionDetect(Player.x, Player.y, 75, 75, Player.Rotate * 75, 0, PMask(Player.Type), P(i).x, P(i).y, 75, 75, P(i).Rotate * 75, 0, PMask(P(i).Type)) = True Then
  409. Player.y = Player.y - Player.YS
  410. Player.YS = -(Player.YS)
  411. P(i).y = P(i).y - P(i).YS
  412. P(i).YS = -(P(i).YS)
  413. End If
  414. Next i
  415.  
  416. With frmGame
  417. If Player.x < -37 Then Player.x = .board.ScaleWidth + 37
  418. If Player.y < -37 Then Player.y = .board.ScaleHeight + 37
  419. If Player.y > .board.ScaleHeight + 37 Then Player.y = -37
  420. If Player.x > .board.ScaleWidth + 37 Then Player.x = -37
  421. End With
  422.  
  423. For c = 0 To 10
  424. If CollisionDetect(A(c).x, A(c).y, 30, 30, A(c).Rotate * 45, 0, AMask, Player.x, Player.y, 75, 75, Player.Rotate * 75, 0, PMask(Player.Type)) = True And A(c).Act = True Then
  425.  
  426. If Player.Shield <= 0 Then
  427. Player.Health = Player.Health - 2
  428.  
  429. If Player.Health < 0 Then
  430. Player.Act = False
  431. Select Case Player.Type
  432. Case sGreen
  433. DoExplo Player.x + 20, Player.y + 20, 0, 0, 6, 6
  434. Case Else
  435. DoExplo Player.x + 20, Player.y + 20, 0, 0, 1, 6
  436. End Select
  437. End If
  438. End If
  439. A(c).Act = False
  440.  
  441. DoExplo A(c).x + 5, A(c).y + 5, IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), 5, 4
  442. DoExplo A(c).x + 5, A(c).y + 5, IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), 5, 4
  443. End If
  444. Next c
  445. Player.Reload = Player.Reload - 1: If Player.Reload < 0 Then Player.Reload = 0
  446. Player.Boost = Player.Boost - 1: If Player.Boost < 0 Then Player.Boost = 0
  447. Player.Shield = Player.Shield - 1: If Player.Shield < 0 Then Player.Shield = 0
  448. Player.Superman = Player.Superman - 1: If Player.Superman < 0 Then Player.Superman = 0
  449. End Function
  450.  
  451. Function MoveShots()
  452. Dim c As Long
  453.  
  454. For c = 0 To 20
  455. If S(c).Act = True Then
  456. If S(c).Count <= 0 Then S(c).Act = False
  457. S(c).Count = S(c).Count - 1
  458. S(c).x = S(c).x + S(c).XS
  459. S(c).y = S(c).y + S(c).YS
  460.  
  461. With frmGame
  462. If S(c).x < -30 Then S(c).x = .board.ScaleWidth + 30
  463. If S(c).y < -30 Then S(c).y = .board.ScaleHeight + 30
  464. If S(c).y > .board.ScaleHeight + 30 Then S(c).y = -30
  465. If S(c).x > .board.ScaleWidth + 30 Then S(c).x = -30
  466. End With
  467. End If
  468. Next c
  469.  
  470. For c = 1 To 30
  471. If Explo(c).Act = True Then
  472. Explo(c).x = Explo(c).x + Explo(c).XS
  473. Explo(c).y = Explo(c).y + Explo(c).YS
  474. Explo(c).Frame = Explo(c).Frame + 1: If Explo(c).Frame > Explo(c).Frames Then Explo(c).Act = False
  475. End If
  476. Next c
  477.  
  478.  
  479. 'move asteroids
  480. Dim C3 As Long
  481. For c = 0 To 10
  482. If A(c).Act = True Then
  483. A(c).x = A(c).x + A(c).XS
  484. A(c).y = A(c).y + A(c).YS
  485. A(c).Rotate = A(c).Rotate + 1: If A(c).Rotate > 35 Then A(c).Rotate = 0
  486.  
  487. With frmGame
  488. If A(c).x < -30 Then A(c).x = .board.ScaleWidth + 30
  489. If A(c).x > .board.ScaleWidth + 5 Then A(c).x = -30
  490. If A(c).y < -30 Then A(c).y = .board.ScaleHeight + 30
  491. If A(c).y > .board.ScaleHeight + 30 Then A(c).y = -30
  492. End With
  493.  
  494. For C3 = 0 To UBound(S())
  495. If CollisionDetect(A(c).x, A(c).y, 30, 30, A(c).Rotate * 45, 0, AMask, S(C3).x, S(C3).y, 30, 30, 0, 0, SMask(S(C3).Type)) = True Then
  496. S(C3).Act = False
  497. Select Case S(c).Type
  498. Case sRed
  499. DoExplo S(c).x, S(c).y, 0, 0, 0, 5
  500. Case sBlue
  501. DoExplo S(c).x, S(c).y, 0, 0, 2, 3
  502. Case sGreen
  503. DoExplo S(c).x, S(c).y, 0, 0, 3, 4
  504. End Select
  505.  
  506. A(c).Act = False
  507.  
  508. DoExplo A(c).x + 5, A(c).y + 5, IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), 5, 4
  509. DoExplo A(c).x + 5, A(c).y + 5, IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), IIf(Int(Rnd * 2) = 0, Int(Rnd * 5) + 1, -(Int(Rnd * 5) + 1)), 5, 4
  510. End If
  511. Next C3
  512. End If
  513. Next c
  514.  
  515. For i = 0 To 20
  516. If PUP(i).Act = True Then
  517. PUP(i).Count = PUP(i).Count - 1: If PUP(i).Count < 0 Then PUP(i).Act = False
  518. End If
  519. Next i
  520. End Function
  521.  
  522. Function DoKeys(Player As Player, L, R, U, Shoot, Special)
  523. If GetAsyncKeyState(L) Then TurnLeft Player
  524. If GetAsyncKeyState(R) Then TurnRight Player
  525. If GetAsyncKeyState(U) Then MoveForward Player
  526. If GetAsyncKeyState(Shoot) Then Fire Player, Player.Type
  527. If GetAsyncKeyState(Special) Then
  528. If Player.Mines > 0 Then
  529. Fire Player, 3
  530. End If
  531. End If
  532. End Function
  533.  
  534. Function DoExplo(x, y, XSp, YSp, eType, Frames)
  535. Dim c As Long
  536. For c = 1 To 30
  537. If Explo(c).Act = False Then
  538. Explo(c).Frame = 0
  539. Explo(c).Act = True
  540. Explo(c).x = x
  541. Explo(c).y = y
  542. Explo(c).XS = XSp
  543. Explo(c).YS = YSp
  544. Explo(c).Type = eType
  545. Explo(c).Frames = Frames
  546. Exit For
  547. End If
  548. Next c
  549. End Function
  550.  
  551. Function DoAI(Player As Player)
  552. Dim Try As Long
  553. If Player.Target = 0 Then
  554. Try = 0
  555. Do
  556. Player.Target = Int(Rnd * 4) + 1
  557. If Player.Target <> Player.id And P(Player.Target).Act = True And Player.Band <> P(Player.Target).Band Then
  558. Exit Do
  559. Else
  560. Try = Try + 1: If Try > 8 Then Exit Do
  561. DoEvents
  562. End If
  563. Loop
  564. End If
  565.  
  566. If Int(Rnd * 10) = Int(Rnd * 9) Then
  567. For i = 0 To UBound(S())
  568. If S(i).Act = True Then
  569. If S(i).x + 15 > Player.x - 75 And S(i).x + 15 < Player.x + (75 * 2) And S(i).y + 15 > Player.y - 75 And S(i).y + 15 < Player.y + (75 * 2) Then
  570. Player.Rotate = FindAng(Player.x + 37, Player.y + 37, S(i).x + 15, S(i).y + 15) - 2
  571. If Player.Rotate < 0 Then Player.Rotate = 7
  572. If Player.Rotate > 7 Then Player.Rotate = 0
  573. MoveForward Player
  574. End If
  575. End If
  576. Next i
  577. End If
  578.  
  579. If Int(Rnd * 5) = Int(Rnd * 6) Then 'seek and destroy
  580. Player.Rotate = FindAng(Player.x + 37, Player.y + 37, P(Player.Target).x + 37, P(Player.Target).y + 37)
  581. MoveForward Player
  582. Fire Player, Player.Type
  583. End If
  584.  
  585. If Player.Mines > 0 And Int(Rnd * 5) = Int(Rnd * 4) Then Fire Player, 3
  586. If Player.BoostLeft > 0 Then
  587. MoveForward Player
  588. Player.BoostLeft = Player.BoostLeft - 1
  589. End If
  590. End Function
  591.  
  592. Function FindAng(SrcX, SrcY, DstX, DstY) As Long
  593. Dim XS, YS, Range
  594. Range = 40
  595. Select Case DstX
  596. Case Is < SrcX - Range
  597. XS = -1
  598. Case Is > SrcX + Range
  599. XS = 1
  600. Case Is < SrcX + Range And DstX > SrcX - Range
  601. XS = 0
  602. End Select
  603.  
  604. Select Case DstY
  605. Case Is < SrcY - Range
  606. YS = -1
  607. Case Is > SrcY + Range
  608. YS = 1
  609. Case Is < SrcY + Range And DstY > SrcY - Range
  610. YS = 0
  611. End Select
  612.  
  613. If XS < 0 And YS < 0 Then FindAng = 7
  614. If XS > 0 And YS > 0 Then FindAng = 3
  615.  
  616. If XS = 0 And YS > 0 Then FindAng = 2
  617. If XS = 0 And YS < 0 Then FindAng = 6
  618.  
  619. If YS = 0 And XS > 0 Then FindAng = 4
  620. If YS = 0 And XS < 0 Then FindAng = 0
  621.  
  622. If YS < 0 And XS > 0 Then FindAng = 5
  623. If YS > 0 And XS < 0 Then FindAng = 1
  624.  
  625. FindAng = 7 - FindAng
  626. End Function
  627.  
  628.  
  629. Sub CheckWinner()
  630. Dim c As Long, PCount As Long, WinnerID As Long, R, G
  631. If Bands = False Then
  632. For c = 1 To UBound(P())
  633. If P(c).Act = True Then PCount = PCount + 1
  634. Next c
  635. If PCount <= 1 And isGameDone = True Then
  636. For c = 1 To UBound(P())
  637. If P(c).Act = True Then WinnerID = c
  638. Next c
  639. Running = False
  640. If WinnerID <= 0 Then Exit Sub
  641. Message.Major = P(WinnerID).Nick & " won the game!"
  642. Message.Minor = "Press F2 for newgame!"
  643. Playing = False
  644. End If
  645. End If
  646.  
  647. If Bands = True Then
  648. For c = 1 To 4
  649. If P(c).Act = True Then
  650. If P(c).Band = 1 Then R = R + 1
  651. If P(c).Band = 0 Then G = G + 1
  652. End If
  653. Next c
  654. Debug.Print R
  655. Debug.Print G
  656. If R < 1 And G > 0 Then
  657. 'team1 won
  658. Playing = False
  659. Running = False
  660. Message.Major = TeamName(1) & " won the game!"
  661. Message.Minor = "Press F2 for newgame!"
  662. ElseIf G < 1 And R > 0 Then
  663. 'team2 won
  664. Message.Major = TeamName(2) & " won the game!"
  665. Message.Minor = "Press F2 for newgame!"
  666. Playing = False
  667. Running = False
  668. End If
  669. End If
  670. End Sub
  671.  
  672. Function isGameDone() As Boolean
  673. isGameDone = True
  674. End Function
  675.  
  676. Function CenterText(picture As PictureBox, text As String, offx, offy)
  677. picture.CurrentX = picture.ScaleWidth \ 2 - picture.TextWidth(text) \ 2 + offx
  678. picture.CurrentY = picture.ScaleHeight \ 2 - picture.TextHeight("|") \ 2 + offy
  679. picture.Print text
  680. End Function
  681.  
  682. Function MakeAsteroid()
  683. Dim c As Long
  684. For c = 0 To 10
  685. If A(c).Act = False Then
  686. A(c).Act = True
  687. A(c).Rotate = Int(Rnd * 35)
  688.  
  689. With frmGame
  690. Select Case Int(Rnd * 4)
  691. Case 0
  692. A(c).x = Int(Rnd * .board.ScaleWidth)
  693. A(c).y = -15
  694. A(c).YS = Int(Rnd * 5) + 1
  695. A(c).XS = IIf(Int(Rnd * 1) = 0, -Int(Rnd * 5) - 1, Int(Rnd * 5) + 1)
  696. Case 1
  697. A(c).x = -15
  698. A(c).y = Int(Rnd * .board.ScaleHeight)
  699. A(c).XS = Int(Rnd * 5) + 1
  700. A(c).YS = IIf(Int(Rnd * 1) = 0, -Int(Rnd * 5) - 1, Int(Rnd * 5) + 1)
  701. Case 2
  702. A(c).x = .board.ScaleWidth + 15
  703. A(c).y = Int(Rnd * .board.ScaleWidth)
  704. A(c).XS = -Int(Rnd * 5) + 1
  705. A(c).YS = IIf(Int(Rnd * 1) = 0, -Int(Rnd * 5) - 1, Int(Rnd * 5) + 1)
  706. Case 3
  707. A(c).x = Int(Rnd * .board.ScaleWidth)
  708. A(c).y = .board.ScaleHeight + 29
  709. A(c).XS = IIf(Int(Rnd * 1) = 0, -Int(Rnd * 5) - 1, Int(Rnd * 5) + 1)
  710. A(c).YS = -Int(Rnd * 5) + 1
  711. End Select
  712. End With
  713. Debug.Print "Asteroid Made"
  714. Exit For
  715. End If
  716. Next c
  717. End Function
  718.  
  719. Sub Pause()
  720. If Playing = False Then Exit Sub
  721. Select Case Running
  722. Case True
  723. Running = False
  724. Exit Sub
  725. Case False
  726. Running = True
  727. Exit Sub
  728. End Select
  729. End Sub
  730.  
  731. Function GetIDBand(id As Long) As Long
  732. GetIDBand = P(id).Band
  733. End Function
  734.