Morpion by cda
Description
Un morpion tout simple, histoire de s'occuper pendant les heures de bureau.
Source / Exemple :
Option Explicit
' Déclaration des variables globales
Dim nbParties As Integer
Dim nbGagnees As Integer
Dim nbNulles As Integer
Dim matrix(8) As String
Dim fin As Boolean
Private Sub initRaz()
' Initialisation de l'affichage
Dim cpt As Integer
For cpt = 0 To 8
picTable(cpt).Cls
matrix(cpt) = "N"
Next cpt
End Sub
Private Sub Form_Load()
' Chargement de l'appli
initRaz
nbParties = 0
nbGagnees = 0
nbNulles = 0
' Affichage du titre de l'appli
With Me
.Caption = App.Title
End With
End Sub
Private Sub men_abt_Click()
' Affichage de la fenêtre A propos ..
frmAbout.Show
End Sub
Private Sub men_aid_Click()
frmHlp.Show
End Sub
Private Sub men_new_Click()
' Remise à zéro quand fichier/nouveau
initRaz
End Sub
Private Sub men_quit_Click()
' Menu Fichier/quitter
End
End Sub
Private Sub picTable_Click(Index As Integer)
' Procédure principale
Dim cpt As Integer
Dim enCours As Integer
For cpt = 0 To 8
picTable(cpt).Enabled = False
Next cpt
fin = False
If StrComp(matrix(Index), "N") = 0 Then
picTable(Index).Line (picTable(Index).ScaleTop, picTable(Index).ScaleLeft)-(picTable(Index).ScaleHeight, picTable(Index).ScaleWidth)
picTable(Index).Line (picTable(Index).ScaleLeft, picTable(Index).ScaleHeight)-(picTable(Index).ScaleWidth, picTable(Index).ScaleTop)
matrix(Index) = "X"
enCours = verifFin
If Not fin Then
cpt = testCoup("X")
picTable(cpt).Circle (picTable(cpt).ScaleHeight / 2 - 5, picTable(cpt).ScaleWidth / 2 - 5), (picTable(cpt).ScaleHeight / 2 - 5)
matrix(cpt) = "O"
enCours = verifFin
End If
If fin Then
If enCours = 0 Then
MsgBox "Vous avez perdu !"
initRaz
ElseIf enCours = 1 Then
MsgBox "Vous avez gagné !"
nbGagnees = nbGagnees + 1
initRaz
ElseIf enCours = -1 Then
MsgBox "Match nul !"
nbNulles = nbNulles + 1
initRaz
End If
nbParties = nbParties + 1
lblScore.Caption = nbGagnees & "/" & nbParties
Label1.Caption = nbNulles & "/" & nbParties
End If
End If
For cpt = 0 To 8
picTable(cpt).Enabled = True
Next cpt
End Sub
Function verifFin() As Integer
Dim test As Boolean
Dim cpt As Integer
Select Case Abs(verifLigne)
Case 1: picTable(0).Cls
picTable(1).Cls
picTable(2).Cls
picTable(0).Line (picTable(0).ScaleTop, picTable(0).ScaleWidth / 2)-(picTable(0).ScaleHeight, picTable(0).ScaleWidth / 2)
picTable(1).Line (picTable(1).ScaleTop, picTable(1).ScaleWidth / 2)-(picTable(1).ScaleHeight, picTable(1).ScaleWidth / 2)
picTable(2).Line (picTable(2).ScaleTop, picTable(2).ScaleWidth / 2)-(picTable(2).ScaleHeight, picTable(2).ScaleWidth / 2)
fin = True
Case 2: picTable(3).Cls
picTable(4).Cls
picTable(5).Cls
picTable(3).Line (picTable(3).ScaleTop, picTable(3).ScaleWidth / 2)-(picTable(3).ScaleHeight, picTable(3).ScaleWidth / 2)
picTable(4).Line (picTable(4).ScaleTop, picTable(4).ScaleWidth / 2)-(picTable(4).ScaleHeight, picTable(4).ScaleWidth / 2)
picTable(5).Line (picTable(5).ScaleTop, picTable(5).ScaleWidth / 2)-(picTable(5).ScaleHeight, picTable(5).ScaleWidth / 2)
fin = True
Case 3: picTable(6).Cls
picTable(7).Cls
picTable(8).Cls
picTable(6).Line (picTable(6).ScaleTop, picTable(6).ScaleWidth / 2)-(picTable(6).ScaleHeight, picTable(6).ScaleWidth / 2)
picTable(7).Line (picTable(7).ScaleTop, picTable(7).ScaleWidth / 2)-(picTable(7).ScaleHeight, picTable(7).ScaleWidth / 2)
picTable(8).Line (picTable(8).ScaleTop, picTable(8).ScaleWidth / 2)-(picTable(8).ScaleHeight, picTable(8).ScaleWidth / 2)
fin = True
End Select
Select Case Abs(verifColonne)
Case 1: picTable(0).Cls
picTable(3).Cls
picTable(6).Cls
picTable(0).Line (picTable(0).ScaleWidth / 2, picTable(0).ScaleTop)-(picTable(0).ScaleWidth / 2, picTable(0).ScaleHeight)
picTable(3).Line (picTable(3).ScaleWidth / 2, picTable(3).ScaleTop)-(picTable(3).ScaleWidth / 2, picTable(3).ScaleHeight)
picTable(6).Line (picTable(6).ScaleWidth / 2, picTable(6).ScaleTop)-(picTable(6).ScaleWidth / 2, picTable(6).ScaleHeight)
fin = True
Case 2: picTable(1).Cls
picTable(4).Cls
picTable(7).Cls
picTable(1).Line (picTable(1).ScaleWidth / 2, picTable(1).ScaleTop)-(picTable(1).ScaleWidth / 2, picTable(1).ScaleHeight)
picTable(4).Line (picTable(4).ScaleWidth / 2, picTable(4).ScaleTop)-(picTable(4).ScaleWidth / 2, picTable(4).ScaleHeight)
picTable(7).Line (picTable(7).ScaleWidth / 2, picTable(7).ScaleTop)-(picTable(7).ScaleWidth / 2, picTable(7).ScaleHeight)
fin = True
Case 3: picTable(2).Cls
picTable(5).Cls
picTable(8).Cls
picTable(2).Line (picTable(2).ScaleWidth / 2, picTable(2).ScaleTop)-(picTable(2).ScaleWidth / 2, picTable(2).ScaleHeight)
picTable(5).Line (picTable(5).ScaleWidth / 2, picTable(5).ScaleTop)-(picTable(5).ScaleWidth / 2, picTable(5).ScaleHeight)
picTable(8).Line (picTable(8).ScaleWidth / 2, picTable(8).ScaleTop)-(picTable(8).ScaleWidth / 2, picTable(8).ScaleHeight)
fin = True
End Select
Select Case Abs(verifDiagonal)
Case 1: picTable(0).Cls
picTable(4).Cls
picTable(8).Cls
picTable(0).Line (picTable(0).ScaleTop, picTable(0).ScaleLeft)-(picTable(0).ScaleWidth, picTable(0).ScaleHeight)
picTable(4).Line (picTable(4).ScaleTop, picTable(4).ScaleLeft)-(picTable(4).ScaleWidth, picTable(4).ScaleHeight)
picTable(8).Line (picTable(8).ScaleTop, picTable(8).ScaleLeft)-(picTable(8).ScaleWidth, picTable(8).ScaleHeight)
fin = True
Case 2: picTable(2).Cls
picTable(4).Cls
picTable(6).Cls
picTable(2).Line (picTable(2).ScaleHeight, picTable(2).ScaleLeft)-(picTable(2).ScaleTop, picTable(2).ScaleWidth)
picTable(4).Line (picTable(4).ScaleHeight, picTable(4).ScaleLeft)-(picTable(4).ScaleTop, picTable(4).ScaleWidth)
picTable(6).Line (picTable(6).ScaleHeight, picTable(6).ScaleLeft)-(picTable(6).ScaleTop, picTable(6).ScaleWidth)
fin = True
End Select
test = False
If matrix(0) <> "N" And matrix(1) <> "N" And matrix(2) <> "N" And _
matrix(3) <> "N" And matrix(4) <> "N" And matrix(5) <> "N" And _
matrix(6) <> "N" And matrix(7) <> "N" And matrix(8) <> "N" Then
fin = True
test = True
End If
If fin Then
If verifLigne < 0 Or verifColonne < 0 Or verifDiagonal < 0 Then
verifFin = 0
ElseIf verifLigne > 0 Or verifColonne > 0 Or verifDiagonal > 0 Then
verifFin = 1
ElseIf test Then
verifFin = -1
End If
End If
End Function
Function verifLigne() As Integer
Dim tmpLigne As Integer
Dim tmpJoueur As String
tmpLigne = 0
If (matrix(0) = matrix(1) And matrix(1) = matrix(2) And matrix(2) <> "N") Then
tmpLigne = 1
tmpJoueur = matrix(0)
ElseIf (matrix(3) = matrix(4) And matrix(4) = matrix(5) And matrix(5) <> "N") Then
tmpLigne = 2
tmpJoueur = matrix(3)
ElseIf (matrix(6) = matrix(7) And matrix(7) = matrix(8) And matrix(8) <> "N") Then
tmpLigne = 3
tmpJoueur = matrix(6)
End If
If tmpJoueur = "O" And tmpLigne <> 0 Then
tmpLigne = 0 - tmpLigne
End If
verifLigne = tmpLigne
End Function
Function verifColonne() As Integer
Dim tmpColonne As Integer
Dim tmpJoueur As String
tmpColonne = 0
If (matrix(0) = matrix(3) And matrix(3) = matrix(6) And matrix(6) <> "N") Then
tmpColonne = 1
tmpJoueur = matrix(0)
ElseIf (matrix(1) = matrix(4) And matrix(4) = matrix(7) And matrix(7) <> "N") Then
tmpColonne = 2
tmpJoueur = matrix(1)
ElseIf (matrix(2) = matrix(5) And matrix(5) = matrix(8) And matrix(8) <> "N") Then
tmpColonne = 3
tmpJoueur = matrix(2)
End If
If tmpJoueur = "O" And tmpColonne <> 0 Then
tmpColonne = 0 - tmpColonne
End If
verifColonne = tmpColonne
End Function
Function verifDiagonal() As Integer
Dim tmpDiagonal As Integer
Dim tmpJoueur As String
tmpDiagonal = 0
If (matrix(0) = matrix(4) And matrix(4) = matrix(8) And matrix(8) <> "N") Then
tmpDiagonal = 1
tmpJoueur = matrix(0)
ElseIf (matrix(2) = matrix(4) And matrix(4) = matrix(6) And matrix(6) <> "N") Then
tmpDiagonal = 2
tmpJoueur = matrix(2)
End If
If tmpJoueur = "O" And tmpDiagonal <> 0 Then
tmpDiagonal = 0 - tmpDiagonal
End If
verifDiagonal = tmpDiagonal
End Function
Function testCoup(joueur As String) As Integer
Dim tmpCp As Integer
Dim tmpRnd As Integer
Dim trouve As Boolean
If (matrix(0) = matrix(8) And matrix(8) = "O" And matrix(4) = "N") Or _
(matrix(2) = matrix(6) And matrix(6) = "O" And matrix(4) = "N") Or _
(matrix(1) = matrix(7) And matrix(7) = "O" And matrix(4) = "N") Or _
(matrix(3) = matrix(5) And matrix(5) = "O" And matrix(4) = "N") Then
' Case du milieu
tmpCp = 4
ElseIf (matrix(1) = matrix(2) And matrix(2) = "O" And matrix(0) = "N") Or _
(matrix(3) = matrix(6) And matrix(6) = "O" And matrix(0) = "N") Or _
(matrix(4) = matrix(8) And matrix(8) = "O" And matrix(0) = "N") Then
' Premier coin, en haut à gauche
tmpCp = 0
ElseIf (matrix(0) = matrix(1) And matrix(1) = "O" And matrix(2) = "N") Or _
(matrix(6) = matrix(4) And matrix(4) = "O" And matrix(2) = "N") Or _
(matrix(8) = matrix(5) And matrix(5) = "O" And matrix(2) = "N") Then
' Second coin, en haut à droite
tmpCp = 2
ElseIf (matrix(0) = matrix(3) And matrix(3) = "O" And matrix(6) = "N") Or _
(matrix(2) = matrix(4) And matrix(4) = "O" And matrix(6) = "N") Or _
(matrix(7) = matrix(8) And matrix(8) = "O" And matrix(6) = "N") Then
' Troisième coin, en bas à gauche
tmpCp = 6
ElseIf (matrix(0) = matrix(4) And matrix(4) = "O" And matrix(8) = "N") Or _
(matrix(2) = matrix(5) And matrix(5) = "O" And matrix(8) = "N") Or _
(matrix(6) = matrix(7) And matrix(7) = "O" And matrix(8) = "N") Then
' Quatrième coin, en bas à gauche
tmpCp = 8
ElseIf (matrix(0) = matrix(2) And matrix(2) = "O" And matrix(1) = "N") Or _
(matrix(4) = matrix(7) And matrix(7) = "O" And matrix(1) = "N") Then
' Au centre, en haut
tmpCp = 1
ElseIf (matrix(6) = matrix(8) And matrix(8) = "O" And matrix(7) = "N") Or _
(matrix(1) = matrix(4) And matrix(4) = "O" And matrix(7) = "N") Then
' Au centre, en bas
tmpCp = 7
ElseIf (matrix(3) = matrix(4) And matrix(4) = "O" And matrix(5) = "N") Or _
(matrix(2) = matrix(8) And matrix(8) = "O" And matrix(5) = "N") Then
' Au centre, à droite
tmpCp = 5
ElseIf (matrix(0) = matrix(6) And matrix(6) = "O" And matrix(3) = "N") Or _
(matrix(4) = matrix(5) And matrix(5) = "O" And matrix(3) = "N") Then
' Au centre, à gauche
tmpCp = 3
ElseIf (matrix(0) = matrix(8) And matrix(8) = joueur And matrix(4) = "N") Or _
(matrix(2) = matrix(6) And matrix(6) = joueur And matrix(4) = "N") Or _
(matrix(1) = matrix(7) And matrix(7) = joueur And matrix(4) = "N") Or _
(matrix(3) = matrix(5) And matrix(5) = joueur And matrix(4) = "N") Then
' Case du milieu
tmpCp = 4
ElseIf (matrix(1) = matrix(2) And matrix(2) = joueur And matrix(0) = "N") Or _
(matrix(3) = matrix(6) And matrix(6) = joueur And matrix(0) = "N") Or _
(matrix(4) = matrix(8) And matrix(8) = joueur And matrix(0) = "N") Then
' Premier coin, en haut à gauche
tmpCp = 0
ElseIf (matrix(0) = matrix(1) And matrix(1) = joueur And matrix(2) = "N") Or _
(matrix(6) = matrix(4) And matrix(4) = joueur And matrix(2) = "N") Or _
(matrix(8) = matrix(5) And matrix(5) = joueur And matrix(2) = "N") Then
' Second coin, en haut à droite
tmpCp = 2
ElseIf (matrix(0) = matrix(3) And matrix(3) = joueur And matrix(6) = "N") Or _
(matrix(2) = matrix(4) And matrix(4) = joueur And matrix(6) = "N") Or _
(matrix(7) = matrix(8) And matrix(8) = joueur And matrix(6) = "N") Then
' Troisième coin, en bas à gauche
tmpCp = 6
ElseIf (matrix(0) = matrix(4) And matrix(4) = joueur And matrix(8) = "N") Or _
(matrix(2) = matrix(5) And matrix(5) = joueur And matrix(8) = "N") Or _
(matrix(6) = matrix(7) And matrix(7) = joueur And matrix(8) = "N") Then
' Quatrième coin, en bas à gauche
tmpCp = 8
ElseIf (matrix(0) = matrix(2) And matrix(2) = joueur And matrix(1) = "N") Or _
(matrix(4) = matrix(7) And matrix(7) = joueur And matrix(1) = "N") Then
' Au centre, en haut
tmpCp = 1
ElseIf (matrix(6) = matrix(8) And matrix(8) = joueur And matrix(7) = "N") Or _
(matrix(1) = matrix(4) And matrix(4) = joueur And matrix(7) = "N") Then
' Au centre, en bas
tmpCp = 7
ElseIf (matrix(3) = matrix(4) And matrix(4) = joueur And matrix(5) = "N") Or _
(matrix(2) = matrix(8) And matrix(8) = joueur And matrix(5) = "N") Then
' Au centre, à droite
tmpCp = 5
ElseIf (matrix(0) = matrix(6) And matrix(6) = joueur And matrix(3) = "N") Or _
(matrix(4) = matrix(5) And matrix(5) = joueur And matrix(3) = "N") Then
' Au centre, à gauche
tmpCp = 3
Else
trouve = False
Do
tmpRnd = Int((8 * Rnd))
If matrix(tmpRnd) = "N" Then
tmpCp = tmpRnd
trouve = True
End If
Loop Until trouve
End If
testCoup = tmpCp
End Function
Codes Sources
A voir également
- Morpion by cda
- Group by - Forum SQL
- Morpion en ligne ✓ - Forum Javascript / DHTML
- Grille morpion vierge - Forum Java
- Renfield cda - Forum Visual Basic
- Morpion définition - Forum C
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.