... Tu me manques :'(
.. @gmail.com
Bombes (P)03/2010 MyLzz59: le Code Source Complet
(à coller dans la zone de code de la première feuille)
' -----------------
' Zone Déclarations
' -----------------
Const Tit = "Bombes (P)03/2010 MyLzz59"
Const Ym = 30, Xm = 40, Nb = 100, Xt = 2, Xb = 18, Xc = 28, Xr = 32
'Dim P() As Integer
' ------------------
' EVT: Teste la Zone
' ------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Y = Target.Row: X = Target.Column: Cancel = True
If Y = Ym + 2 And X = Xr Then
If MsgBox("Réinitialiser l'Aire de Jeu ?", _
vbQuestion + vbYesNo + vbDefaultButton2, Tit) = vbYes Then Remplis
Exit Sub
End If
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Then Exit Sub
Prot False: Pop Y, X: TesteGagne: Prot True
End Sub
' ------------
' EVT: Drapeau
' ------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Y = Target.Row: X = Target.Column: If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Then Exit Sub
Select Case Target.Text
Case "": T = 10: T2 = -1: GoSub SS1
Case "O": T = 11: T2 = 1: GoSub SS1
End Select
Cancel = True: Exit Sub
SS1: Prot False: Colorie Y, X, 1 * T: Cells(Ym + 2, Xb) = Cells(Ym + 2, Xb) + T2
If PP(Y, X) = 9 Then Cells(Ym + 6, Xb) = Cells(Ym + 6, Xb) + T2
Cells(Ym + 2, Xc) = Cells(Ym + 2, Xc) + T2: TesteGagne: Prot True: Return
End Sub
' -----------------------
' Crée un Nouveau Terrain
' -----------------------
Sub Remplis()
Randomize Timer
'ReDim P(1 To Ym, 1 To Xm)
Prot False
Cells(Ym + 5, 1).Value = "Z" + String$(Xm * Ym, "0")
Range(Cells(1, 1), Cells(Ym, Xm)).Interior.ColorIndex = 15
Range(Cells(1, 1), Cells(Ym, Xm)).ClearContents ' Nettoyage
For T = 1 To Nb
'Do: Y = Int(Rnd * Ym) + 1: X = Int(Rnd * Xm) + 1: Loop While P(Y, X) = 9 ' Bombes
Do: Y = Int(Rnd * Ym) + 1: X = Int(Rnd * Xm) + 1: Loop While PP(Y, X) = 9 ' Bombes
For Y2 = Y - 1 To Y + 1: For X2 = X - 1 To X + 1
If X2 >= 1 And X2 <= Xm And Y2 >= 1 And Y2 <= Ym Then
If X2 <> X Or Y2 <> Y Then
'If P(Y2, X2) < 9 Then P(Y2, X2) = P(Y2, X2) + 1 ' Incrément autour
If PP(Y2, X2) < 9 Then PP(Y2, X2) = PP(Y2, X2) + 1 ' Incrément autour
Else
'P(Y, X) = 9 ' Place Bombe
PP(Y, X) = 9 ' Place Bombe
End If
End If
Next X2, Y2
Next T
Cells(Ym + 2, Xt).Value = Tit: Cells(Ym + 2, Xb).Value = Nb
Cells(Ym + 2, Xc).Value = Xm * Ym: Cells(Ym + 6, Xb).Value = Nb 'Marquages
Prot True: MsgBox "Bonne Chance ;)", vbInformation, Tit
End Sub
' ----------------------------------
' SUB: Découvrir une Case (Récursif)
' ----------------------------------
Sub Pop(ByVal Y As Integer, ByVal X As Integer)
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Then Exit Sub
If Cells(Y, X).Text <> "" Then Exit Sub
'Colorie Y, X, P(Y, X): Cells(Ym + 2, Xc) = Cells(Ym + 2, Xc) - 1
Colorie Y, X, PP(Y, X): Cells(Ym + 2, Xc) = Cells(Ym + 2, Xc) - 1
'Select Case P(Y, X)
Select Case PP(Y, X)
Case 9 ' Bombe
' --
For Y = 1 To Ym: For X = 1 To Xm
'If Cells(Y, X).Text = "" _
or Cells(Y, X).Text = "O" Then Colorie Y, X, P(Y, X)
If Cells(Y, X).Text = "" _
Or Cells(Y, X).Text = "O" Then Colorie Y, X, PP(Y, X)
If Cells(Y, X).Text = "0" Then Colorie Y, X, 13
Next X, Y
MsgBox "<<<< BOOM >>>>" + vbCrLf + vbCrLf + "Vous avez perdu.. :(", vbCritical, Tit
' --
Case 1 To 8 ' Découvrir
Case 0 ' Découvrir en Récursif
For Y2 = Y - 1 To Y + 1: For X2 = X - 1 To X + 1
If X2 >= 1 And X2 <= Xm And Y2 >= 1 And Y2 <= Ym Then
If Cells(Y2, X2).Text = "" Then Pop Y2, X2
End If
Next X2, Y2
End Select
End Sub
' --------------
' Sub TesteGagne
' --------------
Sub TesteGagne()
If Cells(Ym + 2, Xb).Value = Cells(Ym + 2, Xc).Value Or _
(Cells(Ym + 2, Xb).Value = 0 And Cells(Ym + 6, Xb).Value = 0) Then
For Y = 1 To Ym: For X = 1 To Xm
'If Cells(Y, X).Text = "" _
or Cells(Y, X).Text = "O" Then Colorie Y, X, P(Y, X)
If Cells(Y, X).Text = "" _
Or Cells(Y, X).Text = "O" Then Colorie Y, X, PP(Y, X)
If Cells(Y, X).Text = "0" Then Colorie Y, X, 12
Next X, Y
MsgBox "<<<< BRAVO >>>>" + vbCrLf + vbCrLf + "Vous avez gagné.. :)", vbInformation, Tit
End If
End Sub
' -----------------------------------------------------------------------------
' Sub: Colorie la Case (Y,X) en Fonction du Nombre de Bombes (ou autre..)
' ( N=0..8 ; N=9:Bombe ; N=10:Drapeau ; N=11:Cachée ; N=12:Gagné ; N=13:Perdu )
' -----------------------------------------------------------------------------
Sub Colorie(ByVal Y As Integer, ByVal X As Integer, ByRef N As Integer)
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Or N < 0 Or N > 13 Then Exit Sub
With Cells(Y, X)
.Interior.ColorIndex = IIf(N = 13, 30, IIf(N = 12, 10, _
IIf(N = 11, 15, IIf(N = 10, 19, IIf(N = 9, 3, IIf(N, 17, 16))))))
.Font.ColorIndex = IIf(N = 13, 30, IIf(N = 12, 10, _
IIf(N = 11, 11, IIf(N = 10, 11, IIf(N = 9, 1, IIf(N, 8, 16))))))
.Font.Name = IIf(N > 8 And N < 11, "Wingdings", "Comic Sans")
.Value = IIf(N > 11, "0", IIf(N = 11, "", IIf(N = 10, "O", IIf(N = 9, "M", CStr(N)))))
End With
End Sub
' -------------------
' SUB: Protéger (O/N)
' -------------------
Sub Prot(B As Boolean)
If B Then Sheets(1).Protect "" Else Sheets(1).Unprotect ""
End Sub
' ---------------------------------------------------------------------
' Property Let: simule l'Ecriture de N [Integer] dans PP(Y,X) [Integer]
' ---------------------------------------------------------------------
Property Let PP(ByVal Y As Integer, ByVal X As Integer, ByRef N As Integer)
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Or N < 0 Or N > 9 Then Exit Property
Z$ = Cells(Ym + 5, 1).Value
Mid$(Z$, Xm * (Y - 1) + X + 1, 1) = CStr(N)
Cells(Ym + 5, 1).Value = Z$
End Property
' ---------------------------------------------------------------------
' Property Get: simule la Lecture de N [Integer] dans PP(Y,X) [Integer]
' ---------------------------------------------------------------------
Property Get PP(ByVal Y As Integer, ByVal X As Integer) As Integer
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Or N < 0 Or N > 9 Then PP = -1: Exit Property
PP = Val(Mid$(Cells(Ym + 5, 1).Value, Xm * (Y - 1) + X + 1, 1))
End Property-MyLzz59-