Public feed #377690

Untitled

public text v1 · immutable
Raw Edit
·published 2007-03-01 22:56 UTC
rendered paste body
Dim mines(0 To 10, 0 To 10) As Integer
Dim cols As Integer
Dim rows As Integer
Dim square As Integer
Dim X, Y As Integer
Dim nums(0 To 10, 0 To 10) As Boolean
Dim clicked(0 To 99) As Integer
Dim sindex As Integer
Dim g As Integer
Dim startflag As Integer
Dim tried(0 To 10, 0 To 10) As Boolean


Private Function load_squares(dimen As Integer)
squares(0).Visible = True
lsquares(0).Visible = True
squares(0).BackColor = &H8000000F
For i = 1 To ((X * Y) - 1)
    Load squares(i)
    Load lsquares(i)
    If (i / 10) = Int(i / 10) Then
    
    squares(i).Left = squares(0).Left
    squares(i).Top = squares(i - 3).Top + 375
    squares(i).Visible = True
    lsquares(i).Left = squares(0).Left
    lsquares(i).Top = squares(i - 3).Top + 375
    lsquares(i).Visible = True
    ElseIf (i / 10) <> Int(i / 10) Then
    lsquares(i).Top = squares(i - 1).Top
    lsquares(i).Left = squares(i - 1).Left + squares(i - 1).Width
    lsquares(i).Visible = True
    squares(i).Top = squares(i - 1).Top
    squares(i).Left = squares(i - 1).Left + squares(i - 1).Width
    squares(i).Visible = True
    
    End If
nums(Int(i / 10), (i - (10 * Int(i / 10)))) = False
Next i
End Function



Private Sub load_mines()

i = 0
While i <= 9
Randomize
row = Int(Rnd * 9)
col = Int(Rnd * 9)

If nums(row, col) = False Then
nums(row, col) = True
i = i + 1
End If

Wend
Call show_mines
End Sub

Private Sub show_mines()
Picture2.Cls
For i = 0 To 99
pos = nums(Int(i / 10), (i - (10 * Int(i / 10))))
If pos = True Then
squares(Int(i / 10) * 10 + (i - (10 * Int(i / 10)))).BackColor = vbGrey

'Picture2.Print (Int(i / 10)); " x "; (i - (10 * Int(i / 10)))
End If
Next i
End Sub
Private Sub Form_Load()
X = 10
Y = 10
End Sub
Private Sub squares_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
g = 1
End Sub

Private Sub squares_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If g = 1 Then
Dim row, col As Integer



Picture1.Cls
Picture1.Print Index
Picture1.Print Button
Picture1.Print (Int(Index / 10)); " x "; (Index - (10 * Int(Index / 10)))
pos = nums(Int(Index / 10), (Index - (10 * Int(Index / 10))))
'If pos = True And Button = 1 Then
'squares(Index).BackColor = vbRed
'ElseIf pos = True And Button = 2 Then
'squares(Index).BackColor = vbBlue
'End If
row = Int(Index / 10)
col = (Index - (10 * Int(Index / 10)))
sindex = Index

Select Case pos
    Case True
        Select Case Button
            Case 1
                'show all mines
                If clicked(Index) = True Then
                Exit Sub
                End If
                squares(Index).BackColor = vbRed
                Call you_lose
                
                'End
                
            Case 2
                squares(Index).BackColor = vbBlue
                flags = flags + 1
        End Select
    Case False
        Select Case Button
            Case 1
            If nums(Int(Index / 10), (Index - (10 * Int(Index / 10)))) = True Then
            Call you_lose
            ElseIf nums(Int(Index / 10), (Index - (10 * Int(Index / 10)))) = False Then
                squares(Index).Visible = False
                    Call examine_around(row, col)
            End If
            
            Case 2
                'incorrectly flag shit
                squares(Index).BackColor = vbBlue
                flags = flags + 1
        End Select
    End Select
gfocus.SetFocus
g = 0
End If

End Sub


Private Sub examine_around(ByVal row As Integer, ByVal col As Integer)
rl = row - 1
rh = row + 1
cl = col - 1
ch = col + 1

If rl < 0 Then rl = 0
If rh = 10 Then rh = 9
If cl < 0 Then cl = 0
If ch = 10 Then ch = 9


For i = rl To rh
        For j = cl To ch
                If nums(i, j) = True And tried(i, j) = False Then
                    mcount = mcount + 1
                    tried(i, j) = True
                ElseIf nums(i, j) = False And tried(i, j) = False And Val(lsquares((i * 10) + j).Caption) <> 0 Then
                    tried(i, j) = True
                    Call examine_around(i, j)
                End If
        Next j
Next i
Picture2.Print mcount
squares((row) * 10 + col).Visible = False
lsquares((row) * 10 + col).Caption = mcount

End Sub
Private Sub Delay(Interval As Single)
startingtime = Timer
Do While Timer < startingtime + Interval
DoEvents
Loop
End Sub
Private Sub start_Click()
If startflag = 0 Then
load_squares (10)
Call load_mines
startflag = 1
Else
menuerror.Caption = "Board already loaded!"
Delay (2)
menuerror.Caption = " "
End If
End Sub
Private Sub reset_all()
i = 99
While i > 0
Unload squares(i)
Unload lsquares(i)
i = i - 1
Wend
lsquares(0).Visible = False
squares(0).Visible = False

End Sub
Private Sub you_lose()
MsgBox "YOU LOSE"
For i = 0 To 99
If nums(Int(i / 10), (i - (10 * Int(i / 10)))) <> True Then
squares(i).Visible = False
lsquares(i).Caption = ""
Else
squares(i).Enabled = False
squares(i).BackColor = vbRed
startflag = 0
End If
Next i
Delay (3)
Call reset_all

End Sub