Buscaminas

buscamina.vb

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6615
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9375
   LinkTopic       =   "Form1"
   ScaleHeight     =   441
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   625
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   1080
      TabIndex        =   1
      Top             =   6240
      Width           =   1215
   End
   Begin VB.PictureBox Tablero 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   5700
      Left            =   0
      ScaleHeight     =   380
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   570
      TabIndex        =   0
      Top             =   0
      Width           =   8550
   End
   Begin VB.Image b 
      Height          =   285
      Left            =   120
      Picture         =   "frmPpal.frx":0000
      Top             =   4320
      Width           =   3420
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const nX = 20 ' = 9
Private Const nY = 10 ' = 9
Private Const nMinas = 12

Private Const Medida = 30

Private Enum enTipoMina
   Nada = 0
   numUno
   numDos
   numTres
   numCuatro
   numCinco
   numSeis
   numSiete
   numOcho
   Marcador
   Minado
End Enum

Private Type unaMina
   Visible As Boolean
   Marcado As Boolean
   Tipo As enTipoMina
End Type

Private Enum enCorrida
   Ninguna = 0
   NumeroMinas
   CuadroVacio
   DestaparAlrededor
End Enum

Private Minas(nX, nY) As unaMina

Private Sub Perder()
   'Perder la partida
   MsgBox "Perdiste", vbCritical
   MostrarMinas
   Tablero.Enabled = False
End Sub

Private Sub Jugar()
   'Comenzar la partida
   Dim i As Integer, j As Integer
   For i = 0 To nX
      For j = 0 To nY
         With Minas(i, j)
            .Tipo = Ninguna
            .Marcado = False
            .Visible = False
         End With
      Next j
   Next i
   Tablero.Enabled = True
   PrepararTablero
   PintarTablero
End Sub

Private Sub MostrarMinas()
   'Mostrar todas las minas en pantalla
   Dim i As Integer, j As Integer
   For i = 0 To nX
      For j = 0 To nY
         If Minas(i, j).Tipo = enTipoMina.Minado Then
            Minas(i, j).Visible = True
            PintarCuadro i, j
         End If
      Next j
   Next i
End Sub

Private Function PrepararPila() As Collection
   'Preparar pila para elementos aleatorios
   Dim i As Integer, j As Integer
   Dim Temporal As New Collection
   For i = 0 To nX
      For j = 0 To nY
         Temporal.Add i & " " & j, i & " " & j
      Next
   Next
   Set PrepararPila = Temporal
End Function

Private Sub PrepararTablero()

   'Preparar matriz de cuadros
   Dim Ran As Integer
   Dim i As Integer, j As Integer
   Dim k As Integer, l As Integer
   Dim Pila As New Collection
   Dim XY() As String
   Dim X, Y As Integer
   Dim X2, Y2 As Integer
   Set Pila = PrepararPila
      
   Randomize Timer
   
   For i = 0 To nMinas - 1
      
      'Crear una Mina Aleatoriamente
      Ran = Rnd * Pila.Count
      If Ran = 0 Then Ran = 1
      XY() = Split(Pila(Ran), " ")
      X = Val(XY(0)): Y = Val(XY(1))
      Minas(X, Y).Tipo = enTipoMina.Minado
      Pila.Remove Ran
      
      'Darle valor a los alrededores
      DesencadenarCuadros X, Y, NumeroMinas
      
   Next i
   
End Sub

Private Sub PintarCuadro(ByVal X As Integer, ByVal Y As Integer)
   'Pintar cuadro especificado
   Tablero.PaintPicture _
      b.Picture, X * Medida, Y * Medida, Medida, Medida _
      , IIf(Minas(X, Y).Visible, Minas(X, Y).Tipo, IIf(Minas(X, Y).Marcado, 9, 11)) * 19 _
      , 0, 19, 19
End Sub

Private Sub DestaparCuadro(ByVal X As Integer, ByVal Y As Integer)
If Not Minas(X, Y).Visible And Minas(X, Y).Marcado = False Then

   Minas(X, Y).Visible = True
   PintarCuadro X, Y
   
   If Minas(X, Y).Tipo = enTipoMina.Minado Then
      Perder
      Exit Sub
   End If
   
   If Minas(X, Y).Tipo = enTipoMina.Nada Then
      DesencadenarCuadros X, Y, CuadroVacio
   End If
   
End If
End Sub

Private Sub DesencadenarCuadros(ByVal X As Integer, ByVal Y As Integer, Optional ByVal tipoCorrida As enCorrida = enCorrida.Ninguna)
   Dim i As Integer, j As Integer
   Dim X2, Y2 As Integer
   
   For i = -1 To 1
      For j = -1 To 1
         If Not (i = 0 And j = 0) Then
            X2 = X + i
            Y2 = Y + j
            
            If X2 > -1 And X2 <= nX And Y2 > -1 And Y2 <= nY Then
               Select Case tipoCorrida
            
                  'Colocar el numero de minas alrededor de la mina
                  Case enCorrida.NumeroMinas
                        If Not Minas(X2, Y2).Tipo = enTipoMina.Minado Then
                           Minas(X2, Y2).Tipo = Minas(X2, Y2).Tipo + 1
                        End If
               
                  'Se destapa uno y se van en cadena
                  Case enCorrida.CuadroVacio
                        If Minas(X2, Y2).Tipo = enTipoMina.Nada Or _
                        (Minas(X2, Y2).Tipo > 0 And Minas(X2, Y2).Tipo < 9) And _
                        Minas(X2, Y2).Marcado = False Then
                           DestaparCuadro X2, Y2
                        End If
                  
                  'Se destapan los de alrededor
                  Case enCorrida.DestaparAlrededor
                        If Minas(X2, Y2).Tipo = enTipoMina.Nada Or Minas(X2, Y2).Tipo = enTipoMina.Minado Or _
                        (Minas(X2, Y2).Tipo > 0 And Minas(X2, Y2).Tipo < 9) And _
                        Minas(X2, Y2).Marcado = False Then
                           DestaparCuadro X2, Y2
                        End If
                        
               End Select
            End If
         End If
      Next j
   Next i
End Sub

Private Sub PintarTablero()
   Dim i As Integer, j As Integer
   For i = 0 To nX
      For j = 0 To nY
         PintarCuadro i, j
      Next
   Next
End Sub

Private Sub Command1_Click()
   Jugar
End Sub

Private Sub Form_Load()
   Tablero.Move 0, 0, nX * Medida + Medida, nY * Medida + Medida
   Jugar
End Sub

Private Sub Tablero_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > -1 And X <= Tablero.ScaleWidth And Y > -1 And Y <= Tablero.ScaleHeight Then
   
   Dim X2 As Integer, Y2 As Integer
   X2 = Fix(X / Medida): Y2 = Fix(Y / Medida)
   If Button = 1 Then
      DestaparCuadro X2, Y2
   ElseIf Button = 2 Then
      Minas(X2, Y2).Marcado = Not Minas(X2, Y2).Marcado
      If Not (Minas(X2, Y2).Marcado) And Minas(X2, Y2).Visible Then
         DesencadenarCuadros X2, Y2, DestaparAlrededor
      End If
      PintarCuadro X2, Y2
   End If
End If
End Sub