Démineur récursif en Visual Basic

VERSION 5.00
Begin VB.Form frMines 
   BorderStyle     =   1  'Fixed Single
   Caption         =   ""
   ClientHeight    =   2775
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   2295
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   185
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   153
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox edtRemaining 
      Alignment       =   2  'Center
      BackColor       =   &H00C0FFFF&
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      ForeColor       =   &H00004080&
      Height          =   375
      Left            =   120
      TabIndex        =   26
      Text            =   "20"
      Top             =   120
      Width           =   975
   End 
   Begin VB.CommandButton butReset 
      Caption         =   "&Rejouer"
      Height          =   375
      Left            =   1200
      TabIndex        =   25
      Top             =   120
      Width           =   975
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   24
      Left            =   1680
      TabIndex        =   24
      Top             =   2160
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   23
      Left            =   1320
      TabIndex        =   23
      Top             =   2160
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   22
      Left            =   960
      TabIndex        =   22
      Top             =   2160
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   21
      Left            =   600
      TabIndex        =   21
      Top             =   2160
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   20
      Left            =   240
      TabIndex        =   20
      Top             =   2160
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   19
      Left            =   1680
      TabIndex        =   19
      Top             =   1800
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   18
      Left            =   1320
      TabIndex        =   18
      Top             =   1800
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   17
      Left            =   960
      TabIndex        =   17
      Top             =   1800
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   16
      Left            =   600
      TabIndex        =   16
      Top             =   1800
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   15
      Left            =   240
      TabIndex        =   15
      Top             =   1800
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   14
      Left            =   1680
      TabIndex        =   14
      Top             =   1440
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   13
      Left            =   1320
      TabIndex        =   13
      Top             =   1440
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   12
      Left            =   960
      TabIndex        =   12
      Top             =   1440
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   11
      Left            =   600
      TabIndex        =   11
      Top             =   1440
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   10
      Left            =   240
      TabIndex        =   10
      Top             =   1440
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   9
      Left            =   1680
      TabIndex        =   9
      Top             =   1080
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   8
      Left            =   1320
      TabIndex        =   8
      Top             =   1080
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   7
      Left            =   960
      TabIndex        =   7
      Top             =   1080
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   6
      Left            =   600
      TabIndex        =   6
      Top             =   1080
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   5
      Left            =   240
      TabIndex        =   5
      Top             =   1080
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   4
      Left            =   1680
      TabIndex        =   4
      Top             =   720
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   3
      Left            =   1320
      TabIndex        =   3
      Top             =   720
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   2
      Left            =   960
      TabIndex        =   2
      Top             =   720
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   1
      Left            =   600
      TabIndex        =   1
      Top             =   720
      Width           =   375
   End 
   Begin VB.Label Mine 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "*"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      End Property
      Height          =   375
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Width           =   375
   End 
   Begin VB.Shape Shape1 
      Height          =   2055
      Left            =   120
      Top             =   600
      Width           =   2055
   End 
End
Attribute VB_Name = "frMines"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Const MS_SIZE = 5
Const MS_COUNT = MS_SIZE * MS_SIZE
Const MS_NUMMINES = 5

Dim XY(1 To 2) As Integer
Dim MS_BUFFER(0 To MS_COUNT - 1) As Boolean
Dim MS_REMAINING As Integer
Dim CanClick As Boolean

'==========================================================
'   La procédure suivante remet à zéro le jeu pour pouvoir commencer à jouer
'==========================================================

    Private Sub ResetGame()
        Dim X As Integer
        Dim p As Integer
    
        'On initialise les variables en mémoire
        CanClick = True
        MS_REMAINING = MS_COUNT
        edtRemaining.Text = MS_REMAINING
        For X = 0 To MS_COUNT - 1
            Mine(X).Caption = ""
            Mine(X).BorderStyle = 1
            Mine(X).BackColor = &H8000000F
            MS_BUFFER(X) = False
        Next

        'On génère la position des Mines
        X = 0
        While X <> MS_NUMMINES
            p = Int(MS_COUNT * Rnd())       'résultat entre 0 et MS_COUNT-1
            If MS_BUFFER(p) = False Then
                MS_BUFFER(p) = True
                X = X + 1
            End If
        Wend
    End Sub

'==========================================================
'   Dit si une coordonnée entre dans les limites du plateau de jeu
'==========================================================

    Private Function GoodXY(X As Integer, Y As Integer) As Boolean
        GoodXY = (X >= 1) And (X <= MS_SIZE) And (Y >= 1) And (Y <= MS_SIZE)
    End Function

'==========================================================
'   Dit si une case a été jouée ou pas
'==========================================================

    Private Function Targetable(X As Integer, Y As Integer) As Boolean
        Targetable = False
        If GoodXY(X, Y) Then Targetable = (Mine(XYToIndex(X, Y)).BorderStyle = 1)
    End Function

'==========================================================
'   Transforme un Index de case en coordonnées
'==========================================================
    
    Private Sub IndexToXY(Index As Integer)
        XY(1) = Index Mod MS_SIZE + 1
        XY(2) = Int(Index / MS_SIZE) + 1
    End Sub
    
'==========================================================
'   Transforme des coordonnées en un Index de case
'==========================================================
    
    Private Function XYToIndex(X As Integer, Y As Integer) As Integer
        XYToIndex = MS_SIZE * (Y - 1) + (X - 1)
    End Function

'==========================================================
'   Renvoie 1 s'il y a une mine en (X,Y), sinon 0
'==========================================================

    Private Function HasMineXY(X As Integer, Y As Integer) As Byte
        HasMineXY = 0
        If GoodXY(X, Y) Then
            'Surtout pas de structure en AND, car l'évaluation booléenne est ici complète
            'Il faut vérifier X et Y d'abord
            If MS_BUFFER(XYToIndex(X, Y)) Then HasMineXY = 1
        End If
    End Function

'==========================================================
'   Calcule le nombre de mines autour de la case
'==========================================================

    Private Function GetMinesAround(Index As Integer) As Integer
        Dim Result As Integer
        Dim X As Integer
        Dim Y As Integer
        Result = 0

        IndexToXY (Index)
        X = XY(1)
        Y = XY(2)
        
        GetMinesAround = HasMineXY(X - 1, Y - 1) + HasMineXY(X, Y - 1) + HasMineXY(X + 1, Y - 1) + _
                         HasMineXY(X - 1, Y) + HasMineXY(X + 1, Y) + _
                         HasMineXY(X - 1, Y + 1) + HasMineXY(X, Y + 1) + HasMineXY(X + 1, Y + 1)
    End Function

'==========================================================
'   A-t-on gagné ?
'==========================================================

    Private Function HasWon() As Boolean
        Dim i As Byte
        HasWon = True
        For i = 0 To MS_COUNT - 1
            If (Mine(i).BorderStyle = 1) And (MS_BUFFER(i) = False) Then HasWon = False
        Next
    End Function

'==========================================================
'   Remise à zéro de la partie
'==========================================================

Private Sub butReset_Click()
    ResetGame
End Sub

'==========================================================
'   Au chargement de l'application
'==========================================================

Private Sub Form_Load()
    Randomize
    ResetGame
End Sub

'==========================================================
'   Gestion des mines
'==========================================================

    Private Sub Propagate(X As Integer, Y As Integer)
        If GoodXY(X, Y) And Targetable(X, Y) Then Call Mine_MouseDown(XYToIndex(X, Y), 1, 0, 0, 0)
    End Sub

Private Sub Mine_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'On quitte si le bouton a déjà été joué
    If Not CanClick Or Mine(Index).BorderStyle = 0 Then
        Exit Sub
    End If

    'Déclaration des variables
    Dim num_mines As Integer
    Dim i As Byte
    Dim CoorX As Integer
    Dim CoorY As Integer
    IndexToXY (Index)
    CoorX = XY(1)
    CoorY = XY(2)

    'Gestion du bouton droit
    If Button = 2 Then
        If Mine(Index).BorderStyle = 1 Then
            If Mine(Index).Caption = "?" Then
                Mine(Index).Caption = ""
                Mine(Index).BackColor = &H8000000F
                MS_REMAINING = MS_REMAINING + 1
            Else
                Mine(Index).Caption = "?"
                Mine(Index).BackColor = &H80C0FF
                MS_REMAINING = MS_REMAINING - 1
            End If
            edtRemaining.Text = MS_REMAINING
        End If
        Exit Sub
    End If

    'Gestion du bouton gauche
    If HasMineXY(CoorX, CoorY) = 1 Then

        'Si on commence la partie en tombant sur une mine, on relance la partie
        '(parce que c'est frustrant, et le démineur original fait pareil [sans le dire])
        If MS_REMAINING = MS_COUNT Then
            Beep
            ResetGame
            Exit Sub
        End If

        For i = 0 To MS_COUNT - 1
            If MS_BUFFER(i) Then Mine(i).BackColor = &HFF&
        Next
        Beep
        CanClick = False
        Exit Sub
    End If
    
    num_mines = GetMinesAround(Index)
    If num_mines <> 0 Then Mine(Index).Caption = num_mines
    Mine(Index).BorderStyle = 0
    Mine(Index).BackColor = &H8000000F
    MS_REMAINING = MS_REMAINING - 1
    edtRemaining.Text = MS_REMAINING

    'Propagation récursive des mines vides
    If num_mines = 0 Then
        Propagate CoorX - 1, CoorY - 1
        Propagate CoorX, CoorY - 1
        Propagate CoorX + 1, CoorY - 1
        
        Propagate CoorX - 1, CoorY
        Propagate CoorX + 1, CoorY
        
        Propagate CoorX - 1, CoorY + 1
        Propagate CoorX, CoorY + 1
        Propagate CoorX + 1, CoorY + 1
    End If
    
    'Et si on a gagné ?
    If HasWon Then
        MsgBox "Vous avez gagné"
        ResetGame
    End If
End Sub