Morpion

Soyez le premier à donner votre avis sur cette source.

Vue 2 813 fois - Téléchargée 196 fois

Description

Mon morpion n'est pas totalement fini, mais le mode 2 joueurs fonctionne bien, et les modes solo aussi. J'ai créé une petite intelligence artificielle, rien de bien terrible

Comme j'ai recu des plaintes comme quoi mon ne marchait pas, que j'aurais pu mettre entièrement mes sources............
Je le fais alors!

Il y a certainement pas mal de maladresses, ca fait quelques temps que je ne l'ai pas regardé, mais toutes vos remarques seront acceptées sans probèmes ;o)
bon jeu à tous.

Source / Exemple :


' tableau qui posséde la marque de la case (X ou O) et le nombre de points attribués a partir de la marque
Dim op(9, 1) As String
' tableau qui totalise le nombre de points en fonction des solutions et de la marque de la case
Dim sol(8, 4) As Integer
' tableau contenant toutes les solutions possibles
Dim res(8, 3) As Integer
' variables qui servent a définir le premier O qui sera posé par l'ordinateur
Dim test, jeu, choix, m, r As Integer
' variables qui servent a identifier les utilisateurs en mode 2 joueurs
Dim nom1, nom2 As String

'                       PROGRAMME PRINCIPAL
Private Sub Command1_Click(Index As Integer)
' la variable test est mise a 0 car elle vaut -1 au début du programme
test = test + 1
autre = autre + 1
' condition necessaire pour eviter de jouer une case déja joué
' si la case est vide, on mets X et on rempli le tableau op
If op(Index, 0) = "" Then
    Command1(Index).Caption = "X"
    op(Index, 0) = "X"
    op(Index, 1) = 4
' on teste si le tableau op est n'est pas rempli
    If T = True Then
        While o = 0
' choix sert à connaitre le niveau choisi
            Call IMBATTABLE
' si la case n'est pas prise, on la marque d'un O et on rempli le tableau
            If op(r, 0) = "" Then
                Command1(r).Caption = "O"
                o = 1
                op(r, 0) = "O"
                op(r, 1) = 1
            End If
        Wend
    End If
' on appelle la procedure fin pour déterminer qui a gagné
    Call FIN
End If
End Sub

' fonction qui a pour but de définir si le tableau op est rempli ou non
Private Function T() As Boolean
i = 0
p = 0
' on teste toutes les cases
While i < 8
    If op(i, 0) <> "" Then
        p = p + 1
    End If
    i = i + 1
Wend
' si p=8 alors tout le tableau est plein
If p = 8 Then
    T = False
Else
    T = True
End If
End Function

Private Sub FIN()
' la variable m va définir s'il y a victoire, défaite ou match nul de l'utilisateur
m = 2
pp = 0
For i = 0 To 6 Step 3
    tot = 0
    For j = 0 To 2
        tot = tot + op(i + j, 1)
        If tot = 12 Then
            m = 1
        Else
            If tot = 3 Then
               m = 0
            End If
        End If
    Next j
Next i

For i = 0 To 2
    tot = 0
    For j = 0 To 6 Step 3
        tot = tot + op(i + j, 1)
        If tot = 12 Then
            m = 1
        Else
            If tot = 3 Then
                m = 0
            End If
        End If
    Next j
Next i

i = 0
tot = 0
    For j = 0 To 8 Step 4
        tot = tot + op(j, 1)
        If tot = 12 Then
            m = 1
        Else
            If tot = 3 Then
               m = 0
            End If
        End If
    Next j

i = 2
tot = 0
    For j = 2 To 6 Step 2
        tot = tot + op(j, 1)
        If tot = 12 Then
            m = 1
        Else
            If tot = 3 Then
               m = 0
            End If
        End If
    
    Next j
For u = 0 To 7
    For g = 0 To 2
        If Command1(res(u, 0)).Caption = "X" And Command1(res(u, 1)).Caption = "X" And Command1(res(u, 2)).Caption = "X" Then
            Command1(res(u, g)).BackColor = &H80FF80
            pp = 1
            m = 1
        End If
    Next g
Next u
If pp <> 1 Then
    For u = 0 To 7
        For g = 0 To 2
            If Command1(res(u, 0)).Caption = "O" And Command1(res(u, 1)).Caption = "O" And Command1(res(u, 2)).Caption = "O" Then
                Command1(res(u, g)).BackColor = &H8080FF
            End If
        Next g
    Next u
End If
' si le tableau op est plein et que m n'est pas changé de valeur: match nul
If T = False And m = 2 Then
    MsgBox ("Match nul")
    For p = 2 To 3
        Text1(p).Text = Text1(p).Text + 1
    Next p
    Call REJ_Click
End If
' si m=1 alors la somme de la ligne (X) vaut 12
If m = 1 Then
    If HVSH.Checked = True Then
        MsgBox (nom1 & " a gagné(e)!")
    Else
        MsgBox ("Vous avez gagné(e)!")
    End If
' actualisation des statistiques
    For p = 0 To 3 Step 3
        Text1(p).Text = Text1(p).Text + 1
    Next p
    Call REJ_Click
Else
' si m=0 alors la somme de la ligne (O) vaut 3
    If m = 0 Then
        If HVSH.Checked = True Then
            MsgBox (nom2 & " a gagné(e)!")
        Else
            MsgBox ("Vous avez perdu(e)!")
        End If
        For p = 1 To 3 Step 2
' actualisation des statistiques
            Text1(p).Text = Text1(p).Text + 1
        Next p
        Call REJ_Click
    End If
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If HVSH.Checked = True Then
    bn = 0
    a = PAIR(jeu)
    If a = True Then
' partie droite du clavier (pavé numerique)
        If KeyAscii = vbKey1 And Command1(6).Caption = "" Then
            Command1(6).Caption = "X"
            op(6, 0) = "X"
            op(6, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey2 And Command1(7).Caption = "" Then
            Command1(7).Caption = "X"
            op(7, 0) = "X"
            op(7, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey3 And Command1(8).Caption = "" Then
            Command1(8).Caption = "X"
            op(8, 0) = "X"
            op(8, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey4 And Command1(3).Caption = "" Then
            Command1(3).Caption = "X"
            op(3, 0) = "X"
            op(3, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey5 And Command1(4).Caption = "" Then
            Command1(4).Caption = "X"
            op(4, 0) = "X"
            op(4, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey6 And Command1(5).Caption = "" Then
            Command1(5).Caption = "X"
            op(5, 0) = "X"
            op(5, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey7 And Command1(0).Caption = "" Then
            Command1(0).Caption = "X"
            op(0, 0) = "X"
            op(0, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey8 And Command1(1).Caption = "" Then
            Command1(1).Caption = "X"
            op(1, 0) = "X"
            op(1, 1) = 4
            bn = 1
        End If
        If KeyAscii = vbKey9 And Command1(2).Caption = "" Then
            Command1(2).Caption = "X"
            op(2, 0) = "X"
            op(2, 1) = 4
            bn = 1
        End If
    Else
'partie gauche du clavier (alphabetique)
        If KeyAscii = vbKeyW Or KeyAscii = 119 And Command1(6).Caption = "" Then
            Command1(6).Caption = "O"
            op(6, 0) = "O"
            op(6, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyX Or KeyAscii = 120 And Command1(7).Caption = "" Then
            Command1(7).Caption = "O"
            op(7, 0) = "O"
            op(7, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyC Or KeyAscii = 99 And Command1(8).Caption = "" Then
            Command1(8).Caption = "O"
            op(8, 0) = "O"
            op(8, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyQ Or KeyAscii = 113 And Command1(3).Caption = "" Then
            Command1(3).Caption = "O"
            op(3, 0) = "O"
            op(3, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyS Or KeyAscii = 115 And Command1(4).Caption = "" Then
            Command1(4).Caption = "O"
            op(4, 0) = "O"
            op(4, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyD Or KeyAscii = 100 And Command1(5).Caption = "" Then
            Command1(5).Caption = "O"
            op(5, 0) = "O"
            op(5, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyA Or KeyAscii = 97 And Command1(0).Caption = "" Then
            Command1(0).Caption = "O"
            op(0, 0) = "O"
            op(0, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyZ Or KeyAscii = 122 And Command1(1).Caption = "" Then
            Command1(1).Caption = "O"
            op(1, 0) = "O"
            op(1, 1) = 1
            bn = 1
        End If
        If KeyAscii = vbKeyE Or KeyAscii = 101 And Command1(2).Caption = "" Then
            Command1(2).Caption = "O"
            op(2, 0) = "O"
            op(2, 1) = 1
            bn = 1
        End If
'fin du clavier
    End If
    If bn = 1 Then
        jeu = jeu + 1
    End If
End If
Call FIN
End Sub

' programme du chargement de la feuille
Private Sub Form_Load()
For i = 0 To 8
    Command1(i).FontSize = 25
    Command1(i).Caption = ""
    op(i, 0) = ""
    op(i, 1) = ""
Next i
' remise a 0 de toutes les variables de statistique
For i = 0 To 6
    Text1(i) = 0
Next i
' mise en place du tableau de jeu
REJ_Click
HVSO.Checked = True
' mise a 0 de tout les points des cases
For i = 0 To 8
    op(i, 1) = 0
Next i
End Sub

Private Function IA() As Integer
' le tableau des solutions possibles est rempli
Call TABSOL

' remise a 0 du tableau qui totalise le nombre de points en fonction des solutions et de la marque de la case
Call RAZ

' calcul du nombre de points par ligne en sachant qui X vaut 1 et O vaut 4
z = -1
For j = 0 To 6 Step 3
    z = z + 1
    For i = 0 To 2
        If op(i + j, 0) = "X" Then
            sol(z, i) = 1
        Else
            sol(z, i) = 0
        End If
        If op(i + j, 0) = "O" Then
            sol(z, i) = 4
        End If
        sol(z, 3) = sol(z, 3) + sol(z, i)
    Next i
Next j

' meme principe pour les colonnes
For i = 0 To 2
    z = z + 1
    h = -1
    For j = 0 To 6 Step 3
        h = h + 1
        If op(i + j, 0) = "X" Then
            sol(z, h) = 1
        End If
        If op(i + j, 0) = "O" Then
            sol(z, h) = 4
        End If
        sol(z, 3) = sol(z, 3) + sol(z, h)
    Next j
Next i

' meme principe pour les diagonales
z = z + 1
i = -1
For j = 0 To 8 Step 4
    i = i + 1
    If op(j, 0) = "X" Then
        sol(z, i) = 1
    End If
    If op(j, 0) = "O" Then
        sol(z, i) = 4
    End If
   sol(z, 3) = sol(z, 3) + sol(z, i)
Next j

i = -1
z = z + 1
For j = 2 To 6 Step 2
    i = i + 1
    If op(j, 0) = "X" Then
        sol(z, i) = 1
    Else
        sol(z, i) = 0
    End If
    If op(j, 0) = "O" Then
        sol(z, i) = 4
    End If
    sol(z, 3) = sol(z, 3) + sol(z, i)
Next j

' appel de la fonction qui retournera la valeur choisi par l'ordinateur
IA = RESULTAT

' choix de la premiere case jouée par l'ordinateur
If test = 0 Then
    IA = Int(Rnd * 9)
End If
End Function

Private Sub help_Click()
For i = 0 To 8
    Command1(i).Caption = i + 1
Next i
joueur1.Show
joueur2.Show
z = MsgBox("Le joueur qui a les 'O' coche les cases grâce aux touches alphabétiques: A -> 1ere case, Z -> 2eme case, E -> 3eme case, Q -> 4eme case, S -> 5eme case, D -> 6eme case, W -> 7eme case, X -> 8eme case, C -> 9eme case. Le joueur qui a les 'X' coche les cases avec le pavé numérique: 7 -> 1ere case, 8 -> 2eme case, 9 -> 3eme case, 4 -> 4eme case, 5 -> 5eme case, 6 -> 6eme case, 1 -> 7eme case, 2 -> 8eme case, 3 -> 9eme case.Pour commencer à jouer, cliquez sur 'OK'", vbInformation)
If z = 1 Then
    joueur1.Hide
    joueur2.Hide
    For i = 0 To 8
        Command1(i).Caption = ""
    Next i
End If
End Sub

Private Sub HVSH_Click()
For i = 0 To 6
    Text1(i) = 0
Next i
HVSH.Checked = True
HVSO.Checked = False
For i = 0 To 8
    Command1(i).Enabled = False
Next i
nom1 = InputBox("Quel est votre nom? (Vous avez les X)")
Label1(0).Caption = nom1
nom2 = InputBox("Quel est votre nom? (Vous avez les O et vous commencé(e))")
Label1(1).Caption = nom2
End Sub

Private Sub HVSO_Click()
HVSH.Checked = False
HVSO.Checked = True
For i = 0 To 8
    Command1(i).Enabled = True
Next i
End Sub

Private Sub REJ_Click()
' initialisation a -1 de la variable qui sert a jouer la premiere case pour l'ordinateur
jeu = 9
autre = -1
test = -1
' mise en place du jeu
For i = 0 To 8
    Command1(i).Caption = ""
    op(i, 0) = ""
    op(i, 1) = 0
    Command1(i).BackColor = &H8000000A
Next i
For Each obj In Command1
    obj.Visible = True
Next obj
For Each obj In Label1
    obj.Visible = False
Next obj
For Each obj In Text1
    obj.Visible = False
Next obj
For Each obj In Line1
    obj.Visible = False
Next obj
End Sub

' mise en place du tableau de statistiques
Private Sub stat_Click()
k = 3
For i = 0 To 2
    k = k + 1
    If Text1(i) <> 0 Then
        Text1(k).Text = (Text1(i) / Text1(3)) * 100
    End If
Next i
For Each obj In Command1
    obj.Visible = False
Next obj
For Each obj In Label1
    obj.Visible = True
Next obj
For Each obj In Text1
    obj.Visible = True
Next obj
For Each obj In Line1
    obj.Visible = True
Next obj
End Sub

Private Function RESULTAT() As Integer
' fonction qui retourne la valeur correspondante a la case que l'ordinateur va jouer
' l'ordinateur va d'abord regarder s'il ne va pas perdre et jouera pour ne pas perdre
For i = 0 To 7
    If sol(i, 3) = 2 Then
        For j = 0 To 2
            If sol(i, j) = 0 Then
                RESULTAT = res(i, j)
            End If
        Next j
' si l'ordinateur ne peut pas perdre, alors il va tenter de gagner
    Else
       For r = 0 To 7
           If sol(r, 3) = 8 Then
               For p = 0 To 2
                   If sol(r, p) = 0 Then
                       RESULTAT = res(r, p)
                   End If
               Next p
           End If
       Next r
    End If
Next i
End Function

Private Sub RAZ()
' procedure qui remet a 0 le tableau totalisant les points par lignes, colonnes et diagonales
For i = 0 To 8
    For j = 0 To 3
        sol(i, j) = 0
    Next j
Next i
End Sub

Private Function PAIR(x) As Boolean
Dim chif(4) As Integer
For y = 0 To 4
    chif(y) = y * 2
Next y
For w = 0 To 4
    If Mid(x, 2) = chif(w) Then
        bn = 1
    End If
Next w
If bn = 1 Then
    PAIR = True
Else
    PAIR = False
End If
End Function

Private Sub TABSOL()
res(0, 0) = 0
res(0, 1) = 1
res(0, 2) = 2
res(1, 0) = 3
res(1, 1) = 4
res(1, 2) = 5
res(2, 0) = 6
res(2, 1) = 7
res(2, 2) = 8
res(3, 0) = 0
res(3, 1) = 3
res(3, 2) = 6
res(4, 0) = 1
res(4, 1) = 4
res(4, 2) = 7
res(5, 0) = 2
res(5, 1) = 5
res(5, 2) = 8
res(6, 0) = 0
res(6, 1) = 4
res(6, 2) = 8
res(7, 0) = 2
res(7, 1) = 4
res(7, 2) = 6
End Sub

Private Sub IMBATTABLE()
            r = IA
    
' on teste si la case n'est pas déja prise
    If op(r, 0) <> "" Then
        r = Int(Rnd * 9)
    End If
End Sub

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
56
Date d'inscription
vendredi 17 octobre 2003
Statut
Membre
Dernière intervention
3 juillet 2005

Si tu mettai les sources + l'executabe ca serait chouette :o)

Moi j'suis fan des p'tits trucs comme ca ;o)
Messages postés
288
Date d'inscription
dimanche 1 septembre 2002
Statut
Membre
Dernière intervention
13 juin 2008

oui, c'est vrai

si tu ajoutais la source et les feuilles, ce serait mieux

@+
Messages postés
17
Date d'inscription
lundi 13 mai 2002
Statut
Membre
Dernière intervention
21 janvier 2004

pas de source et en plus un petit bug en mode solo si on gagne l'ordinateur joue quand meme un coup aprés et (si lui gagne sur ce coup il nous declare perdant)

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.