home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Classic_Ga19517811282005.psc / Cascade / Cascade.bas next >
BASIC Source File  |  2005-11-27  |  9KB  |  291 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Public Const BoardX = 15
  4. Public Const BoardY = 12
  5. Public Board(BoardX - 1, BoardY - 1, 1)
  6. Public AllowClick, AllowLeft As Boolean
  7. Public MaxFrames As Single
  8. Public Frame As Single
  9. Public CellX As Double
  10. Public CellY As Double
  11. Public GetCellX As Double
  12. Public GetIndex As Long
  13. Public Animate As Boolean
  14. Public DisplayGrey As Single
  15. Public AllowMessage As Boolean
  16. Public HighScores(10, 1)
  17. Public YourPos As Single
  18. Public DoSave As Boolean
  19.  
  20. Public Function FileExists(strPath As String) As Integer
  21.     FileExists = Not (Dir(strPath) = "")
  22. End Function
  23.  
  24.  
  25. Public Sub CheckEnd()
  26.     Dim BallX, BallY, Connection, Balls As Single
  27.     
  28.     Connection = 0
  29.     
  30.     For BallY = 0 To BoardY - 1
  31.         For BallX = 0 To BoardX - 1
  32.             If Board(BallX, BallY, 0) < 5 Then
  33.                 Balls = Balls + 1
  34.                 If BallX < BoardX - 1 Then
  35.                     If Board(BallX + 1, BallY, 0) = Board(BallX, BallY, 0) Then Connection = 1
  36.                 End If
  37.         
  38.                 If BallX > 0 Then
  39.                     If Board(BallX - 1, BallY, 0) = Board(BallX, BallY, 0) Then Connection = 1
  40.                 End If
  41.         
  42.                 If BallY > 0 Then
  43.                     If Board(BallX, BallY - 1, 0) = Board(BallX, BallY, 0) Then Connection = 1
  44.                 End If
  45.         
  46.                 If BallY < BoardY - 1 Then
  47.                     If Board(BallX, BallY + 1, 0) = Board(BallX, BallY, 0) Then Connection = 1
  48.                 End If
  49.             End If
  50.             If Connection = 1 Then Exit Sub
  51.             DoEvents
  52.         Next BallX
  53.     Next BallY
  54.  
  55.  
  56.     
  57.     If Connection = 0 And AllowMessage = False Then
  58.         AllowMessage = True
  59.         If Balls = 0 Then
  60.             FrmCascade.Score.Caption = Val(FrmCascade.Score.Caption) + 10000
  61.             MsgBox "You Cleared The Board, Bonus 10,000 Points."
  62.             LoadHighScores True, Val(FrmCascade.Score.Caption)
  63.             Exit Sub
  64.         Else
  65.             MsgBox "Your Outa There..."
  66.             LoadHighScores False, Val(FrmCascade.Score.Caption)
  67.         End If
  68.     End If
  69.     
  70. End Sub
  71. Public Sub LoadHighScores(Bonus As Boolean, Score As Double)
  72.  
  73.     Dim FF As Long
  74.     Dim Pos, rep As Single
  75.     Dim SplitString() As String
  76.     Dim InString As String
  77.     
  78.     Pos = 0
  79.     
  80.     FF = FreeFile
  81.     Open App.Path & "\Scores.Txt" For Input As #FF
  82.         Do
  83.             Line Input #FF, InString
  84.             SplitString = Split(InString, "|")
  85.             HighScores(Pos, 0) = SplitString(0)
  86.             HighScores(Pos, 1) = SplitString(1)
  87.             Pos = Pos + 1
  88.         Loop Until EOF(FF)
  89.     Close #FF
  90.     
  91.     If Score < Val(HighScores(9, 1)) Then
  92.         frmScore.Score = Score
  93.         frmScore.EndMessage.Caption = "Well Done, You Didn't Even Get On The Score Board??!!??"
  94.         For rep = 0 To 9
  95.             frmOtherStuff.TxtName(rep).Caption = HighScores(rep, 0)
  96.             frmOtherStuff.Score(rep).Caption = HighScores(rep, 1)
  97.         Next rep
  98.         FrmMenu.Show
  99.         frmScore.Show
  100.         Exit Sub
  101.     Else
  102.         HighScores(9, 0) = ""
  103.         HighScores(9, 1) = Score
  104.         frmScore.Score = Score
  105.     End If
  106.     
  107.     For rep = 9 To 0 Step -1
  108.         If Score > Val(HighScores(rep, 1)) Then
  109.             YourPos = rep
  110.         End If
  111.     Next rep
  112.  
  113.     For rep = 1 To 10
  114.         For Pos = 9 To 1 Step -1
  115.             If Val(HighScores(Pos - 1, 1)) < Val(HighScores(Pos, 1)) Then
  116.                 
  117.                 HighScores(10, 0) = HighScores(Pos - 1, 0)
  118.                 HighScores(10, 1) = HighScores(Pos - 1, 1)
  119.                 
  120.                 HighScores(Pos - 1, 0) = HighScores(Pos, 0)
  121.                 HighScores(Pos - 1, 1) = HighScores(Pos, 1)
  122.                 
  123.                 HighScores(Pos, 0) = HighScores(10, 0)
  124.                 HighScores(Pos, 1) = HighScores(10, 1)
  125.             End If
  126.         Next Pos
  127.     Next rep
  128.     
  129.     Select Case YourPos
  130.     Case 0
  131.         frmScore.EndMessage.Caption = "Daaaamn, You Made 1st Place Well Done."
  132.     Case 1
  133.         frmScore.EndMessage.Caption = "Excellant Effort You Made 2nd Place. "
  134.     Case 2
  135.         frmScore.EndMessage.Caption = "Well Done, 3rd Place."
  136.     Case 3
  137.         frmScore.EndMessage.Caption = "Good Effort, 4th Place."
  138.     Case 4
  139.         frmScore.EndMessage.Caption = "Don't Suppose Your An Average Sort Of Person? You Made 5th."
  140.     Case 5
  141.         frmScore.EndMessage.Caption = "HHHhhhhhm 6th Place, At Least Your On The Board."
  142.     Case 6
  143.         frmScore.EndMessage.Caption = "A Bit Below Average, Is That Normal For You? 7th Place."
  144.     Case 7
  145.         frmScore.EndMessage.Caption = "Guess You'd Better Try Again, I Mean 8th Place, C'Mon."
  146.     Case 8
  147.         frmScore.EndMessage.Caption = "Your Not An IT Teacher Are You? 9th Place."
  148.     Case 9
  149.         frmScore.EndMessage.Caption = "Bet You Always get That Hanging On By Your Teeth Feeling, 10th."
  150.     End Select
  151.     
  152.     For rep = 0 To 9
  153.         frmOtherStuff.TxtName(rep).Caption = HighScores(rep, 0)
  154.         frmOtherStuff.Score(rep).Caption = HighScores(rep, 1)
  155.     Next rep
  156.     
  157.     
  158.     
  159.     DoSave = True
  160.     frmOtherStuff.TxtEnterName.Top = frmOtherStuff.TxtName(YourPos).Top
  161.     frmOtherStuff.TxtEnterName.Left = frmOtherStuff.TxtName(YourPos).Left
  162.     frmOtherStuff.TxtEnterName.Visible = True
  163.     FrmMenu.Show
  164.     frmScore.Show
  165.  
  166. End Sub
  167.  
  168.  
  169. Public Sub SaveScores()
  170.  
  171.     Dim FF As Long
  172.     Dim rep As Single
  173.     
  174.     FF = FreeFile
  175.     Open App.Path & "\Scores.Txt" For Output As #FF
  176.         For rep = 0 To 9
  177.             Print #FF, HighScores(rep, 0) & "|" & HighScores(rep, 1)
  178.         Next rep
  179.     Close #FF
  180.     
  181. End Sub
  182.  
  183. Public Sub GetConnected(BallX As Double, BallY As Double, BColour As Single)
  184.  
  185.     Dim Connection, X, Y, rep As Single
  186.     
  187.     Connection = 0
  188.     
  189.     'Check for Lonesome Ball
  190.     If BallX < BoardX - 1 Then
  191.         If Board(BallX + 1, BallY, 0) = Board(BallX, BallY, 0) Then Connection = 1
  192.     End If
  193.     
  194.     If BallX > 0 Then
  195.         If Board(BallX - 1, BallY, 0) = Board(BallX, BallY, 0) Then Connection = 1
  196.     End If
  197.     
  198.     If BallY > 0 Then
  199.     If Board(BallX, BallY - 1, 0) = Board(BallX, BallY, 0) Then Connection = 1
  200.     End If
  201.     
  202.     If BallY < BoardY - 1 Then
  203.     If Board(BallX, BallY + 1, 0) = Board(BallX, BallY, 0) Then Connection = 1
  204.     End If
  205.     
  206.     'It Is A Lonesome Ball Aaaawwwwww
  207.     If Connection = 0 Then
  208.         AllowClick = True
  209.         Exit Sub
  210.     End If
  211.     
  212.     'Change Point Ball To A Grey Ball
  213.     Board(BallX, BallY, 0) = 0
  214.     
  215.     'Find The Number Of Balls In Ya Whammy
  216.     For rep = 0 To (BoardX * BoardY)
  217.         For Y = 0 To BoardY - 1
  218.             For X = 0 To BoardX - 1
  219.                 'Convert Connected Balls To Grey Balls
  220.                 If Board(X, Y, 0) = 0 Then
  221.                     If X < BoardX - 1 Then
  222.                         If Board(X + 1, Y, 0) = BColour Then Board(X + 1, Y, 0) = 0
  223.                     End If
  224.             
  225.                     If X > 0 Then
  226.                         If Board(X - 1, Y, 0) = BColour Then Board(X - 1, Y, 0) = 0
  227.                     End If
  228.                     
  229.                     If Y > 0 Then
  230.                         If Board(X, Y - 1, 0) = BColour Then Board(X, Y - 1, 0) = 0
  231.                     End If
  232.                     
  233.                     If Y < BoardY - 1 Then
  234.                         If Board(X, Y + 1, 0) = BColour Then Board(X, Y + 1, 0) = 0
  235.                     End If
  236.                 End If
  237.                 
  238.             Next X
  239.         Next Y
  240.     Next rep
  241.  
  242.     DisplayGrey = 6
  243.     
  244. End Sub
  245.  
  246. Public Sub ClearYaWhammy()
  247.  
  248.     Dim X, Y, Whammy As Single
  249.     
  250.     For Y = 0 To BoardY - 1
  251.         For X = 0 To BoardX - 1
  252.             If Board(X, Y, 0) = 0 Then
  253.                 Board(X, Y, 0) = 5
  254.                 Whammy = Whammy + 1
  255.             End If
  256.             
  257.         Next X
  258.     Next Y
  259.     
  260.     FrmCascade.Score.Caption = Val(FrmCascade.Score.Caption) + ((Whammy * Whammy) * Whammy)
  261.     
  262.     AllowClick = True
  263. End Sub
  264.  
  265. Public Sub MoveEmLeft()
  266.  
  267.     Dim X, Y, X2, Y2, Match, rep As Single
  268.  
  269.  
  270.     For X = 0 To BoardX - 2
  271.         Match = 0
  272.         For Y = 0 To BoardY - 1
  273.             If Board(X, Y, 0) < 5 Then Match = 1
  274.         Next Y
  275.         If Match = 0 Then
  276.             AllowClick = False
  277.             For X2 = X To BoardX - 2
  278.                 For Y2 = 0 To BoardY - 1
  279.                     Board(X2, Y2, 0) = Board(X2 + 1, Y2, 0)
  280.                     Board(X2 + 1, Y2, 0) = 5
  281.                 Next Y2
  282.             Next X2
  283.             AllowClick = True
  284.             Exit Sub
  285.         End If
  286.         
  287.     Next X
  288.  
  289.  
  290. End Sub
  291.