VERSION 5.00 Begin VB.Form Frm_lose_your_marbles BackColor = &H0080C0FF& Caption = "Lose Your Marbles" ClientHeight = 3195 ClientLeft = 60 ClientTop = 630 ClientWidth = 4680 LinkTopic = "Form1" ScaleHeight = 3195 ScaleWidth = 4680 WindowState = 2 'Maximized Begin VB.CommandButton cmd_down Caption = "DOWN" Height = 855 Left = 11400 TabIndex = 7 Top = 5160 Width = 975 End Begin VB.CommandButton cmd_up Caption = "UP" Height = 855 Left = 11400 TabIndex = 6 Top = 4320 Width = 975 End Begin VB.Frame Frame1 BackColor = &H00FF8080& BorderStyle = 0 'None Height = 9135 Left = 3360 TabIndex = 0 Top = 600 Width = 6615 Begin VB.Line Line2 BorderWidth = 3 X1 = 0 X2 = 6600 Y1 = 5160 Y2 = 5160 End Begin VB.Line Line1 BorderWidth = 3 X1 = 0 X2 = 6600 Y1 = 4200 Y2 = 4200 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 44 Left = 5400 Shape = 3 'Circle Top = 8160 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 43 Left = 5400 Shape = 3 'Circle Top = 7200 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 42 Left = 5400 Shape = 3 'Circle Top = 6240 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 41 Left = 5400 Shape = 3 'Circle Top = 5280 Width = 855 End Begin VB.Shape Shape1 BackColor = &H00FF8080& FillStyle = 0 'Solid Height = 735 Index = 40 Left = 5400 Shape = 3 'Circle Top = 4320 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 39 Left = 5400 Shape = 3 'Circle Top = 3360 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 38 Left = 5400 Shape = 3 'Circle Top = 2400 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 37 Left = 5400 Shape = 3 'Circle Top = 1440 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 36 Left = 5400 Shape = 3 'Circle Top = 480 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 35 Left = 4200 Shape = 3 'Circle Top = 8160 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 34 Left = 4200 Shape = 3 'Circle Top = 7200 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 33 Left = 4200 Shape = 3 'Circle Top = 6240 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 32 Left = 4200 Shape = 3 'Circle Top = 5280 Width = 855 End Begin VB.Shape Shape1 BackColor = &H00FF8080& FillStyle = 0 'Solid Height = 735 Index = 31 Left = 4200 Shape = 3 'Circle Top = 4320 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 30 Left = 4200 Shape = 3 'Circle Top = 3360 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 29 Left = 4200 Shape = 3 'Circle Top = 2400 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 28 Left = 4200 Shape = 3 'Circle Top = 1440 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 27 Left = 4200 Shape = 3 'Circle Top = 480 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 26 Left = 2880 Shape = 3 'Circle Top = 8160 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 25 Left = 2880 Shape = 3 'Circle Top = 7200 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 24 Left = 2880 Shape = 3 'Circle Top = 6240 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 23 Left = 2880 Shape = 3 'Circle Top = 5280 Width = 855 End Begin VB.Shape Shape1 BackColor = &H00FF8080& FillStyle = 0 'Solid Height = 735 Index = 22 Left = 2880 Shape = 3 'Circle Top = 4320 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 21 Left = 2880 Shape = 3 'Circle Top = 3360 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 20 Left = 2880 Shape = 3 'Circle Top = 2400 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 19 Left = 2880 Shape = 3 'Circle Top = 1440 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 18 Left = 2880 Shape = 3 'Circle Top = 480 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 17 Left = 1680 Shape = 3 'Circle Top = 8160 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 16 Left = 1680 Shape = 3 'Circle Top = 7200 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 15 Left = 1680 Shape = 3 'Circle Top = 6240 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 14 Left = 1680 Shape = 3 'Circle Top = 5280 Width = 855 End Begin VB.Shape Shape1 BackColor = &H00FF8080& FillStyle = 0 'Solid Height = 735 Index = 13 Left = 1680 Shape = 3 'Circle Top = 4320 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 12 Left = 1680 Shape = 3 'Circle Top = 3360 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 11 Left = 1680 Shape = 3 'Circle Top = 2400 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 10 Left = 1680 Shape = 3 'Circle Top = 1440 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 9 Left = 1680 Shape = 3 'Circle Top = 480 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 8 Left = 360 Shape = 3 'Circle Top = 8160 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 7 Left = 360 Shape = 3 'Circle Top = 7200 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 6 Left = 360 Shape = 3 'Circle Top = 6240 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 5 Left = 360 Shape = 3 'Circle Top = 5280 Width = 855 End Begin VB.Shape Shape1 BackColor = &H00FF8080& FillStyle = 0 'Solid Height = 735 Index = 4 Left = 360 Shape = 3 'Circle Top = 4320 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 3 Left = 360 Shape = 3 'Circle Top = 3360 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 2 Left = 360 Shape = 3 'Circle Top = 2400 Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 1 Left = 360 Shape = 3 'Circle Top = 1440 Visible = 0 'False Width = 855 End Begin VB.Shape Shape1 FillStyle = 0 'Solid Height = 735 Index = 0 Left = 360 Shape = 3 'Circle Top = 480 Visible = 0 'False Width = 855 End Begin VB.Label Label1 BackColor = &H00FF8080& Height = 975 Index = 4 Left = 5280 TabIndex = 5 Top = 4200 Width = 1095 End Begin VB.Label Label1 BackColor = &H00FF8080& Height = 975 Index = 3 Left = 4080 TabIndex = 4 Top = 4200 Width = 1095 End Begin VB.Label Label1 BackColor = &H00FF8080& Height = 975 Index = 2 Left = 2760 TabIndex = 3 Top = 4200 Width = 1095 End Begin VB.Label Label1 BackColor = &H00FF8080& Height = 975 Index = 1 Left = 1560 TabIndex = 2 Top = 4200 Width = 1095 End Begin VB.Label Label1 BackColor = &H00FF8080& Height = 975 Index = 0 Left = 240 TabIndex = 1 Top = 4200 Width = 1095 End End Begin VB.Menu mnu_new_game Caption = "New Game" End Begin VB.Menu mnu_exit Caption = "Exit" End End Attribute VB_Name = "Frm_lose_your_marbles" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private marbletop(0 To 4) As Integer Private marblebottom(0 To 4) As Integer Private boardtop(0 To 4) As Integer Private boardbottom(0 To 4) As Integer Private marblemiddle(0 To 4) As Integer Private currentcolumn As Integer Private Sub cmd_up_Click() Dim x As Integer Dim y As Integer If marbletop(currentcolumn) = boardtop(currentcolumn) Then MsgBox "Can't Move Up" Else marbletop(currentcolumn) = marbletop(currentcolumn) - 1 marblebottom(currentcolumn) = marblebottom(currentcolumn) - 1 Shape1(marblebottom(currentcolumn) + 1).Visible = False Shape1(marbletop(currentcolumn)).Visible = True For x = marbletop(currentcolumn) To marblebottom(currentcolumn) Shape1(x).FillColor = Shape1(x + 1).FillColor Next x End If 'test for two marbles on either side If currentcolumn <= 4 And currentcolumn > 1 Then If Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) - 9).FillColor And Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) - 18).FillColor Then MsgBox "YES" Shape1(marbletop(currentcolumn)).Visible = False marbletop(currentcolumn) = marbletop(currentcolumn) + 1 For x = marbletop(currentcolumn) To marblemiddle(currentcolumn) Shape1(x).FillColor = Shape1(x - 1).FillColor Next x Shape1(marbletop(currentcolumn - 1)).Visible = False marbletop(currentcolumn - 1) = marbletop(currentcolumn - 1) + 1 For x = marbletop(currentcolumn - 1) To marblemiddle(currentcolumn - 1) Shape1(x).FillColor = Shape1(x - 1).FillColor Next x Shape1(marbletop(currentcolumn - 2)).Visible = False marbletop(currentcolumn - 2) = marbletop(currentcolumn - 2) + 1 For x = marbletop(currentcolumn - 2) To marblemiddle(currentcolumn - 2) Shape1(x).FillColor = Shape1(x - 1).FillColor Next x End If End If If currentcolumn >= 0 And currentcolumn < 3 Then If Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) + 9).FillColor And Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) + 18).FillColor Then MsgBox "YES" Shape1(marbletop(currentcolumn)).Visible = False marbletop(currentcolumn) = marbletop(currentcolumn) + 1 For x = marbletop(currentcolumn) To marblemiddle(currentcolumn) Shape1(x).FillColor = Shape1(x - 1).FillColor Next x Shape1(marbletop(currentcolumn + 1)).Visible = False marbletop(currentcolumn + 1) = marbletop(currentcolumn + 1) + 1 For x = marbletop(currentcolumn + 1) To marblemiddle(currentcolumn + 1) Shape1(x).FillColor = Shape1(x - 1).FillColor Next x Shape1(marbletop(currentcolumn + 2)).Visible = False marbletop(currentcolumn + 2) = marbletop(currentcolumn + 2) + 1 For x = marbletop(currentcolumn + 2) To marblemiddle(currentcolumn + 2) Shape1(x).FillColor = Shape1(x - 1).FillColor Next x End If End If 'test for one marble on each side If currentcolumn > 0 And currentcolumn < 4 Then If Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) + 9).FillColor And Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) - 9).FillColor Then MsgBox "YES" End If End If End Sub Private Sub cmd_down_Click() If marblebottom(currentcolumn) = boardbottom(currentcolumn) Then MsgBox "Can't Move Down" Else marbletop(currentcolumn) = marbletop(currentcolumn) + 1 marblebottom(currentcolumn) = marblebottom(currentcolumn) + 1 Shape1(marbletop(currentcolumn) - 1).Visible = False Shape1(marblebottom(currentcolumn)).Visible = True For x = marblebottom(currentcolumn) To marbletop(currentcolumn) Step -1 Shape1(x).FillColor = Shape1(x - 1).FillColor Next x End If 'test for two marbles on either side If currentcolumn <= 4 And currentcolumn > 1 Then If Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) - 9).FillColor And Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) - 18).FillColor Then MsgBox "YES" End If End If If currentcolumn >= 0 And currentcolumn < 3 Then If Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) + 9).FillColor And Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) + 18).FillColor Then MsgBox "YES" End If End If 'test for one marble on each side If currentcolumn > 0 And currentcolumn < 4 Then If Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) + 9).FillColor And Shape1(marblemiddle(currentcolumn)).FillColor = Shape1(marblemiddle(currentcolumn) - 9).FillColor Then MsgBox "YES" End If End If End Sub Private Sub Form_Activate() Dim x As Integer x = 0 For Column = 0 To 4 marbletop(Column) = 2 + x boardtop(Column) = 0 + x marblebottom(Column) = 6 + x boardbottom(Column) = 8 + x marblemiddle(Column) = 4 + x x = x + 9 Next Column For x = 2 To 6 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 11 To 15 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 20 To 24 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 29 To 33 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 38 To 42 Shape1(x).FillColor = QBColor(Rnd * 5) Next x End Sub Private Sub Label1_Click(Index As Integer) currentcolumn = Index End Sub Private Sub mnu_new_game_Click() For Column = 0 To 4 marbletop(Column) = 2 + x boardtop(Column) = 0 + x marblebottom(Column) = 6 + x boardbottom(Column) = 8 + x marblemiddle(Column) = 4 + x x = x + 9 Next Column For Column = 0 To 4 Shape1(marbletop(Column) - 1).Visible = False Shape1(boardtop(Column)).Visible = False Shape1(marblebottom(Column) + 1).Visible = False Shape1(boardbottom(Column)).Visible = False Shape1(marbletop(Column)).Visible = True Shape1(marbletop(Column) + 1).Visible = True Shape1(marblebottom(Column)).Visible = True Shape1(marblebottom(Column) - 1).Visible = True Next Column For x = 2 To 6 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 11 To 15 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 20 To 24 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 29 To 33 Shape1(x).FillColor = QBColor(Rnd * 5) Next x For x = 38 To 42 Shape1(x).FillColor = QBColor(Rnd * 5) Next x End Sub Private Sub mnu_exit_Click() End End Sub