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 / FrmCascade.frm < prev    next >
Text File  |  2005-11-27  |  8KB  |  280 lines
  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
  3. Begin VB.Form FrmCascade 
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   0  'None
  6.    Caption         =   "Form1"
  7.    ClientHeight    =   8925
  8.    ClientLeft      =   0
  9.    ClientTop       =   0
  10.    ClientWidth     =   11685
  11.    BeginProperty Font 
  12.       Name            =   "Kristen ITC"
  13.       Size            =   14.25
  14.       Charset         =   0
  15.       Weight          =   700
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    LinkTopic       =   "Form1"
  21.    MaxButton       =   0   'False
  22.    MinButton       =   0   'False
  23.    ScaleHeight     =   595
  24.    ScaleMode       =   3  'Pixel
  25.    ScaleWidth      =   779
  26.    ShowInTaskbar   =   0   'False
  27.    StartUpPosition =   3  'Windows Default
  28.    WindowState     =   2  'Maximized
  29.    Begin VB.CheckBox Check1 
  30.       BackColor       =   &H00000000&
  31.       Caption         =   "Animate My Balls"
  32.       ForeColor       =   &H00FF8080&
  33.       Height          =   495
  34.       Left            =   840
  35.       TabIndex        =   2
  36.       Top             =   3540
  37.       Width           =   3375
  38.    End
  39.    Begin VB.Timer Timer1 
  40.       Interval        =   75
  41.       Left            =   120
  42.       Top             =   2520
  43.    End
  44.    Begin PicClip.PictureClip Balls 
  45.       Index           =   0
  46.       Left            =   540
  47.       Top             =   4980
  48.       _ExtentX        =   21167
  49.       _ExtentY        =   1323
  50.       _Version        =   393216
  51.       Cols            =   16
  52.       Picture         =   "FrmCascade.frx":0000
  53.    End
  54.    Begin PicClip.PictureClip Balls 
  55.       Index           =   1
  56.       Left            =   660
  57.       Top             =   5880
  58.       _ExtentX        =   21167
  59.       _ExtentY        =   1323
  60.       _Version        =   393216
  61.       Cols            =   16
  62.       Picture         =   "FrmCascade.frx":1D512
  63.    End
  64.    Begin PicClip.PictureClip Balls 
  65.       Index           =   2
  66.       Left            =   840
  67.       Top             =   6660
  68.       _ExtentX        =   21167
  69.       _ExtentY        =   1323
  70.       _Version        =   393216
  71.       Cols            =   16
  72.       Picture         =   "FrmCascade.frx":3AA24
  73.    End
  74.    Begin PicClip.PictureClip Balls 
  75.       Index           =   3
  76.       Left            =   1080
  77.       Top             =   7560
  78.       _ExtentX        =   21167
  79.       _ExtentY        =   1323
  80.       _Version        =   393216
  81.       Cols            =   16
  82.       Picture         =   "FrmCascade.frx":57F36
  83.    End
  84.    Begin VB.Label Score 
  85.       BackColor       =   &H00000000&
  86.       Caption         =   "0"
  87.       BeginProperty Font 
  88.          Name            =   "Kristen ITC"
  89.          Size            =   24
  90.          Charset         =   0
  91.          Weight          =   700
  92.          Underline       =   0   'False
  93.          Italic          =   0   'False
  94.          Strikethrough   =   0   'False
  95.       EndProperty
  96.       ForeColor       =   &H00FF8080&
  97.       Height          =   645
  98.       Left            =   2220
  99.       TabIndex        =   1
  100.       Top             =   120
  101.       Width           =   2955
  102.    End
  103.    Begin VB.Label Label1 
  104.       AutoSize        =   -1  'True
  105.       BackColor       =   &H00000000&
  106.       Caption         =   "Score ="
  107.       BeginProperty Font 
  108.          Name            =   "Kristen ITC"
  109.          Size            =   24
  110.          Charset         =   0
  111.          Weight          =   700
  112.          Underline       =   0   'False
  113.          Italic          =   0   'False
  114.          Strikethrough   =   0   'False
  115.       EndProperty
  116.       ForeColor       =   &H00FF8080&
  117.       Height          =   660
  118.       Left            =   180
  119.       TabIndex        =   0
  120.       Top             =   120
  121.       Width           =   1890
  122.    End
  123.    Begin VB.Image Cell 
  124.       Height          =   675
  125.       Index           =   0
  126.       Left            =   0
  127.       Top             =   0
  128.       Width           =   615
  129.    End
  130. End
  131. Attribute VB_Name = "FrmCascade"
  132. Attribute VB_GlobalNameSpace = False
  133. Attribute VB_Creatable = False
  134. Attribute VB_PredeclaredId = True
  135. Attribute VB_Exposed = False
  136. Option Explicit
  137.  
  138. Private Sub BuildBoard()
  139.     On Error Resume Next
  140.     
  141.     Dim GridY As Single
  142.     Dim GridX As Single
  143.     
  144.     Dim X As Single
  145.     Dim Y As Single
  146.     
  147.     Dim OffX As Single
  148.     Dim OffY As Single
  149.     
  150.     'Populate Board Image Arrey
  151.     For Y = 0 To BoardY - 1
  152.         For X = 0 To BoardX - 1
  153.             Board(X, Y, 0) = Int(Rnd * 3) + 1
  154.             Select Case Board(X, Y, 0)
  155.                 Case 1
  156.                     Board(X, Y, 1) = 0
  157.                 Case 2
  158.                     Board(X, Y, 1) = 4
  159.                 Case 3
  160.                     Board(X, Y, 1) = 8
  161.                 Case 4
  162.                     Board(X, Y, 1) = 12
  163.             End Select
  164.         Next X
  165.     Next Y
  166.     
  167.     Cell(0).Picture = Balls(0).GraphicCell(0)
  168.     
  169.     'Get Central Position
  170.     OffX = ((Screen.Width / 15) - (BoardX * 50)) / 2
  171.     OffY = ((Screen.Height / 15) - (BoardY * 50)) / 2
  172.     
  173.     
  174.     'Create Board
  175.     For GridY = 0 To BoardY - 1
  176.         For GridX = 0 To BoardX - 1
  177.             Load Cell(GridX + (GridY * BoardX))
  178.             Cell(GridX + (GridY * BoardX)).Left = OffX + (GridX * 50)
  179.             Cell((GridX + (GridY * BoardX))).Top = OffY + (GridY * 50)
  180.             Cell((GridX + (GridY * BoardX))).Visible = True
  181.         Next GridX
  182.     Next GridY
  183. End Sub
  184.  
  185. Private Sub Cell_Click(Index As Integer)
  186.  
  187.     If AllowClick = False Then Exit Sub
  188.     
  189.     'Get Arrey Coordinates From Index
  190.     CellY = Int(Index / BoardX)
  191.     GetCellX = Format(((Index / BoardX) - (CellY + 1)), "###.###") + 0.01
  192.     CellX = Int((BoardX / 100) * ((GetCellX + 1) * 100))
  193.     
  194.     If Board(CellX, CellY, 0) = 5 Then Exit Sub
  195.     
  196.     AllowClick = False
  197.     
  198.     GetConnected CellX, CellY, Int(Board(CellX, CellY, 0))
  199. End Sub
  200.  
  201.  
  202.  
  203.  
  204. Private Sub Check1_Click()
  205. Animate = Check1.Value
  206. End Sub
  207.  
  208. Private Sub Form_Activate()
  209.     AllowClick = True
  210.     AllowLeft = True
  211.     AllowMessage = False
  212.     Score.Caption = 0
  213.     BuildBoard
  214.     MaxFrames = 14
  215. End Sub
  216.  
  217. Private Sub Form_Load()
  218.  
  219.     AllowClick = True
  220.     BuildBoard
  221.     MaxFrames = 14
  222.     Check1.Left = 20
  223.     Check1.Top = (Screen.Height / 15) - Check1.Height - 20
  224.     Animate = Check1.Value
  225.     
  226. End Sub
  227.  
  228. Private Sub Timer1_Timer()
  229.     
  230.     Dim Y As Single
  231.     Dim X As Single
  232.     
  233.     'Animate The Balls
  234.     For Y = 0 To BoardY - 1
  235.         For X = 0 To BoardX - 1
  236.         
  237.             If Board(X, Y, 0) < 5 And Y < BoardY - 1 Then
  238.                 If Board(X, Y + 1, 0) = 5 Then
  239.                     AllowLeft = False
  240.                     Board(X, Y + 1, 0) = Board(X, Y, 0)
  241.                     Board(X, Y, 0) = 5
  242.                 End If
  243.             End If
  244.                       
  245.             If AllowLeft = True Then
  246.                 MoveEmLeft
  247.             End If
  248.             
  249.             If Board(X, Y, 0) < 5 Then
  250.                 If Animate = True Then
  251.                     Board(X, Y, 1) = Board(X, Y, 1) + 1
  252.                     If Board(X, Y, 1) > MaxFrames Then Board(X, Y, 1) = 0
  253.                 Else
  254.                     Board(X, Y, 1) = 4
  255.                 End If
  256.                 Cell((Y * BoardX) + X).Picture = Balls(Board(X, Y, 0)).GraphicCell(Board(X, Y, 1))
  257.             Else
  258.                 GetIndex = (Y * BoardX) + X
  259.                 Cell(GetIndex).Picture = LoadPicture("")
  260.             End If
  261.         Next X
  262.     Next Y
  263.     
  264.     If AllowLeft = True Then CheckEnd
  265.     
  266.     AllowLeft = True
  267.     
  268.     DisplayGrey = DisplayGrey - 1
  269.     If DisplayGrey < 0 Then DisplayGrey = 0
  270.     
  271.     If DisplayGrey = 1 Then
  272.         ClearYaWhammy
  273.         ElseIf DisplayGrey > 1 Then AllowClick = False
  274.     End If
  275.     
  276.     
  277.     
  278.     
  279. End Sub
  280.