1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
|
'Morpion
Option Explicit
Dim finpartie As Boolean
' Variable pour indiquer la fin de la partie
Dim tourjoueur As Integer
' Donne le tour au joueur (0 pour le joueur 1, 1 pour le joueur 2)
Dim nbcouptotal As Integer
' Nombre total de coups joués
Dim Tabposs(8, 1) As Integer
' Tableau des coups joués par joueur
Dim poss(8) As Long
' Tableau des solutions possibles
Private Sub cmd_new_Click()
' Début d'une nouvelle partie
' Déclarer les variables
Dim i As Integer
Dim rsTB As String
Dim picTB As Object
' Initialiser les variables
nbcouptotal = 0
finpartie = False
tourjoueur = 0
For i = 1 To 8
Tabposs(i, 0) = 0
Tabposs(i, 1) = 0
Next i
' Efface le terrain de jeu
For i = 1 To 9
picTab(i).Enabled = True
picTab(i).Picture = Nothing
Next i
lblComment.Caption = ""
' On ne peut plus changer le nom des joueurs
txtJoueur1.Enabled = False
txtJoueur2.Enabled = False
' On demande qui commence
If MsgBox("Voulez-vous que " & txtJoueur1.Text & " commence la partie ?", vbQuestion + vbYesNo, "Choix du joueur") <> vbYes Then
' Si c'est le joueur 2, on échange les propriétés
rsTB = txtJoueur1.Text
Set picTB = picJoueur1.Picture
txtJoueur1.Text = txtJoueur2.Text
picJoueur1.Picture = picJoueur2.Picture
txtJoueur2.Text = rsTB
picJoueur2.Picture = picTB
End If
End Sub
Private Sub cmd_quit_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
'Tableau des huit possibilités pour gagner la partie
poss(1) = 132
poss(2) = 465
poss(3) = 798
poss(4) = 174
poss(5) = 285
poss(6) = 396
poss(7) = 375
poss(8) = 195
End Sub
Private Sub mnuNouvellePartie_Click()
' Début d'une nouvelle partie
Dim i As Integer
Dim rsTB As String
Dim picTB As Object
' Déclarer les variables
nbcouptotal = 0
finpartie = False
tourjoueur = 0
For i = 1 To 8
Tabposs(i, 0) = 0
Tabposs(i, 1) = 0
' Initialiser les variables
Next i
' Efface le terrain de jeu
For i = 1 To 9
picTab(i).Enabled = True
picTab(i).Picture = Nothing
Next i
lblComment.Caption = ""
' On ne peut plus changer le nom des joueurs
txtJoueur1.Enabled = False
txtJoueur2.Enabled = False
' On demande qui commence
If MsgBox("Voulez-vous que " & txtJoueur1.Text & " commence la partie ?", vbQuestion + vbYesNo, "Choix du joueur") <> vbYes Then
' Si c'est le joueur 2, on échange les propriétés
rsTB = txtJoueur1.Text
Set picTB = picJoueur1.Picture
txtJoueur1.Text = txtJoueur2.Text
picJoueur1.Picture = picJoueur2.Picture
txtJoueur2.Text = rsTB
picJoueur2.Picture = picTB
End If
End Sub
Private Sub mnuQuitter_Click()
' Quitte le jeu
Unload Me
End
End Sub
Private Sub picTab_Click(Index As Integer)
Dim i As Integer
' Si la case courante n'a pas d'image,elle n'a pas encore été joué
If picTab(Index).Picture = 0 Then
' En fonction de son index, on remplit le tableau des solutions du joueur.
Select Case Index
Case 1
finpartie = Not (RemplirTabposs(1) And RemplirTabposs(4) And RemplirTabposs(8))
Case 2
finpartie = Not (RemplirTabposs(1) And RemplirTabposs(5))
Case 3
finpartie = Not (RemplirTabposs(1) And RemplirTabposs(6) And RemplirTabposs(7))
Case 4
finpartie = Not (RemplirTabposs(2) And RemplirTabposs(4))
Case 5
finpartie = Not (RemplirTabposs(2) And RemplirTabposs(5) And RemplirTabposs(7) And RemplirTabposs(8))
Case 6
finpartie = Not (RemplirTabposs(2) And RemplirTabposs(6))
Case 7
finpartie = Not (RemplirTabposs(3) And RemplirTabposs(4) And RemplirTabposs(7))
Case 8
finpartie = Not (RemplirTabposs(3) And RemplirTabposs(5))
Case 9
finpartie = Not (RemplirTabposs(3) And RemplirTabposs(6) And RemplirTabposs(8))
End Select
' En fonction du joueur qui joue,on va placer son symbole dans la case cochée
If tourjoueur = 0 Then
picTab(Index).Picture = picJoueur1.Picture
Else
picTab(Index).Picture = picJoueur2.Picture
End If
' inverse les joueurs qui jouent, si tourjoueur=0 alors tourjoueur devient 1, sinon devient 0
tourjoueur = (1 - tourjoueur)
' On augmente le nombre de tours joués
nbcouptotal = nbcouptotal + 1
' C'est la fin de la partie, si un joueur a gagné ou si toute les cases sont cochées
If finpartie Or nbcouptotal = 9 Then
' Si on a fait 9 coups sans que la partie soit réellement finie, c'est alors un match nul
If (nbcouptotal = 9) And Not finpartie Then lblComment.Caption = "La partie est terminée, pas de gagnant : Match Nul"
' Ensuite, on vérouille les cases
For i = 1 To 9
picTab(i).Enabled = False
Next i
End If
End If
End Sub
Public Sub JoueSolution(Solution As Integer)
Dim a As Integer, b As Integer, c As Integer
' On extrait les index des différentes cases qui compose la solution trouvée
a = poss(Solution) \ 100 ' première case
b = (poss(Solution) - (a * 100)) \ 10 ' deuxième case
c = (poss(Solution) - (a * 100) - (b * 10)) 'dernière case
' Si la première case n'a pas été cochée,
If picTab(a).Picture = 0 Then
' on s'en occupe,
Call picTab_Click(a)
' sinon, on cherche à cocher la seconde
ElseIf picTab(b).Picture = 0 Then
Call picTab_Click(b)
' en enfin la troisième.
ElseIf picTab(c).Picture = 0 Then
Call picTab_Click(c)
End If
End Sub
Public Function RemplirTabposs(Solution As Integer) As Boolean
Dim l_score As Integer
l_score = 0
' Fonction qui remplit le tableau des solutions d'un joueur et indique si celui-ci a gagné
If Tabposs(Solution, tourjoueur) = 2 Then
' Si la valeur du tableau est déjà à 2, fin de la partie.
' Le joueur à qui s'était le tour est vainqueur
If (nbcouptotal = 1) Then
lblComment.Caption = "Gagné ! " & txtJoueur1.Text & " vainqueur..."
l_score = l_score + 1
Else
lblComment.Caption = "Gagné ! " & txtJoueur2.Text & " vainqueur..."
End If
' Indique que l'on a pas remplit le tableau, car nous avons un gagnant
RemplirTabposs = False
Else
Tabposs(Solution, tourjoueur) = Tabposs(Solution, tourjoueur) + 1
' C'est pas encore gagné, on augmente la valeur du tableau
RemplirTabposs = True
' on a remplit le tableau
End If
End Function |
Partager