Découvrir Visual Basic Express Edition dans une première application.
Ce tutoriel est la suite de Programmer un jeu - OTHELLO - Première partie.
L'auteur en est AffreuxJojp, je n'ai contribué qu'à sa mise en page dans cette nouvelle interface.
Donc, nous venons de découvrir qu'il faut changer de couleur de pion après chaque coup ! Ce n'est pas une découverte puisque c'est la règle du jeu, mais que l'on applique implicitement, sans vraiment y penser et de plus cette règle introduit des exceptions. Pour la résoudre, il faut introduire une nouvelle fonction capable de tester si le jeu est possible (dans au moins une case) pour une couleur donnée :
' ' Teste si le jeu est possible pour cette couleur de pion Function CanPlay(ByVal pion As Piece) As Boolean For idx As Index = Index.a1 To Index.h8 'teste toutes les cases du jeu If CaseCheck(idx, pion) Then Return True Next CanPlay = False End Function
Une procédure supplémentaire est créée pour assurer le changement de la couleur du pion joueur et l'événement est modifié en conséquence.
Remarque : La nouvelle procédure ne ré-affiche pas le jeu si la case choisie n'était pas bonne.
' Sub PionPlaying(ByVal idx As Index) Dim count As Integer = Playing(idx, Player) If count > 0 Then 'OK c'est bon If CanPlay(NotColor(Player)) Then Player = NotColor(Player) Display() End If End Sub Private Sub Form1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick Dim idx As Index = ToIndex(e.Location) If idx <> Index.ovf Then PionPlaying(idx) 'si on clique dans l'Othellier End Sub
Cette fois-ci ça marche, on peut jouer, mais si notre programme assure le minimum, il ne communique toujours pas beaucoup, il pourrait faire beaucoup mieux ! Et puis, il ne gère pas la fin de partie, lorsqu'aucun des joueurs ne peut jouer !
Nous allons réécrire la dernière fonction « PionPlaying » et ajouter toutes fonctions nécessaires pour sortir les différents messages sur le jeu, en utilisant les « TextBox » prévues. La fonction « Display » est aussi complétée. A la suite de toutes ces modifications, voici un état complet du jeu dans cette nouvelle version :
' Public Class Form1 Dim g As Graphics ' position Othellier dans l'image (et dans Form1) Const ofsX = 17, OfsY = 17, oWidth = 208, oHeight = 208 '==================================================================== ' Etat du jeu Enum Index As Byte ' positions caractéristiques sur l'Othellier a1 = 0 ' première case du jeu h8 = 63 ' dernière case du jeu d4 = 8 * 3 + 3 ' cases centrales de départ d5 = 8 * 3 + 4 e4 = 8 * 4 + 3 e5 = 8 * 4 + 4 ovf = 64 'valeur utilisée pour signifier le bord du jeu, hors Othellier End Enum Enum Piece As Byte ' différentes valeurs possibles d'une case du jeu Empty Black White Border ' valeur de la case Index.ovf End Enum ' État courant du jeu : état des 64 cases du jeu, plus une, réservée pour signaler Dim table(Index.ovf) As Piece 'le bord de l'Othellier lors des déplacements Dim Player As Piece 'la couleur du pion qui doit jouer (Piece.Empty = partie terminée) '==================================================================== ' Mouvements sur l'Othellier dans les 8 directions Enum Direction As Byte ' Les 8 directions de mouvements sur l'Othellier (0..7) North NorthEast East SouthEast South SouthWest West NorthWest last = 7 End Enum '==================================================================== 'Tables utilisées pour convertir un index en texte désignant la case ("a1".."h8") Const tchar As String = "abcdefgh" Const tnum As String = "12345678" '==================================================================== ' Conversion d'un index (dans la table de jeu) en position dans l'affichage Function ToPosition(ByVal idx As Index) As Point If idx = Index.ovf Then ToPosition.X = -1 : ToPosition.Y = -1 Else ToPosition.X = ((idx And 7) * oWidth) \ 8 + ofsX ToPosition.Y = ((idx >> 3) * oHeight) \ 8 + OfsY End If End Function ' Conversion d'une position dans l'affichage en index dans la table (de jeu) Function ToIndex(ByVal pos As Point) As Index pos.X -= ofsX : pos.Y -= OfsY If pos.X >= 0 And pos.X < oWidth And pos.Y >= 0 And pos.Y < oHeight Then ToIndex = ((pos.X * 8) \ oWidth) + 8 * ((pos.Y * 8) \ oHeight) Else ToIndex = Index.ovf End If End Function ' Conversion d'un index (dans la table de jeu) en texte de position Function IndexStr(ByVal idx As Index) As String 'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ... IndexStr = If(idx >= 0 AndAlso idx < 64, _ tchar.Chars(idx Mod 8) & tnum.Chars(idx \ 8), "??") End Function ' Conversion d'un texte de position en index dans la table de jeu Function AlphaNumToIndex(ByVal str As String) As Index 'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ... str = str.Trim(" "",;'").ToLower() + " " 'nettoyage du texte Dim u As Integer = tchar.IndexOf(str.Chars(0)) 'premier car. (a..h) nom colonnes Dim v As Integer = tnum.IndexOf(str.Chars(1)) '2eme car (1..8) nom lignes AlphaNumToIndex = If(u >= 0 And v >= 0, u + 8 * v, Index.ovf) End Function ' Conversion d'un no de case exprime en décimal (11..88) en Index Function NumToIndex(ByVal val As Byte) As Index ' codage : 11=a1(0), 18=h1(7), 21=a2(8), 81=a8(56), 88=h8(63), utilise par WTB Dim u As Integer = val \ 10 - 1 ' dizaines Dim v As Integer = val Mod 10 - 1 ' unites NumToIndex = If(u >= 0 And v >= 0 And u < 8 And v < 8, v + 8 * u, Index.ovf) End Function ' Calcul de la position suivante pour un déplacement sur l'Othellier Function NextPos(ByVal idx As Index, ByVal dir As Direction) As Index 'suivant la position de départ et la direction, on peut sortir de l'Othellier Select Case dir Case Direction.North NextPos = If(idx \ 8 = 0, Index.ovf, idx - 8) Case Direction.NorthEast NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 0, Index.ovf, idx - 7) Case Direction.East NextPos = If(idx Mod 8 = 7, Index.ovf, idx + 1) Case Direction.SouthEast NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 7, Index.ovf, idx + 9) Case Direction.South NextPos = If(idx \ 8 = 7, Index.ovf, idx + 8) Case Direction.SouthWest NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 7, Index.ovf, idx + 7) Case Direction.West NextPos = If(idx Mod 8 = 0, Index.ovf, idx - 1) Case Direction.NorthWest NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 0, Index.ovf, idx - 9) End Select End Function ' Retournement d'un pion Function NotColor(ByVal pion As Piece) As Piece Select Case pion Case Piece.Black NotColor = Piece.White Case Piece.White NotColor = Piece.Black Case Else ' pour les autres états pas de changement NotColor = pion End Select End Function ' Conversion en text du nom du pion joueur Function PieceStr(ByVal pion As Piece) As String Select Case pion Case Piece.Black PieceStr = "Noir" Case Piece.White PieceStr = "Blanc" Case Else PieceStr = "" End Select End Function ' Invite une couleur a jouer Function PromptPlayer(ByVal m As Byte) As String If m = 0 Then PromptPlayer = "C'est maintenant à " & PieceStr(Player) & " de jouer." ElseIf m = 1 Then PromptPlayer = "Et " & PieceStr(Player) & " continue de jouer." Else PromptPlayer = "Et " & PieceStr(Player) & " abandonne !" End If End Function ' Change la couleur du joueur si c'est nécessaire et sortie du message d'invite ' à jouer ou de fin Sub ComputNext(ByVal text As String, Optional ByVal db As Boolean = False) Dim flg As Byte = If(db, 2, 0) Messages.Text = text & vbCrLf If CanPlay(Player) Then Messages.Text &= PromptPlayer(flg) ElseIf CanPlay(NotColor(Player)) Then 'la couleur adverse ne peut jouer, ' continue la meme couleur Player = NotColor(Player) Messages.Text &= PromptPlayer(flg + 1) Else 'fin du jeu, aucun des pions ne pouvant jouer Player = Piece.Empty ' indique la fin de la partie Messages.Text &= ScoreEndOfPlay() End If End Sub ' Édite le score de fin de jeu Function ScoreEndOfPlay() As String Dim noir As Byte = CountPions(Piece.Black) Dim blanc As Byte = CountPions(Piece.White) If noir > blanc Then Return " Et Noir gagne " & Str(64 - blanc) _ & " à " & Str(blanc) & "." If blanc > noir Then Return " Et Blanc gagne " & Str(64 - noir) _ & " à " & Str(noir) & "." Return " Et le jeu se termine match null " & Str(noir) & " à " & Str(blanc) & "." End Function ' Message ajoutant le compte des cases vides Function VidesMsg(ByVal total As Byte) As String VidesMsg = If(total = 64, "", " + " + Str(64 - total)) End Function ' Compte les points d'une couleur donnée Function CountPions(ByVal pion As Piece) As Byte CountPions = 0 For i As Index = Index.a1 To Index.h8 If table(i) = pion Then CountPions += 1 Next End Function '==================================================================== ' JEU ' initialise et démarre le jeu Sub Initialize() InitTable() Messages.Text = "Début du jeu :" & vbCrLf & PromptPlayer(0) End Sub ' Initialisation de la table du jeu Sub InitTable() For i As Index = Index.a1 To Index.h8 table(i) = Piece.Empty Next table(Index.d4) = Piece.White table(Index.d5) = Piece.Black table(Index.e4) = Piece.Black table(Index.e5) = Piece.White table(Index.ovf) = Piece.Border Player = Piece.Black ' Noir commence toujours la partie End Sub ' Recherche si, dans une direction donnée, le retournement de pions adverses est possible Function Search(ByVal idx As Index, ByVal dir As Direction, ByVal pion As Piece) As Boolean Dim notPion As Piece = NotColor(pion) ' couleur pion adverse 'il faut, au moins, qu'à la premiere case parcourue, le pion rencontré soit adverse idx = NextPos(idx, dir) If table(idx) <> notPion Then Return False Do 'cherche la fin des pions adverses dans la direction idx = NextPos(idx, dir) Loop While table(idx) = notPion 'la case suivante, dans la direction, doit être occupée par un pion de la couleur Return CBool(table(idx) = pion) End Function ' Teste si le jeu de cette case avec cette couleur de pion est possible Function CaseCheck(ByVal idx As Index, ByVal pion As Piece) As Boolean If table(idx) <> Piece.Empty Then Return False 'la case n'est pas vide For dir As Direction = 0 To Direction.last 'dans les 8 directions If Search(idx, dir, pion) Then Return True 'cherche une ou le jeu est possible Next Return False End Function ' Teste si le jeu est possible pour cette couleur de pion Function CanPlay(ByVal pion As Piece) As Boolean For idx As Index = Index.a1 To Index.h8 'teste toutes les cases If CaseCheck(idx, pion) Then Return True Next CanPlay = False End Function ' Place un nouveau pion dans le jeu (si possible), indique le nombre de pions gagnés Function Playing(ByVal idx As Index, ByVal pion As Piece) As Integer Playing = 1 ' on compte le pion joué If table(idx) = Piece.Empty Then ' La case est vide For dir As Direction = 0 To Direction.last ' pour les 8 directions If Search(idx, dir, pion) Then ' Cette direction est valide Dim i As Index = NextPos(idx, dir) ' première case dans la direction 'le premier est toujours à retourner, puisque la direction est valide Do table(i) = pion 'retourne les pions dans cette direction Playing += 1 'compte les pions retournés i = NextPos(i, dir) 'extrait la position suivante Loop While table(i) <> pion 'termine sur un pion de sa couleur End If Next End If 'Si la case de depart (idx) est mal choisie, aucun pion n'est retourné If Playing > 1 Then table(idx) = pion Else Playing = 0 End Function ' Affiche le jeu Sub Display() Dim noir As Byte = CountPions(Piece.Black) Dim blanc As Byte = CountPions(Piece.White) ' Affiche l'état des cases du jeu For i As Index = Index.a1 To Index.h8 ImageList1.Draw(g, ToPosition(i), table(i)) Next ' Affiche le score actuel du jeu If Player <> Piece.Empty OrElse noir = blanc Then 'partie en cours ou match null ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions" ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions" ElseIf noir > blanc Then 'partie terminée, Noir gagne ScoreBlack.Text = "Noir gagne : " + Str(noir) + " pions" _ & VidesMsg(noir + blanc) ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions" Else 'partie terminée, Blanc gagne ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions" ScoreWhite.Text = "Blanc gagne : " + Str(blanc) _ & " pions" + VidesMsg(noir + blanc) End If End Sub ' Affiche les messages d'après avoir joué un pion Sub PlayingMsg(ByVal idx As Index, ByVal count As Integer) If count > 0 Then 'OK c'est bon, on memorise et affiche le nouveau jeu Dim msg As String = PieceStr(Player) & " a joué et gagne" & Str(count) _ & " points." Player = NotColor(Player) ComputNext(msg) Display() ElseIf Player <> Piece.Empty Then Messages.Text = "Erreur, " & PieceStr(Player) _ & " doit jouer une case valide !" End If If Player = Piece.Empty Then ' le jeu est fini If MsgBox("Voulez-vous recommencer une autre partie ?", _ MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then Initialize() Display() End If End If End Sub '==================================================================== ' EVENEMENTS... Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Initialize() End Sub Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint g = Me.CreateGraphics() Display() End Sub ' Place le pion sur l'Othellier à la suite d'un clic souris Private Sub Form1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick Dim idx As Index = ToIndex(e.Location) If idx <> Index.ovf Then PlayingMsg(idx, Playing(idx, Player)) End Sub 'Avancer au pas suivant de la partie Private Sub BtnFor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFor.Click End Sub 'Reculer d'un pas dans la partie Private Sub BtnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBack.Click End Sub 'Remise de la partie au début Private Sub BtnZero_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZero.Click End Sub 'Se place à la fin de la partie telle qu'elle est enregistrée Private Sub BtnMax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnMax.Click End Sub 'Rejouer une partie sauvegardée dans un fichier Private Sub BtnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRead.Click End Sub 'Ecriture dans un fichier de la partie en cours Private Sub BtnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnWrite.Click End Sub 'Rejouer la partie designée de la base de données Private Sub RecNb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RecNb.ValueChanged End Sub End Class
La version décrite plus haut, permet à deux joueurs de faire une partie, elle vérifie si les coups proposés sont légaux et elle compte les points et détermine le gagnant. Mais on peut lui ajouter des fonctionnalités de confort comme annuler un coup, sauvegarder une partie puis la rejouer, ou encore afficher les parties contenues dans une Base de Données de type WTB. Ces fonctionnalités font intervenir les boutons qui ne sont pas utilisés.
Pour cela, il faut ajouter les variables globales suivantes :
' Dim current As Integer 'le numero du coup joué (1, 2,...) Dim history(60) As Byte 'mémoire des coups joués, termine par une case à zéro Dim db As Byte() 'Base de données de jeu, chargée par ReadWTB()
Et les traitements correspondants:
' ' Affichage de l'entête de la base de données (si elle est chargée) Function DbHeader(ByVal nb As Integer) As String DbHeader = "" Try Dim year As Integer = db(10) + db(11) * 256 Dim nbMax As Integer = (db.Length - 16) \ 68 DbHeader = "Année" & Str(year) DbHeader &= If(nb > 0, ", partie" & Str(nb) & " /" & Str(nbMax), _ ", comportant" & Str(nbMax) & " parties") Catch End Try End Function '==================================================================== ' HISTORY ' Sauvegarde du coup dans l'history Sub SaveStep(ByVal idx As Index, ByVal pion As Piece) history(current) = (idx << 2) Or (pion And 3) current += 1 history(current) = 0 ' indicateur de fin de l'history End Sub ' Lecture de l'état du jeu, à un pas quelconque, à partir de l'history Sub Restore(ByVal curStep As Integer, Optional ByVal back As Boolean = True) Dim idx, count As Byte InitTable() Do While current < curStep AndAlso history(current) <> 0 idx = history(current) : Player = idx And 3 : idx >>= 2 count = Playing(idx, Player) ' replace les pions comme ils ont déjà été joués current += 1 Loop If current = 0 Then Messages.Text = "Retour au début du jeu :" & vbCrLf & PromptPlayer(0) Else Dim msg As String = SuppressMsg(back) & BackMsg(count, back) Player = NotColor(Player) ' Normalement on change de couleur à chaque coup ComputNext(msg) End If Display() 'Affiche le nouveau jeu End Sub '==================================================================== ' LECTURE / ECRITURE FICHIER Sub Read(ByRef filename As String) If Strings.Right(filename, 4).ToLower() = ".wtb" Then ReadWTB(filename) Else ReadAscii(filename) End Sub ' Lecture d'une partie a partir d'un fichier ascii Sub ReadAscii(ByRef fileName As String) Dim comments As String = "", line As String = "", nb As Integer = 0 InitTable() history(0) = 0 ' vide la memoire de l'history Try FileOpen(1, fileName, OpenMode.Input) While Not EOF(1) line = LineInput(1) : nb += 1 Dim idx As Index = AlphaNumToIndex(line) If idx <> Index.ovf Then 'Le numero de la case est valide, détermine la couleur If Not CaseCheck(idx, Player) Then Player = NotColor(Player) If Playing(idx, Player) = 0 Then Err.Raise(6) 'le coup est illégal ! SaveStep(idx, Player) Player = NotColor(Player) ElseIf line.Length() > 1 And line(0) = "'" Then comments = line.Substring(1) & " : " End If End While ComputNext(comments) 'Affiche le message de présentation de la partie Catch Messages.Text = If(current > 0, Str(current) & " coups lus", "") InitTable() MsgBox(fileName & vbCrLf & If(nb > 0, comments & vbCrLf & line & _ " >> Erreur à la ligne" & Str(nb), "Erreur de lecture !")) Finally FileClose(1) End Try Display() 'Affiche le nouveau jeu End Sub 'Chargement de la base de données Sub ReadWTB(ByRef fileName As String) Dim nb As Integer = 0 Try db = My.Computer.FileSystem.ReadAllBytes(fileName) If db.Length > 16 Then nb = (db.Length - 16) \ 68 Catch MsgBox(fileName & vbCrLf & "Erreur de lecture !") db = Nothing End Try If nb > 0 Then Dim year As Integer = db(10) + db(11) * 256 RecNb.Maximum = nb RecNb.Value = 1 : LoadWTB(1) ' par défaut on charge le no 1 Messages.Text = "Le fichier " & fileName & vbCrLf & DbHeader(0) & " est chargé." RecNb.Enabled = True Else RecNb.Enabled = False End If End Sub 'Chargement du record nb à partir de la base de données Sub LoadWTB(ByVal nb As Integer) Dim n As Integer = nb * 68 + 16 - 60 ' position indice dans la base de données If n >= 16 And n + 59 < db.Length Then InitTable() history(0) = 0 ' vide la memoire de l'history For i As Integer = 0 To 59 Dim idx As Index = NumToIndex(db(n + i)) If Not CanPlay(Player) Then Player = NotColor(Player) If Playing(idx, Player) = 0 Then Exit For ' fin de la partie SaveStep(idx, Player) Player = NotColor(Player) Next 'Affiche le message de présentation, avec mention d'abandon si jeu non fini ComputNext(DbHeader(nb) & " est chargée.", True) Display() ' Affiche le nouveau jeu End If End Sub ' Sauvegarde le jeu courant dans un fichier Sub Write(ByRef FileName As String) Dim comments As String = InputBox("Voulez-vous ajouter un commentaire" & _ vbCrLf & " dans le fichier ?", "", DbHeader(RecNb.Value)) Try FileOpen(2, FileName, OpenMode.Output) If comments <> "" Then PrintLine(2, "'" & comments) ' Sortie de la liste des cases jouées For i As Integer = 0 To 60 Dim idx As Integer = history(i) If idx = 0 Then Exit For ' fin du jeu PrintLine(2, IndexStr(idx >> 2)) Next Catch MsgBox(FileName & vbCrLf & " Erreur d'écriture !") Finally FileClose(2) End Try End Sub
Puis ajouter les lignes de code (en rouge) dans les fonctions existantes :
' initialise et démarre le jeu Sub Initialize() InitTable() ' Initialisation de la table du jeu For i As Index = Index.a1 To Index.h8 ' Affiche le jeu ' Affiche l'etat des cases du jeu ' Etat des boutons qui dependent du jeu |
Et Enfin compléter les gestions d'événements correspondantes :
' 'Avancer au pas suivant de la partie Private Sub BtnFor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFor.Click Restore(current + 1, False) End Sub 'Reculer d'un pas dans la partie Private Sub BtnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBack.Click Restore(current - 1) End Sub 'Remise de la partie au début Private Sub BtnZero_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZero.Click Restore(0, False) End Sub 'Se place à la fin de la partie telle qu'elle est enregistrée Private Sub BtnMax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnMax.Click Restore(60) End Sub 'Rejouer une partie sauvegardée dans un fichier Private Sub BtnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRead.Click If OpenFileDialog1.ShowDialog() = DialogResult.OK Then Read(OpenFileDialog1.FileName) End Sub 'Ecriture dans un fichier de la partie en cours Private Sub BtnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnWrite.Click If SaveFileDialog1.ShowDialog() = DialogResult.OK Then Write(SaveFileDialog1.FileName) End Sub 'Rejouer la partie désignée de la base de données Private Sub RecNb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RecNb.ValueChanged If RecNb.Created() Then LoadWTB(RecNb.Value) End Sub
Après toutes ces opérations les différents boutons sont actifs en fonction du contexte du jeu.
Le premier permet, lorsqu'un joueur se trompe de case, de lui indiquer les cases possibles à jouer avec le gain en points pour chaque.
Le deuxième constate, après analyse de parties déjà jouées, que si Noir commence toujours, avec le choix entre quatre cases, ce choix n'a aucune importance sur la stratégie du jeu. Ca ne fait qu'orienter le jeu de manière différente. Nous ajoutons donc une fonction capable de changer cette case initiale pour des jeux existants.
Pour le premier gadget la réalisation est assez simple, il s'agit de créer une nouvelle Sub de Help :
' '==================================================================== ' AIDE AU JEU ' Indique les cases à jouer avec le nombre de pions à gagner Sub Help(ByVal pion As Piece) Dim drawFormat As New StringFormat drawFormat.Alignment = StringAlignment.Center drawFormat.LineAlignment = StringAlignment.Center For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases If table(idx) = Piece.Empty Then ' La case est vide Dim count As Integer = 1 ' Ajoute le pion joué For dir As Direction = 0 To Direction.last ' pour les 8 directions If Search(idx, dir, pion) Then ' Cette direction est valide Dim i As Index = NextPos(idx, dir) ' première case dans la direction 'le premier est toujours a retourner, puisque la direction est valide Do count += 1 'compte les pions a gagner i = NextPos(i, dir) 'extrait la position suivante Loop While table(i) <> pion End If Next If count > 1 Then ' Si un gain, affiche le score de la case Dim r As New Rectangle(IndexToPos(idx), ImageList1.ImageSize) g.DrawString(count.ToString, MyClass.Font(), Brushes.Blue, r, drawFormat) 'ces valeurs ne sont pas memorisées, elles disparaissent facilement End If End If Next End Sub
Il suffit d'en faire l'appel dans la branche de traitement des jeux dans une mauvaise case de PlayingMsg.
Pour le deuxième, il faut modifier le contenu de l'history de toute la partie en transcodant les numéros de cases jouées pour faire les rotations demandées.
' '==================================================================== ' ROTATION DU JEU Sub MakeRotation(ByVal rot As Byte) Debug.Print("makeRotation" & Str(oldSel) & " new" & Str(rot)) If history(0) = 0 Then 'joue la case comme rien n'a encore été joué PlayingMsg(AlphaNumToIndex(ListBox1.Items(rot))) ElseIf rot <> oldSel Then ' oriente le jeu Rotation(oldSel Xor rot) End If End Sub ' Modifie l'orientation du jeu Sub Rotation(ByVal rot As Byte) ' modifie l'history avec la nouvelle orientation For i As Integer = 0 To 59 If history(i) = 0 Then Exit For ' fin history Dim idx As Index = history(i) >> 2 ' index de la case jouée Dim u As Byte = idx \ 8, v As Byte = idx Mod 8, t As Byte ' 90 degres, permutation ligne - colonne If (rot And 1) = 1 Then t = u : u = v : v = t ' 180 degres, complementation lignes et colonnes If (rot And 2) = 2 Then u = 7 - u : v = 7 - v history(i) = ((v + 8 * u) << 2) Or (history(i) And 3) Next Restore(current, False) ' affiche le jeu modifie End Sub ' Indique le premier trait Sub SelectFirstLine() Dim h As Byte = history(0), idx As Index = h >> 2 If h <> 0 Then ' il y a un premier trait de memorise dans l'history Dim nb As Integer = ListBox1.FindString(IndexStr(idx)) ListBox1.SetSelected(nb, True) oldSel = nb Else oldSel = 0 ListBox1.ClearSelected() End If End Sub
Cette fonctionnalité nécessite d'implémenter un nouvel objet ListBox par le processus habituel, nous la plaçons dans une zone libre de la forme et nous modifions les propriétés comme suit :
Propriétés | Listbox1 |
---|---|
CausesValidation | False |
Items | (Collection) |
Location | 238; 161 |
Size | 20; 56 |
Et en cliquant sur (collection) on fait apparaître la fenêtre « Editeur de Collections string » dans lequel on place le nom des cases concernées, une par ligne : d3, c4, e6, f5. De plus on crée l'événement MouseClick correspondant à cette listBox.
' 'Changer l'orientation du jeu Private Sub ListBox1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseClick MakeRotation(sender.IndexFromPoint(e.Location)) End Sub
Enfin la variable globale suivante doit être ajoutée :
' Dim oldSel As Byte = 0 ' sélection du premier trait du jeu
Et ajouter l'appel de « SelectFirstLine() » dans la Sub Display().
Pour le jeu de l'ordinateur, il a été dit au début du texte que c'est une autre paire de manche pour programmer un partenaire de jeu consistant, capable d'appliquer une stratégie, lui permettant de gagner les parties. Mais il est toujours possible de faire un clin d'oeil, puisque nous avons déjà dans le dernier chapitre réalisé un programme capable de déterminer les coups à jouer, il ne reste que faire un semblant de jeu ordinateur en choisissant au hasard l'un de ces coups. Puisqu'il paraît que le hasard fait bien les choses !
Pour cette opération, il faut ajouter un bouton supplémentaire, un timer et une nouvelle variable globale :
' Dim computer As Piece = Piece.Empty ' couleur du jeu ordinateur
Et les programmes suivants :
' '==================================================================== ' JEU ORDINATEUR ' Pseudo jeu ordinateur Function ComputIndex(ByVal pion As Piece) Dim data(20) As Index, n As Integer = 0 data(0) = Index.ovf For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases If CaseCheck(idx, pion) Then data(n) = idx : n += 1 Next ComputIndex = If(n <= 1, data(0), data(Rnd(n))) End Function Sub ComputerPlay() If Player <> Piece.Empty And Player = computer Then Timer1.Start() End Sub
Les propriétés des deux objets :
Propriétés | Button1 | Timer1 |
---|---|---|
Name | BtnComput | |
Location | 249; 236 | |
Size | 69; 22 | |
Text | Computer | |
Interval | 1000 |
Il faut ajouter les événements correspondants :
' 'Jeu ordinateur Private Sub BtnComput_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnComput.Click Randomize() Dim idx As Index = ComputIndex(Player) If computer = Piece.Empty Then computer = Player If idx <> Index.ovf Then PlayingMsg(idx) End Sub Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick Timer1.Stop() Dim idx As Index = ComputIndex(Player) If idx <> Index.ovf Then PlayingMsg(idx) End Sub
Il faut insérer l'appel de ComputerPlay dans la Sub PlayingMsg() :
' ' Joue et affiche le jeu et les messages indiquant la suite Sub PlayingMsg(ByVal idx As Index) Dim count As Integer = Playing(idx, Player) If count > 0 Then 'OK c'est bon, on mémorise et affiche le nouveau jeu SaveStep(idx, Player) Player = NotColor(Player) ' par défaut on change de couleur ComputNext(BackMsg(count, False)) Display() ComputerPlay() ' lance le jeu éventuel de l'ordinateur ElseIf Player <> Piece.Empty Then Messages.Text = "Erreur, " & PieceStr(Player) _ & " doit jouer une case valide !" Help(Player) End If If Player = Piece.Empty Then ' le jeu est fini If MsgBox("Voulez-vous recommencer une autre partie ?", _ MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then Initialize() Display() End If End If End Sub
Le système de développement proposé est assez complet puisqu'il permet de réaliser, entres autres, les informations nécessaires pour réaliser un CD ou une clé USB auto extractible permettant de livrer le jeu à d'autres possesseurs d'ordinateurs.
Pour cette opération, initialisez les options suivantes : Menu Projet, Propriétés d'Othello. Dans la nouvelle fenêtre qui s'affiche choisir l'onglet Publier. Valider « L'application est également disponible hors connexion..., puis cliquez sur Options. Dans la nouvelle fenêtre qui s'affiche, cocher l'option :
« Pour les installations depuis un CD-ROM, démarrer automatiquement... »
Vous pouvez définir un nom éditeur, car il installera le programme sous ce nom, par exemple dans notre cas : Jeux
Puis fermer la fenêtre en cliquant sur OK et lancer :
Générer, Générer Othello
Générer, Publier Othello
Puis cliquez sur les Suivants du Wizard, puis sur Terminer, pour qu'au final, une fenêtre vous montre les fichiers à charger sur le fameux CD.
Ca peut paraître bien tard dans cet exposé d'aborder seulement maintenant cet aspect, fondamental au gout de certains ! Certaines écoles préconisent le test systématique de chaque programme avec la rédaction de fiches de tests dès la phase de l'analyse. Si ces dispositions pouvaient remplir les pages de manuels qualité, elles étaient souvent très peu suivies en pratique et en contradiction avec l'évolution actuelle des outils de développement, notamment sur le plan intuitif et réactif !
Le principal inconvénient de ces méthodes était de passer du temps à tester des erreurs que l'on n'avait pas commises ! Puisque cela concernait des points auxquels on avait déjà réfléchi. Il est vrai que le seul fait de rédiger la fiche de test permettait de corriger les conséquences de certaines faiblesses de l'analyse initiale. Les bugs le plus insidieux correspondent aux situations aux quelles on n'avait pas pensé et dont on n'avait pas envisagé les conséquences.
De plus, Visual Studio nous offre des moyens interactifs assez fins pour corriger les principales fautes de saisie du programme en signalant au moment de l'écriture si la dernière phrase entrée est compréhensible par la machine. Au moment de l'exécution, il vérifie les principales erreurs aux plus graves conséquences, comme l'indice qui sort des limites d'un tableau avec ses risques d'enfoncement mémoire. Ces erreurs sont pernicieuses car elles échappent à toute logique, l'effet n'a pas de rapport immédiat avec la causes. L'exécution d'un programme modifie des données aux quelles il ne devrait pas avoir accès ou pire encore il modifie des instructions d'un autre programme !
Pour le test et la vérification des programmes nous pouvons définir une stratégie avec différents degrés de « lourdeur » suivant la manière où l'anomalie résiste :
' Debug.Print(« text » & Str(x))
Par exemple : où text indique le nom de la fonction, complété de la valeur de la variable x. C'est très pratique dans une architecture événementielle où l'on peut apprécier ainsi l'occurrence et la chronologie des événements. Visual Basic possède une fenêtre spéciale : Fenêtre Exécution qui affiche ces messages. Ces traces peuvent être retirées lorsque les tests sont terminés.
Une autre manière assez astucieuse est d'utiliser l'instruction « Debug.Assert(condition) » qui permet de placer aux endroits stratégiques du programme un test pour vérifier qu'une variable ne sort pas des clous ! C'est particulièrement efficace dans le cas de situations erratiques car cette instruction provoque un break qui permet de tester le contexte au moment de l'erreur.
Cette opération fait appel à une palette graphique standard de Windows : Paint. Ce programme est accessible dans Démarrer, Tous les programmes, Accessoires, Paint.
La première opération consiste à réaliser une Bitmap de l'image par la commande : Fichier, Nouveau, puis par la commande : Image, Attributs, qui ouvre la fenêtre Attributs et définir une Largeur et une Hauteur 230 Pixels. Ceci nous produit un carré blanc de 230 pixels de côté. Il faut s'habituer à parler pixel car on devra positionner sur cette image des pions et il est nécessaire d'être précis au pixel près !
Maintenant il faut tracer la grille, pour cette opération, on sélectionne l'outil ligne et la couleur Noir avec l'épaisseur la plus fine (1 pixel). On se positionne en haut du carré blanc à 15,1. Le 15 est obligatoire, mais le 1 est approximatif. La position s'affiche et se vérifie dans la barre de status au bas-droite de la fenêtre. On enfonce le bouton gauche de la souris et on descend au bas de l'image pour faire une ligne bien verticale (elle ne doit pas avoir de cassure). Au bas on lâche le bouton de la souris et on a dessiné ainsi une ligne bien verticale. Si c'est raté, il est possible d'annuler l'opération par la commande Edition, Annuler.
On continue maintenant avec un x = 41, puis 67, 93, 119, 145, 171, 197, 223. On arrive à un résultat qui ressemble à ceci :
On recommence l'opération avec des lignes horizontales, avec cette fois-ci pour des y biens définis :
y = 15, 41, 67, 93, 119, 145, 171, 197, 223.
On démarre sur le bord gauche à environ x = 1 et on fini sur le bord droite, ce qui nous dessine une grille.
Puis maintenant on sélectionne l'outil gomme de taille moyenne et on entreprend d'effacer traits qui dépassent. Pour plus de précision on peut se mettre en loupe par la commande Affichage, Zoom, Grande taille.
La prochaine étape consiste à doubler le cadre autour de la grille en traçant un trait à l'extérieur contre la grille.
Maintenant il faut marquer les cases, pour cette opération il faut augmenter la taille de l'image en hauteur par exemple en programmant la hauteur à 340. Puis dans la zone blanche en bas de l'image il faut rentrer le texte nécessaire sous forme de deux lignes composées de 'a', espace, 'b',... 'h' pour la première et '1', espace, '2' espace,... '8' pour la seconde en choisissant la police « Fixedsys 8 Occidental ». Il reste d'utiliser l'outil sélection rectangle pour transporter chacune de ces indications à la bonne place. C'est plus facile et précis en se plaçant en Zoom ! L'opération terminée, on revient à la taille initiale de l'image.
Pour le fun, il reste à ajouter les petits carrés noirs en bas des cases b2, f2, b6, et f6. Il reste à sauvegarder l'image sous son nom définitif et on peut choisir de réduire la définition de couleur à bitmap 16 couleurs.
Cela devient un jeu d'enfant, par rapport à l'image du jeu. Il faut utiliser pour chaque des bitmap de 23 x 23 pixels et dessiner sur chacune comme suit. La couleur rouge indique les zones de transparence :
' '=============================================================== ' <auto-generated> ' Ce code a été généré par un outil. ' Version du runtime :2.0.50727.3623 ' ' Les modifications apportées à ce fichier peuvent provoquer un comportement incorrect et seront perdues si ' le code est régénéré. ' </auto-generated> '=============================================================== Option Strict On Option Explicit On Imports System Namespace My.Resources 'Cette classe a été générée automatiquement par la classe StronglyTypedResourceBuilder 'à l'aide d'un outil, tel que ResGen ou Visual Studio. 'Pour ajouter ou supprimer un membre, modifiez votre fichier .ResX, puis réexécutez ResGen 'avec l'option /str ou régénérez votre projet VS. '''<summary> ''' Une classe de ressource fortement typée destinée, entre autres, à la consultation des chaînes localisées. '''</summary> <Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "2.0.0.0"), _ Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _ Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _ Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _ Friend Module Resources Private resourceMan As Global.System.Resources.ResourceManager Private resourceCulture As Global.System.Globalization.CultureInfo '''<summary> ''' Retourne l'instance ResourceManager mise en cache utilisée par cette classe. '''</summary> <Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _ Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager Get If Object.ReferenceEquals(resourceMan, Nothing) Then Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("Othello.Resources", GetType(Resources).Assembly) resourceMan = temp End If Return resourceMan End Get End Property '''<summary> ''' Remplace la propriété CurrentUICulture du thread actuel pour toutes ''' les recherches de ressources à l'aide de cette classe de ressource fortement typée. '''</summary> <Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _ Friend Property Culture() As Global.System.Globalization.CultureInfo Get Return resourceCulture End Get Set resourceCulture = value End Set End Property Friend ReadOnly Property BmOthellier() As System.Drawing.Bitmap Get Dim obj As Object = ResourceManager.GetObject("BmOthellier", resourceCulture) Return CType(obj,System.Drawing.Bitmap) End Get End Property Friend ReadOnly Property BmOthelloBlack() As System.Drawing.Bitmap Get Dim obj As Object = ResourceManager.GetObject("BmOthelloBlack", resourceCulture) Return CType(obj,System.Drawing.Bitmap) End Get End Property Friend ReadOnly Property BmOthelloEmpty() As System.Drawing.Bitmap Get Dim obj As Object = ResourceManager.GetObject("BmOthelloEmpty", resourceCulture) Return CType(obj,System.Drawing.Bitmap) End Get End Property Friend ReadOnly Property BmOthelloWhite() As System.Drawing.Bitmap Get Dim obj As Object = ResourceManager.GetObject("BmOthelloWhite", resourceCulture) Return CType(obj,System.Drawing.Bitmap) End Get End Property End Module End Namespace <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ Partial Class Form1 Inherits System.Windows.Forms.Form 'Form remplace la méthode Dispose pour nettoyer la liste des composants. <System.Diagnostics.DebuggerNonUserCode()> _ Protected Overrides Sub Dispose(ByVal disposing As Boolean) Try If disposing AndAlso components IsNot Nothing Then components.Dispose() End If Finally MyBase.Dispose(disposing) End Try End Sub 'Requise par le Concepteur Windows Form Private components As System.ComponentModel.IContainer 'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form 'Elle peut être modifiée à l'aide du Concepteur Windows Form. 'Ne la modifiez pas à l'aide de l'éditeur de code. <System.Diagnostics.DebuggerStepThrough()> _ Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(Form1)) Me.Messages = New System.Windows.Forms.TextBox Me.ScoreBlack = New System.Windows.Forms.TextBox Me.ScoreWhite = New System.Windows.Forms.TextBox Me.BtnZero = New System.Windows.Forms.Button Me.BtnFor = New System.Windows.Forms.Button Me.BtnBack = New System.Windows.Forms.Button Me.BtnWrite = New System.Windows.Forms.Button Me.BtnRead = New System.Windows.Forms.Button Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components) Me.OpenFileDialog1 = New System.Windows.Forms.OpenFileDialog Me.SaveFileDialog1 = New System.Windows.Forms.SaveFileDialog Me.BtnMax = New System.Windows.Forms.Button Me.RecNb = New System.Windows.Forms.NumericUpDown Me.Timer1 = New System.Windows.Forms.Timer(Me.components) Me.BtnComput = New System.Windows.Forms.Button Me.ListBox1 = New System.Windows.Forms.ListBox CType(Me.RecNb, System.ComponentModel.ISupportInitialize).BeginInit() Me.SuspendLayout() ' 'Messages ' Me.Messages.Location = New System.Drawing.Point(238, 12) Me.Messages.Multiline = True Me.Messages.Name = "Messages" Me.Messages.ReadOnly = True Me.Messages.Size = New System.Drawing.Size(156, 84) Me.Messages.TabIndex = 0 Me.Messages.TabStop = False ' 'ScoreBlack ' Me.ScoreBlack.Location = New System.Drawing.Point(238, 102) Me.ScoreBlack.Name = "ScoreBlack" Me.ScoreBlack.ReadOnly = True Me.ScoreBlack.Size = New System.Drawing.Size(156, 20) Me.ScoreBlack.TabIndex = 1 Me.ScoreBlack.TabStop = False ' 'ScoreWhite ' Me.ScoreWhite.Location = New System.Drawing.Point(238, 128) Me.ScoreWhite.Name = "ScoreWhite" Me.ScoreWhite.ReadOnly = True Me.ScoreWhite.Size = New System.Drawing.Size(156, 20) Me.ScoreWhite.TabIndex = 2 Me.ScoreWhite.TabStop = False ' 'BtnZero ' Me.BtnZero.Location = New System.Drawing.Point(29, 236) Me.BtnZero.Name = "BtnZero" Me.BtnZero.Size = New System.Drawing.Size(40, 22) Me.BtnZero.TabIndex = 3 Me.BtnZero.Text = "0 <<" Me.BtnZero.UseVisualStyleBackColor = True ' 'BtnFor ' Me.BtnFor.Location = New System.Drawing.Point(75, 236) Me.BtnFor.Name = "BtnFor" Me.BtnFor.Size = New System.Drawing.Size(40, 22) Me.BtnFor.TabIndex = 4 Me.BtnFor.Text = ">>" Me.BtnFor.UseVisualStyleBackColor = True ' 'BtnBack ' Me.BtnBack.Location = New System.Drawing.Point(121, 236) Me.BtnBack.Name = "BtnBack" Me.BtnBack.Size = New System.Drawing.Size(40, 22) Me.BtnBack.TabIndex = 5 Me.BtnBack.Text = "<<" Me.BtnBack.UseVisualStyleBackColor = True ' 'BtnWrite ' Me.BtnWrite.Location = New System.Drawing.Point(285, 195) Me.BtnWrite.Name = "BtnWrite" Me.BtnWrite.Size = New System.Drawing.Size(52, 22) Me.BtnWrite.TabIndex = 6 Me.BtnWrite.Text = "Write" Me.BtnWrite.UseVisualStyleBackColor = True ' 'BtnRead ' Me.BtnRead.Location = New System.Drawing.Point(342, 195) Me.BtnRead.Name = "BtnRead" Me.BtnRead.Size = New System.Drawing.Size(52, 22) Me.BtnRead.TabIndex = 7 Me.BtnRead.Text = "Read" Me.BtnRead.UseVisualStyleBackColor = True ' 'ImageList1 ' Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer) Me.ImageList1.TransparentColor = System.Drawing.Color.Red Me.ImageList1.Images.SetKeyName(0, "BmOthelloEmpty.bmp") Me.ImageList1.Images.SetKeyName(1, "BmOthelloBlack.bmp") Me.ImageList1.Images.SetKeyName(2, "BmOthelloWhite.bmp") ' 'OpenFileDialog1 ' Me.OpenFileDialog1.FileName = "Othello.oth" Me.OpenFileDialog1.Filter = "Othello (*.oth)|*.oth|Base de données (*.wtb)|*.wtb|Texte (*.txt)|*.txt|All (*.*)" & _ "|*.*" ' 'SaveFileDialog1 ' Me.SaveFileDialog1.FileName = "Othello.oth" Me.SaveFileDialog1.Filter = "Othello (*.oth)|*.oth|Texte (*.txt)|*.txt|All (*.*)|*.*" ' 'BtnMax ' Me.BtnMax.Location = New System.Drawing.Point(167, 236) Me.BtnMax.Name = "BtnMax" Me.BtnMax.Size = New System.Drawing.Size(40, 22) Me.BtnMax.TabIndex = 8 Me.BtnMax.Text = ">> |" Me.BtnMax.UseVisualStyleBackColor = True ' 'RecNb ' Me.RecNb.Enabled = False Me.RecNb.Location = New System.Drawing.Point(342, 223) Me.RecNb.Minimum = New Decimal(New Integer() {1, 0, 0, 0}) Me.RecNb.Name = "RecNb" Me.RecNb.Size = New System.Drawing.Size(52, 20) Me.RecNb.TabIndex = 11 Me.RecNb.Value = New Decimal(New Integer() {1, 0, 0, 0}) ' 'Timer1 ' Me.Timer1.Interval = 1000 ' 'BtnComput ' Me.BtnComput.Location = New System.Drawing.Point(249, 236) Me.BtnComput.Name = "BtnComput" Me.BtnComput.Size = New System.Drawing.Size(69, 22) Me.BtnComput.TabIndex = 12 Me.BtnComput.Text = "Computer" Me.BtnComput.UseVisualStyleBackColor = True ' 'ListBox1 ' Me.ListBox1.CausesValidation = False Me.ListBox1.Items.AddRange(New Object() {"d3", "c4", "e6", "f5"}) Me.ListBox1.Location = New System.Drawing.Point(238, 161) Me.ListBox1.Name = "ListBox1" Me.ListBox1.Size = New System.Drawing.Size(20, 56) Me.ListBox1.TabIndex = 15 ' 'Form1 ' Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.BackgroundImage = CType(resources.GetObject("$this.BackgroundImage"), System.Drawing.Image) Me.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None Me.ClientSize = New System.Drawing.Size(408, 270) Me.Controls.Add(Me.ListBox1) Me.Controls.Add(Me.BtnComput) Me.Controls.Add(Me.RecNb) Me.Controls.Add(Me.BtnMax) Me.Controls.Add(Me.BtnRead) Me.Controls.Add(Me.BtnWrite) Me.Controls.Add(Me.BtnBack) Me.Controls.Add(Me.BtnFor) Me.Controls.Add(Me.BtnZero) Me.Controls.Add(Me.ScoreWhite) Me.Controls.Add(Me.ScoreBlack) Me.Controls.Add(Me.Messages) Me.Name = "Form1" Me.Text = "Othello" CType(Me.RecNb, System.ComponentModel.ISupportInitialize).EndInit() Me.ResumeLayout(False) Me.PerformLayout() End Sub Friend WithEvents Messages As System.Windows.Forms.TextBox Friend WithEvents ScoreBlack As System.Windows.Forms.TextBox Friend WithEvents ScoreWhite As System.Windows.Forms.TextBox Friend WithEvents BtnZero As System.Windows.Forms.Button Friend WithEvents BtnFor As System.Windows.Forms.Button Friend WithEvents BtnBack As System.Windows.Forms.Button Friend WithEvents BtnWrite As System.Windows.Forms.Button Friend WithEvents BtnRead As System.Windows.Forms.Button Friend WithEvents ImageList1 As System.Windows.Forms.ImageList Friend WithEvents OpenFileDialog1 As System.Windows.Forms.OpenFileDialog Friend WithEvents SaveFileDialog1 As System.Windows.Forms.SaveFileDialog Friend WithEvents BtnMax As System.Windows.Forms.Button Friend WithEvents RecNb As System.Windows.Forms.NumericUpDown Friend WithEvents Timer1 As System.Windows.Forms.Timer Friend WithEvents BtnComput As System.Windows.Forms.Button Friend WithEvents ListBox1 As System.Windows.Forms.ListBox End Class Public Class Form1 Dim g As Graphics ' position de l'Othellier dans l'image (et dans Form1) Const ofsX = 17, OfsY = 17, oWidth = 208, oHeight = 208 '=============================================================== ' Etat du jeu Enum Index As Byte ' positions caracteristiques sur l'Othellier a1 = 0 ' premiere case du jeu h8 = 63 ' derniere case du jeu d4 = 8 * 3 + 3 ' cases centrales de depart d5 = 8 * 3 + 4 e4 = 8 * 4 + 3 e5 = 8 * 4 + 4 ovf = 64 'valeur utilisee pour signifier le bord du jeu, hors Othellier End Enum Enum Piece As Byte ' differentes valeurs possibles d'une case du jeu Empty Black White Border ' valeur de la case Index.ovf End Enum ' Etat courant du jeu : etat des 64 cases du jeu, plus une, reservee pour signaler Dim table(Index.ovf) As Piece 'le bord de l'Othellier lors des deplacements Dim current As Integer 'le numero du coup joue (1, 2,...) Dim Player As Piece 'la couleur du pion qui doit jouer (Piece.Empty = partie terminee) Dim history(60) As Byte 'memoire des coups joues, termine par une case a zero '=============================================================== ' Mouvements sur l'Othellier dans les 8 directions Enum Direction As Byte ' Les 8 directions de mouvements sur l'Othellier (0..7) North NorthEast East SouthEast South SouthWest West NorthWest last = 7 End Enum '=============================================================== Dim db As Byte() 'Base de donnees de jeu, chargee par ReadWTB() Dim oldSel As Byte = 0 ' selection du premier trait du jeu Dim computer As Piece = Piece.Empty ' couleur du jeu ordinateur '=============================================================== 'Tables utilisees pour convertir un index en texte designant la case ("a1".."h8") Const tchar As String = "abcdefgh" Const tnum As String = "12345678" '=============================================================== ' SOUS PROGRAMMES ET FONCTIONS ' Conversion d'un index (dans la table de jeu) en position dans l'affichage Function IndexToPos(ByVal idx As Index) As Point If idx = Index.ovf Then IndexToPos.X = -1 : IndexToPos.Y = -1 Else IndexToPos.X = ((idx And 7) * oWidth) \ 8 + ofsX IndexToPos.Y = ((idx >> 3) * oHeight) \ 8 + OfsY End If End Function ' Conversion d'une position dans l'affichage en index dans la table (de jeu) Function PosToIndex(ByVal pos As Point) As Index pos.X -= ofsX : pos.Y -= OfsY If pos.X >= 0 And pos.X < oWidth And pos.Y >= 0 And pos.Y < oHeight Then PosToIndex = ((pos.X * 8) \ oWidth) + 8 * ((pos.Y * 8) \ oHeight) Else PosToIndex = Index.ovf End If End Function ' Conversion d'un index (dans la table de jeu) en texte de position alphaNum Function IndexStr(ByVal idx As Index) As String 'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ... IndexStr = If(idx >= 0 AndAlso idx < 64, _ tchar.Chars(idx Mod 8) & tnum.Chars(idx \ 8), "??") End Function ' Conversion d'un texte de position alphaNum en index dans la table de jeu Function AlphaNumToIndex(ByVal str As String) As Index 'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ... str = str.Trim(" "",;'").ToLower() + " " 'nettoyage du texte Dim u As Integer = tchar.IndexOf(str.Chars(0)) 'premier car. (a..h) nom colonnes Dim v As Integer = tnum.IndexOf(str.Chars(1)) '2eme car (1..8) nom lignes AlphaNumToIndex = If(u >= 0 And v >= 0, u + 8 * v, Index.ovf) End Function ' Conversion d'un no de case exprime en decimal (11..88) en Index Function NumToIndex(ByVal val As Byte) As Index ' codage : 11=a1(0), 18=h1(7), 21=a2(8), 81=a8(56), 88=h8(63), utilise par WTB Dim u As Integer = val \ 10 - 1 ' dizaines Dim v As Integer = val Mod 10 - 1 ' unites NumToIndex = If(u >= 0 And v >= 0 And u < 8 And v < 8, v + 8 * u, Index.ovf) End Function ' Calcul de la position suivante pour un deplacement sur l'Othellier Function NextPos(ByVal idx As Index, ByVal dir As Direction) As Index 'suivant la position de depart et la direction, on peut sortir de l'Othellier Select Case dir Case Direction.North NextPos = If(idx \ 8 = 0, Index.ovf, idx - 8) Case Direction.NorthEast NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 0, Index.ovf, idx - 7) Case Direction.East NextPos = If(idx Mod 8 = 7, Index.ovf, idx + 1) Case Direction.SouthEast NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 7, Index.ovf, idx + 9) Case Direction.South NextPos = If(idx \ 8 = 7, Index.ovf, idx + 8) Case Direction.SouthWest NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 7, Index.ovf, idx + 7) Case Direction.West NextPos = If(idx Mod 8 = 0, Index.ovf, idx - 1) Case Direction.NorthWest NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 0, Index.ovf, idx - 9) End Select End Function ' Retournement d'un pion Function NotColor(ByVal pion As Piece) As Piece Select Case pion Case Piece.Black NotColor = Piece.White Case Piece.White NotColor = Piece.Black Case Else ' pour les autres etats pas de changement NotColor = pion End Select End Function ' Conversion en text du nom du pion joueur Function PieceStr(ByVal pion As Piece) As String If pion = Piece.Black Then Return "Noir" If pion = Piece.White Then Return "Blanc" Else Return "" End Function ' Affichage de l'entete de la base de donnees (si elle est chargee) Function DbHeader(ByVal nb As Integer) As String DbHeader = "" Try Dim year As Integer = db(10) + db(11) * 256 Dim nbMax As Integer = (db.Length - 16) \ 68 DbHeader = "Année" & Str(year) DbHeader &= If(nb > 0, ", partie" & Str(nb) & " /" & Str(nbMax), _ ", comportant" & Str(nbMax) & " parties") Catch End Try End Function ' Invite une couleur a jouer Function PromptPlayer(ByVal m As Byte) As String If m = 0 Then PromptPlayer = "C'est maintenant à " & PieceStr(Player) & " de jouer." ElseIf m = 1 Then PromptPlayer = "Et " & PieceStr(Player) & " continue de jouer." Else PromptPlayer = "Et " & PieceStr(Player) & " abandonne !" End If End Function ' Change la couleur du joueur si c'est necessaire et sortie du message d'invite a jouer ou de fin Sub ComputNext(ByVal text As String, Optional ByVal db As Boolean = False) Dim flg As Byte = If(db, 2, 0) Messages.Text = text & vbCrLf If CanPlay(Player) Then Messages.Text &= PromptPlayer(flg) ElseIf CanPlay(NotColor(Player)) Then 'la couleur adverse ne peut jouer, continue la meme couleur Player = NotColor(Player) Messages.Text &= PromptPlayer(flg + 1) Else 'fin du jeu, aucun des pions ne pouvant jouer Player = Piece.Empty ' indique la fin de la partie Messages.Text &= ScoreEndOfPlay() End If End Sub ' Edite le score de fin de jeu Function ScoreEndOfPlay() As String Dim noir As Byte = CountPions(Piece.Black) Dim blanc As Byte = CountPions(Piece.White) If noir > blanc Then Return " Et Noir gagne " & Str(64 - blanc) & " à " & Str(blanc) & "." If blanc > noir Then Return " Et Blanc gagne " & Str(64 - noir) & " à " & Str(noir) & "." Return " Et le jeu se termine match null " & Str(noir) & " à " & Str(blanc) & "." End Function ' Sortie du message de fin d'un coup Function BackMsg(ByVal count As Integer, ByVal back As Boolean) As String Dim h As Byte = history(current - 1), idx As Index = h >> 2, pion As Piece = h And 3 If back Then BackMsg = " Au coup précédent, " Else BackMsg = "" BackMsg &= PieceStr(pion) & " a joué " & IndexStr(idx) _ & " et gagne " & count.ToString & " points." End Function ' Sorie du message de coup supprime Function SuppressMsg(ByVal en As Boolean) As String Dim h As Byte = history(current), idx As Index = h >> 2, pion As Piece = h And 3 SuppressMsg = If(en And pion <> Piece.Empty, "Le jeu " & PieceStr(pion) _ & " en " & IndexStr(idx) & " est annulé.", "") End Function ' Message ajoutant le compte des cases vides Function VidesMsg(ByVal total As Byte) As String VidesMsg = If(total = 64, "", " + " + Str(64 - total)) End Function ' Compte les points d'une couleur donnee Function CountPions(ByVal pion As Piece) As Byte CountPions = 0 For i As Index = Index.a1 To Index.h8 If table(i) = pion Then CountPions += 1 Next End Function '=============================================================== ' JEU ' initialise et demarre le jeu Sub Initialize() InitTable() computer = Piece.Empty 'Ordinateur ne joue pas history(0) = 0 'vide la memoire des coups joues Messages.Text = "Début du jeu :" & vbCrLf & PromptPlayer(0) End Sub ' Initialisation de la table du jeu Sub InitTable() For i As Index = Index.a1 To Index.h8 table(i) = Piece.Empty Next table(Index.d4) = Piece.White table(Index.d5) = Piece.Black table(Index.e4) = Piece.Black table(Index.e5) = Piece.White table(Index.ovf) = Piece.Border current = 0 'annule le compte de coups joues, mais pas la memoire history des coups ! Player = Piece.Black ' Noir commence toujours la partie End Sub ' Recherche si, dans une direction donnee, le retournement de pions adverses est possible Function Search(ByVal idx As Index, ByVal dir As Direction, ByVal pion As Piece) As Boolean Dim notPion As Piece = NotColor(pion) ' couleur pion adverse 'il faut, au moins, qu'a la premiere case parcourue, le pion rencontre soit adverse idx = NextPos(idx, dir) If table(idx) <> notPion Then Return False Do 'cherche la fin des pions adverses dans la direction idx = NextPos(idx, dir) Loop While table(idx) = notPion 'la case suivante, dans la direction, doit etre occupee par un pion de la couleur Return CBool(table(idx) = pion) End Function ' Teste si le jeu de cette case avec cette couleur de pion est possible Function CaseCheck(ByVal idx As Index, ByVal pion As Piece) As Boolean If table(idx) <> Piece.Empty Then Return False 'la case n'est pas vide For dir As Direction = 0 To Direction.last 'dans les 8 directions If Search(idx, dir, pion) Then Return True 'cherche une ou le jeu est possible Next Return False End Function ' Teste si le jeux est possible pour cette couleur de pion Function CanPlay(ByVal pion As Piece) As Boolean For idx As Index = Index.a1 To Index.h8 'teste toutes les cases If CaseCheck(idx, pion) Then Return True Next CanPlay = False End Function ' Place un nouveau pion dans le jeu (si possible), indique le nombre de pions gagnes Function Playing(ByVal idx As Index, ByVal pion As Piece) As Integer Playing = 1 ' on compte le pion joue If table(idx) = Piece.Empty Then ' La case est vide For dir As Direction = 0 To Direction.last ' pour les 8 directions If Search(idx, dir, pion) Then ' Cette direction est valide Dim i As Index = NextPos(idx, dir) ' premiere case dans la direction 'le premier est toujours a retourner, puisque la direction est valide Do table(i) = pion 'retourne les pions dans cette direction Playing += 1 'compte les pions retournes i = NextPos(i, dir) 'extrait la position suivante Loop While table(i) <> pion 'termine sur un pion de sa couleur End If Next End If 'Si la case de depart (idx) est mal choisie, aucun pion n'est retourne If Playing > 1 Then table(idx) = pion Else Playing = 0 End Function ' Affiche le jeu Sub Display() Dim noir As Byte = CountPions(Piece.Black) Dim blanc As Byte = CountPions(Piece.White) ' Affiche l'etat des cases du jeu For i As Index = Index.a1 To Index.h8 ImageList1.Draw(g, IndexToPos(i), table(i)) Next ' Affiche le score actuel du jeu If Player <> Piece.Empty OrElse noir = blanc Then 'partie en cours ou match null ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions" ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions" ElseIf noir > blanc Then 'partie terminee, Noir gagne ScoreBlack.Text = "Noir gagne : " + Str(noir) + " pions" + VidesMsg(noir + blanc) ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions" Else 'partie terminee, Blanc gagne ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions" ScoreWhite.Text = "Blanc gagne : " + Str(blanc) + " pions" + VidesMsg(noir + blanc) End If ' Etat des boutons qui dependent du jeu BtnBack.Enabled = (current <> 0) 'touche Back BtnFor.Enabled = (history(current) <> 0) 'touche For BtnZero.Enabled = (current <> 0) 'touche Mise a zero BtnMax.Enabled = (history(current) <> 0) 'touche Mise au max BtnWrite.Enabled = history(0) <> 0 'touche Write SelectFirstLine() ' affiche le premier trait End Sub ' Joue et affiche le jeu et les messages indiquant la suite Sub PlayingMsg(ByVal idx As Index) Dim count As Integer = Playing(idx, Player) If count > 0 Then 'OK c'est bon, on memorise et affiche le nouveau jeu SaveStep(idx, Player) Player = NotColor(Player) ' par defaut on change de couleur ComputNext(BackMsg(count, False)) Display() ComputerPlay() ' lance le jeu eventuel de l'ordinateur ElseIf Player <> Piece.Empty Then Messages.Text = "Erreur, " & PieceStr(Player) _ & " doit jouer une case valide !" Help(Player) End If If Player = Piece.Empty Then ' le jeu est fini If MsgBox("Voulez-vous recommencer une autre partie ?", _ MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then Initialize() Display() End If End If End Sub '=============================================================== ' HISTORY ' Sauvegarde du coup dans l'history Sub SaveStep(ByVal idx As Index, ByVal pion As Piece) history(current) = (idx << 2) Or (pion And 3) current += 1 history(current) = 0 ' indicateur de fin de l'history End Sub ' Lecture de l'etat du jeu, a un pas quelconque, a partir de l'history Sub Restore(ByVal curStep As Integer, Optional ByVal back As Boolean = True) Dim idx, count As Byte InitTable() Do While current < curStep AndAlso history(current) <> 0 idx = history(current) : Player = idx And 3 : idx >>= 2 count = Playing(idx, Player) ' replace les pions comme ils ont deja ete joues current += 1 Loop If current = 0 Then Messages.Text = "Retour au début du jeu :" & vbCrLf & PromptPlayer(0) Else Dim msg As String = SuppressMsg(back) & BackMsg(count, back) Player = NotColor(Player) ' Normalement on change de couleur a chaque coup ComputNext(msg) End If Display() 'Affiche le jeu End Sub '=============================================================== ' LECTURE / ECRITURE FICHIER Sub Read(ByRef filename As String) If Strings.Right(filename, 4).ToLower() = ".wtb" Then ReadWTB(filename) Else ReadAscii(filename) End Sub ' Lecture d'une partie a partir d'un fichier ascii Sub ReadAscii(ByRef fileName As String) Dim comments As String = "", line As String = "", nb As Integer = 0 InitTable() history(0) = 0 ' vide la memoire de l'history Try FileOpen(1, fileName, OpenMode.Input) While Not EOF(1) line = LineInput(1) : nb += 1 Dim idx As Index = AlphaNumToIndex(line) If idx <> Index.ovf Then 'Le numero de la case est valide, determine la couleur If Not CaseCheck(idx, Player) Then Player = NotColor(Player) If Playing(idx, Player) = 0 Then Err.Raise(6) 'le coup est illegal ! SaveStep(idx, Player) Player = NotColor(Player) ElseIf line.Length() > 1 And line(0) = "'" Then comments = line.Substring(1) & " : " End If End While ComputNext(comments) 'Affiche le message de presentation de la partie Catch Messages.Text = If(current > 0, Str(current) & " coups lus", "") InitTable() MsgBox(fileName & vbCrLf & If(nb > 0, comments & vbCrLf & line & _ " >> Erreur à la ligne" & Str(nb), "Erreur de lecture !")) Finally FileClose(1) End Try Display() 'Affiche le nouveau jeu End Sub 'Chargement de la base de donnees Sub ReadWTB(ByRef fileName As String) Dim nb As Integer = 0 Try db = My.Computer.FileSystem.ReadAllBytes(fileName) If db.Length > 16 Then nb = (db.Length - 16) \ 68 Catch MsgBox(fileName & vbCrLf & "Erreur de lecture !") db = Nothing End Try If nb > 0 Then Dim year As Integer = db(10) + db(11) * 256 RecNb.Maximum = nb RecNb.Value = 1 : LoadWTB(1) ' par defaut on charge le no 1 Messages.Text = "Le fichier " & fileName & vbCrLf & DbHeader(0) & " est chargé." RecNb.Enabled = True Else RecNb.Enabled = False End If End Sub 'Chargement du record nb a partir de la base de donnees Sub LoadWTB(ByVal nb As Integer) Dim n As Integer = nb * 68 + 16 - 60 ' position indice dans la base de donnees If n >= 16 And n + 59 < db.Length Then InitTable() history(0) = 0 ' vide la memoire de l'history For i As Integer = 0 To 59 Dim idx As Index = NumToIndex(db(n + i)) If Not CanPlay(Player) Then Player = NotColor(Player) If Playing(idx, Player) = 0 Then Exit For ' fin de la partie SaveStep(idx, Player) Player = NotColor(Player) Next 'Affiche le message de presentation, avec mention d'abandon si jeu non fini ComputNext(DbHeader(nb) & " est chargée.", True) Display() ' Affiche le nouveau jeu End If End Sub ' Sauvegarde le jeu courant dans un fichier Sub Write(ByRef FileName As String) Dim comments As String = InputBox("Voullez-vous ajouter un commentaire" & _ vbCrLf & " dans le fichier ?", "", DbHeader(RecNb.Value)) Try FileOpen(2, FileName, OpenMode.Output) If comments <> "" Then PrintLine(2, "'" & comments) ' Sortie de la liste des cases jouees For i As Integer = 0 To 60 Dim idx As Index = history(i) If idx = 0 Then Exit For ' fin du jeu PrintLine(2, IndexStr(idx >> 2)) Next Catch MsgBox(FileName & vbCrLf & " Erreur d'écriture !") Finally FileClose(2) End Try End Sub '=============================================================== ' AIDE AU JEU ' Indique les cases a jouer avec le nombre de pions a gagner Sub Help(ByVal pion As Piece) Dim drawFormat As New StringFormat drawFormat.Alignment = StringAlignment.Center drawFormat.LineAlignment = StringAlignment.Center For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases If table(idx) = Piece.Empty Then ' La case est vide Dim count As Integer = 1 ' Ajoute le pion joue For dir As Direction = 0 To Direction.last ' pour les 8 directions If Search(idx, dir, pion) Then ' Cette direction est valide Dim i As Index = NextPos(idx, dir) ' premiere case dans la direction 'le premier est toujours a retourner, puisque la direction est valide Do count += 1 'compte les pions a gagner i = NextPos(i, dir) 'extrait la position suivante Loop While table(i) <> pion End If Next If count > 1 Then ' Si un gain, affiche le score de la case Dim r As New Rectangle(IndexToPos(idx), ImageList1.ImageSize) g.DrawString(count.ToString, MyClass.Font(), Brushes.Blue, r, drawFormat) 'ces valeurs ne sont pas memorisees elles disparaissent facilement End If End If Next End Sub '=============================================================== ' ROTATION DU JEU Sub MakeRotation(ByVal rot As Byte) If history(0) = 0 Then 'joue la case comme rien n'a encore ete joue PlayingMsg(AlphaNumToIndex(ListBox1.Items(rot))) ElseIf rot <> oldSel Then ' oriente le jeu Rotation(oldSel Xor rot) End If End Sub ' Modifie l'orientation du jeu Sub Rotation(ByVal rot As Byte) ' modifie l'history avec la nouvelle orientation For i As Integer = 0 To 59 If history(i) = 0 Then Exit For ' fin history Dim idx As Index = history(i) >> 2 ' index de la case jouee Dim u As Byte = idx \ 8, v As Byte = idx Mod 8, t As Byte ' 90 degres, permutation ligne - colonne If (rot And 1) = 1 Then t = u : u = v : v = t ' 180 degres, complementation lignes et colonnes If (rot And 2) = 2 Then u = 7 - u : v = 7 - v history(i) = ((v + 8 * u) << 2) Or (history(i) And 3) Next Restore(current, False) ' affiche le jeu modifie End Sub ' Indique le premier trait Sub SelectFirstLine() Dim h As Byte = history(0), idx As Index = h >> 2 If h <> 0 Then ' il y a un premier trait de memorise dans l'history Dim nb As Integer = ListBox1.FindString(IndexStr(idx)) ListBox1.SetSelected(nb, True) oldSel = nb Else oldSel = 0 ListBox1.ClearSelected() End If End Sub '=============================================================== ' JEU ORDINATEUR ' Pseudo jeu ordinateur Function ComputIndex(ByVal pion As Piece) Dim data(20) As Index, n As Integer = 0 data(0) = Index.ovf For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases If CaseCheck(idx, pion) Then data(n) = idx : n += 1 Next ComputIndex = If(n <= 1, data(0), data(Rnd(n))) End Function Sub ComputerPlay() If Player <> Piece.Empty And Player = computer Then Timer1.Start() End Sub '=============================================================== ' EVENEMENTS... Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Initialize() End Sub Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint g = Me.CreateGraphics() Display() End Sub ' Place le pion sur l'Othellier a la suite d'un clic souris Private Sub Form1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick Dim idx As Index = PosToIndex(e.Location) Timer1.Stop() If idx <> Index.ovf Then PlayingMsg(idx) End Sub 'Avancer au pas suivant de la partie Private Sub BtnFor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFor.Click Restore(current + 1, False) End Sub 'Reculer d'un pas dans la partie Private Sub BtnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBack.Click Restore(current - 1) End Sub 'Remise de la partie au début Private Sub BtnZero_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZero.Click Restore(0, False) End Sub 'Se place a la fin de la partie telle qu'elle est enregistree Private Sub BtnMax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnMax.Click Restore(60) End Sub 'Rejouer une partie sauvegardée dans un fichier Private Sub BtnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRead.Click If OpenFileDialog1.ShowDialog() = DialogResult.OK Then Read(OpenFileDialog1.FileName) End Sub 'Sauvegarde dans un fichier de la partie en cours Private Sub BtnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnWrite.Click If SaveFileDialog1.ShowDialog() = DialogResult.OK Then Write(SaveFileDialog1.FileName) End Sub 'Rejouer la partie designee de la base de donnees Private Sub RecNb_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RecNb.ValueChanged, RecNb.Click If RecNb.Created() Then LoadWTB(RecNb.Value) End Sub 'Changer l'orientation du jeu Private Sub ListBox1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseClick MakeRotation(sender.IndexFromPoint(e.Location)) End Sub 'Jeu ordinateur Private Sub BtnComput_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnComput.Click Randomize() Dim idx As Index = ComputIndex(Player) If computer = Piece.Empty Then computer = Player If idx <> Index.ovf Then PlayingMsg(idx) End Sub Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick Timer1.Stop() Dim idx As Index = ComputIndex(Player) If idx <> Index.ovf Then PlayingMsg(idx) End Sub End Class