Public Class frmTrois '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '| | '| TROIS PTITS OURS | '| par Martin Robinson | '| | '| Table des matière | '| 1.0 Les constantes | '| 1.1 Les Modules | '| 1.2 Les Evenements | '| 1.2.0 Démarrage du programme | '| 1.2.1 Fin du programme | '| 1.2.2 Quand l'utilisateur stocke une tuile | '| 1.2.3 Les cliques sur la grille de jeu | '| 1.2.4 Petit timeur pour les événements | '| 1.2.6 L'utilisateur TRICHE | '| 1.2.5 Imprimer | '| 2.0 Les Fonctions | '| 2.0.0 Nouvelle partie | '| 2.0.1 Fin de la partie | '| 2.0.2 Le choix aléatoire des pièce à placer | '| 2.0.3 Verification si la grille est pleine | '| 2.0.4 Placer une piece | '| 2.0.4.1 Placer une piece oridinaire | '| 2.0.4.2 Placer un ours | '| 2.0.4.3 Placer un diamand | '| 3.0 sous-fonction | '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| '________________________________________________________________________________ '| 1.0 Les constantes | '|______________________________________________________________________________| Const mtagVide = 0 Const mtagBalais = 1 Const mtagOursPolaire = 2 Const mtagPandaKungfu = 3 Const mtagOurs = 4 Const mtagGrave = 5 Const mtagEglise = 6 Const mtagCathedral = 7 Const mtagCoin = 8 Const mtagGrass = 9 Const mtagBush = 10 Const mtagTree = 11 Const mtagMaison = 12 Const mtagBloc = 13 Const mtagCondo = 14 Const mtagChateau = 15 Const mtagGrosChateau = 16 Const mtagBot1 = 17 Const mtagBot2 = 18 Const mtagbot3 = 19 Const mtagRock = 21 Const mtagDiamond = 20 Const mtagStone = 22 Const mtxtGazon = "Trois touffes de gazon font un buisson" Const mtxtBuisson = "Trois buissons font un arbre" Const mtxtArbre = "Trois arbres font une maison" Const mtxtDiamand = "Le crystal se conbine avec tout, mais s'il n'y a rien qui marche, elle se transforme en roche, trois roches font une plus grosse roche" Const mtxtBalais = "Le balais fait disparaitre n'importe quoi, sauf les ours qui laisse une pierre tombale" Const mtxtOurs = "L'ours, si mignon soit-il, est très nuisible, il se déplace tout seul" Const mtxtCoin = "La piece de monnaie se clique peut importe quoi vous avez en main et donne 100 points" '________________________________________________________________________________ '| 1.1 Les Modules | '|______________________________________________________________________________| Dim mresSprite() As Image Dim mpicGrille() As PictureBox Dim mcollAccumulateur As New Collection Dim mintScore As Integer Dim mintHighScore As Integer Dim mbytTableauScore(9) As Byte Dim mlblTableauScore(9) As Label Dim mbytLevel As Byte '________________________________________________________________________________ '| 1.2 Les Evenements | '|______________________________________________________________________________| '-------1.2.0 Démarrage du programme Private Sub Debut(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim I As Byte mresSprite = New Image() {My.Resources.Resources.Vide, My.Resources.Resources.broom, My.Resources.Resources.polarbear, My.Resources.Resources.panda, My.Resources.Resources.bear, My.Resources.Resources.grave, My.Resources.Resources.church, My.Resources.Resources.cathedral, My.Resources.Resources.coin, My.Resources.Resources.grass, My.Resources.Resources.bush, My.Resources.Resources.tree, My.Resources.Resources.house, My.Resources.Resources.bloc, My.Resources.Resources.condo, My.Resources.Resources.castle, My.Resources.Resources.bigcastle, My.Resources.Resources.bot1, My.Resources.Resources.bot2, My.Resources.Resources.bot3, My.Resources.Resources.diamond, My.Resources.Resources.Rock, My.Resources.Resources.Stone} mpicGrille = New PictureBox() {picTuile0, picTuile1, picTuile2, picTuile3, picTuile4, picTuile5, picTuile6, picTuile7, picTuile8, picTuile9, picTuile10, picTuile11, picTuile12, picTuile13, picTuile14, picTuile15, picTuile16, picTuile17, picTuile18, picTuile19, picTuile20, picTuile21, picTuile22, picTuile23, picTuile24, picTuile25, picTuile26, picTuile27, picTuile28, picTuile29, picTuile30, picTuile31, picTuile32, picTuile33, picTuile34, picTuile35} mlblTableauScore = New Label() {frmPointage.lblMaison, frmPointage.lblBloc, frmPointage.lblCondo, frmPointage.lblChateau, frmPointage.lblGrosChateau, frmPointage.lblOurs, frmPointage.lblTombe, frmPointage.lblRoche, frmPointage.lblPierre} For I = 0 To mpicGrille.Length - 1 AddHandler mpicGrille(I).Click, AddressOf CliqueTuile Next '_______________________debut de la partie Dim mswFichier As System.IO.StreamReader Try mswFichier = My.Computer.FileSystem.OpenTextFileReader("DernierePartie.txt") mintHighScore = Integer.Parse(mswFichier.ReadLine()) mintScore = Integer.Parse(mswFichier.ReadLine()) picSuivant.Tag = Byte.Parse(mswFichier.ReadLine()) picStockage.Tag = Byte.Parse(mswFichier.ReadLine()) For I = 0 To mpicGrille.Length - 1 mpicGrille(I).Tag = Byte.Parse(mswFichier.ReadLine()) Next mbytLevel = Byte.Parse(mswFichier.ReadLine()) mswFichier.Close() For I = 0 To mpicGrille.Length - 1 mpicGrille(I).Image = mresSprite(mpicGrille(I).Tag) Next picSuivant.Image = mresSprite(picSuivant.Tag) picStockage.Image = mresSprite(picStockage.Tag) lblScore.Text = mintScore lblMeilleurScore.Text = mintHighScore MessageBox.Show("La derniere partie non completé a été rechargée", "Bienvenue", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Catch ex As Exception MessageBox.Show("Impossible de charger la derniere partie, commencé à neuf", "Nouvelle Partie", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) NouvellePartie() End Try End Sub '-------1.2.1 Fin du programme Private Sub frmTrois_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing Dim mswFichier As System.IO.StreamWriter Dim I As Byte If ModeTriche1.Toggled = True Then MessageBox.Show("En mode triche il ny a pas de sauvegarde, la prochaine partie utilisera une sauvegarde antérieure", "sauvegarde annulé", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Exit Sub End If Try mswFichier = My.Computer.FileSystem.OpenTextFileWriter("DernierePartie.txt", False) mswFichier.WriteLine(mintHighScore) mswFichier.WriteLine(mintScore) mswFichier.WriteLine(picSuivant.Tag) mswFichier.WriteLine(picStockage.Tag) For I = 0 To mpicGrille.Length - 1 mswFichier.WriteLine(mpicGrille(I).Tag) Next mswFichier.WriteLine(mbytLevel) mswFichier.Close() MessageBox.Show("La partie a été sauvegardé pour plus tard!", "Au revoir!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Catch ex As Exception MessageBox.Show("Il y a eu un problème avec la sauvegarde, cette partie sera perdu à tout jamais, bouhouhou!", "Erreur fichier", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End Try End Sub '-------1.2.2 Quand l'utilisateur stocke une tuile Private Sub ClickStockage(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles picStockage.Click If picStockage.Tag = 0 Then picStockage.Tag = picSuivant.Tag ChoisirUnNouvelElement() Else Dim intTmp As Integer = picStockage.Tag picStockage.Tag = picSuivant.Tag picSuivant.Tag = intTmp End If picStockage.Image = mresSprite(picStockage.Tag) picSuivant.Image = mresSprite(picSuivant.Tag) End Sub '-------1.2.3 Les cliques sur la grille de jeu Private Sub CliqueTuile(ByVal sender As System.Object, ByVal e As System.EventArgs) '_______ Dim I As Byte = CByte(sender.name.ToString().Trim({"p"c, "i"c, "c"c, "T"c, "u"c, "l"c, "e"c})) '_______ If picSuivant.Tag = mtagBalais Then If sender.tag = mtagOurs Then Placer(I, mtagGrave) ElseIf sender.tag <> 0 Then sender.tag = 0 mpicGrille(I).Image = My.Resources.Resources.Add5 mintScore = mintScore + 5 Else Exit Sub End If ElseIf sender.tag = 0 Then Placer(I, picSuivant.Tag) ElseIf sender.tag = mtagCoin Then sender.tag = 0 mintScore = mintScore + 100 BougerLesOurs(I) lblScore.Text = String.Format("{0}", mintScore) mpicGrille(I).Image = My.Resources.Resources.Add100 tmrPouf.Enabled = True Exit Sub Else Exit Sub End If ChoisirUnNouvelElement() BougerLesOurs(I) lblScore.Text = String.Format("{0}", mintScore) tmrPouf.Enabled = True If mbytLevel > 2 OrElse LaGrilleEstPleine() Then ConstruireLeScoreFinale() NouvellePartie() If frmPointage.ShowDialog() = DialogResult.Yes Then 'dlgApercue.Document = prtDocument dlgImprimer.Document = prtDocument Try 'dlgApercue.ShowDialog() If dlgImprimer.ShowDialog = Windows.Forms.DialogResult.OK Then prtDocument.Print() End If Catch ex As Exception MessageBox.Show("erreur Imprimante") End Try End If End If End Sub '-------1.2.4 Petit timer pour les événements Private Sub tmrPouf_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrPouf.Tick Dim L As Byte For L = 0 To mpicGrille.Length - 1 mpicGrille(L).Image = mresSprite(mpicGrille(L).Tag) Next tmrPouf.Enabled = False End Sub '-------1.2.5 Imprimer Private Sub prtDocument_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles prtDocument.PrintPage Dim I As Byte Dim x, y As Integer Dim picImages() As PictureBox = {frmPointage.picMaison, frmPointage.picBloc, frmPointage.picCondo, frmPointage.picChateau, frmPointage.picGrosChateau, frmPointage.picOurs, frmPointage.picTombe, frmPointage.picRoche, frmPointage.picPierre} e.Graphics.DrawImage(My.Resources.Resources.TroisPtitsOurs, New Rectangle(100, 100, 233, 300)) e.Graphics.DrawString("Score initial = " & frmPointage.lblInitial.Text, frmPointage.lblInitial.Font, Brushes.Blue, New Point(100, 400)) x = 100 y = 425 For I = 0 To picImages.Length - 1 e.Graphics.DrawImage(picImages(I).Image, New Rectangle(x, y, 32, 32)) e.Graphics.DrawString(mlblTableauScore(I).Text, mlblTableauScore(I).Font, Brushes.Blue, New Point(x + 33, y)) y = y + 33 Next e.Graphics.DrawImage(frmPointage.picBot1.Image, New Rectangle(100, 725, 32, 32)) e.Graphics.DrawString(frmPointage.lblBot1.Text, frmPointage.lblBot1.Font, Brushes.Blue, New Point(133, 725)) e.Graphics.DrawImage(frmPointage.picBot2.Image, New Rectangle(100, 758, 32, 32)) e.Graphics.DrawString(frmPointage.lblBot2.Text, frmPointage.lblBot1.Font, Brushes.Blue, New Point(133, 758)) e.Graphics.DrawImage(frmPointage.picBot3.Image, New Rectangle(100, 791, 32, 32)) e.Graphics.DrawString(frmPointage.lblBot3.Text, frmPointage.lblBot1.Font, Brushes.Blue, New Point(133, 791)) e.Graphics.DrawString("Score final = " & frmPointage.lblFinal.Text, frmPointage.lblFinal.Font, Brushes.Blue, New Point(100, 825)) e.Graphics.DrawString(frmPointage.lblFinDePartie.Text, frmPointage.lblFinDePartie.Font, Brushes.Blue, New Point(100, 1000)) End Sub '-------1.2.6 L'utilisateur TRICHE Public Sub ModeTriche1_Toggle() Handles ModeTriche1.OnToggle If ModeTriche1.Toggled = True Then MessageBox.Show("Espèce de Tricheur(se)", "Mode triche activé", MessageBoxButtons.OK, MessageBoxIcon.Asterisk) ChoisirUnNouvelElement() Else MessageBox.Show("Je suis contraint de vous forcer à commencer une nouvelle partie", "Mode triche désactivé", MessageBoxButtons.OK, MessageBoxIcon.Asterisk) NouvellePartie() End If Debug.WriteLine("hey") End Sub '________________________________________________________________________________ '| 2.0 Les Fonctions | '|______________________________________________________________________________| '-------2.0.0 Nouvelle partie Sub NouvellePartie() Dim I, J As Byte '__retirer le mode tricheur ModeTriche1.Toggled = False '__vider la grille For I = 0 To mpicGrille.Length - 1 mpicGrille(I).Tag = 0 Next '__randomizer_la_grille For I = 0 To 25 Randomize() J = CByte(Math.Floor(Rnd() * 35)) ChoisirUnNouvelElement() Placer(J, picSuivant.Tag) Next mintScore = 0 '__vider les vieilles variable mintScore = 0 picStockage.Tag = 0 mbytLevel = 0 '__Mettre_À_Jours_L_Affichage For I = 0 To mpicGrille.Length - 1 mpicGrille(I).Image = mresSprite(mpicGrille(I).Tag) Next picStockage.Image = Nothing ChoisirUnNouvelElement() lblMeilleurScore.Text = mintHighScore End Sub '-------2.0.1 Fin de la partie Sub ConstruireLeScoreFinale() Dim I As Byte Dim intValue, intSum As Integer Dim intFinalScore As Integer = mintScore For I = 0 To mbytTableauScore.Length - 1 mbytTableauScore(I) = 0 Next For I = 0 To mpicGrille.Length - 1 Select Case mpicGrille(I).Tag Case mtagMaison To mtagGrosChateau mbytTableauScore(mpicGrille(I).Tag - mtagMaison) += 1 Case mtagOurs mbytTableauScore(5) += 1 Case mtagGrave mbytTableauScore(6) += 1 Case mtagRock mbytTableauScore(7) += 1 Case mtagStone mbytTableauScore(8) += 1 End Select Next For I = 0 To mlblTableauScore.Length - 1 If mbytTableauScore(I) > 0 Then Select Case I Case 0 To 4 intValue = ((I * 5) + 5) Case 5 intValue = -10 Case 6 intValue = -5 Case 7 intValue = -1 Case 8 intValue = -2 End Select intSum = mbytTableauScore(I) * intValue intFinalScore += intSum mlblTableauScore(I).Text = mbytTableauScore(I) & " * " & intValue & " = " & intSum End If Next If mbytLevel > 0 Then frmPointage.picBot1.Image = My.Resources.Resources.bot1 frmPointage.lblBot1.Text = "+1000" intFinalScore += 1000 End If If mbytLevel > 1 Then frmPointage.picBot2.Image = My.Resources.Resources.bot2 frmPointage.lblBot2.Text = "+2000" intFinalScore += 2000 End If If mbytLevel > 2 Then frmPointage.picBot3.Image = My.Resources.Resources.bot3 frmPointage.lblBot3.Text = "+3000" intFinalScore += 3000 End If frmPointage.lblInitial.Text = mintScore frmPointage.lblFinal.Text = intFinalScore If ModeTriche1.Toggled = True Then frmPointage.lblFinDePartie.Text = "Tricheur" Else If mbytLevel = 3 Then frmPointage.lblFinDePartie.Text = "Félicitation" End If If intFinalScore > mintHighScore Then mintHighScore = intFinalScore End If End If End Sub '-------2.0.2 Le choix aléatoire des pièce à placer 'choix aléatoire de la tuile suivante 'j'ai voulu mettre certaine priorité 'sur certaines tuiles. Sub ChoisirUnNouvelElement() Randomize() Dim tmp As Integer = CInt(Rnd() * 100) If ModeTriche1.Toggled = True Then If tmp < 50 Then picSuivant.Tag = mtagChateau ElseIf tmp < 70 Then picSuivant.Tag = mtagBalais Else picSuivant.Tag = mtagDiamond End If Else If tmp Mod 13 = 0 Then picSuivant.Tag = mtagDiamond lblAide.Text = mtxtDiamand ElseIf tmp Mod 11 = 0 Then picSuivant.Tag = mtagBalais lblAide.Text = mtxtBalais ElseIf tmp Mod 7 = 0 Then picSuivant.Tag = mtagTree lblAide.Text = mtxtArbre ElseIf tmp Mod 3 = 0 Then picSuivant.Tag = mtagOurs lblAide.Text = mtxtOurs ElseIf tmp Mod 2 = 0 Then picSuivant.Tag = mtagBush lblAide.Text = mtxtBuisson Else picSuivant.Tag = mtagGrass lblAide.Text = mtxtGazon End If End If picSuivant.Image = mresSprite(picSuivant.Tag) End Sub '-------2.0.3 Verification si la grille est pleine Function LaGrilleEstPleine() As Boolean Dim I As Byte Dim boolGameOver As Boolean = True For I = 0 To mpicGrille.Length - 1 If mpicGrille(I).Tag = 0 Then boolGameOver = False End If Next Return boolGameOver End Function '-------2.0.4 Placer une piece Sub Placer(ByVal I As Byte, ByVal bytTag As Byte) Select Case bytTag Case mtagDiamond PlacerUnDiamand(I) Case mtagOurs PlacerUnOurs(I) Case mtagBalais Exit Sub Case Else PlacerUnElement(I, bytTag) End Select End Sub '-------2.0.4.1 Placer une piece oridinaire Sub PlacerUnElement(ByVal I As Byte, ByVal bytTag As Byte) 'Besoin d'une clause pour la plus grande piece If VerificationRecursiveDeToutLesÉlémentIdentiqueEnContact(I, bytTag) Then For Each K As Byte In mcollAccumulateur mpicGrille(K).Tag = 0 mpicGrille(K).Image = My.Resources.Resources.Add5 mintScore = mintScore + 5 Next Select Case bytTag Case mtagStone, mtagCathedral mpicGrille(I).Tag = mtagCoin lblAide.Text = mtxtCoin Case mtagGrosChateau mbytLevel = mbytLevel + 1 'condition pour gagner la partie 'si mbytLevel attein 3 'cela voudra dire que les 3 robots 'auront étés construits mpicGrille(I).Tag = mtagGrosChateau + mbytLevel Case Else Placer(I, bytTag + 1) End Select Else mpicGrille(I).Tag = bytTag End If 'Il se peut qu'un objet placer 'empeche un ou plusieus ours 'de bouger, il vont tous mourrir mcollAccumulateur.Clear() VerificationAdjacenteDesIdentiques(I, mtagOurs) For Each Ours As Byte In mcollAccumulateur PlacerUnOurs(Ours) Next End Sub '-------2.0.4.2 Placer un ours Sub PlacerUnOurs(ByVal I As Byte) mpicGrille(I).Tag = mtagCoin 'nimporte quoi qui n'entrera pas en conflie If OursQuiPeutBouger(I) OrElse AuMoinUnOursPeutBouger(I) Then mpicGrille(I).Tag = mtagOurs Else Placer(I, mtagGrave) End If End Sub '-------2.0.4.3 Placer un diamand Sub PlacerUnDiamand(ByVal I As Byte) Dim sbytTag As SByte For sbytTag = 7 To 5 Step -1 If EssaieDiamand(I, sbytTag) Then Exit Sub End If Next For sbytTag = 15 To 9 Step -1 If EssaieDiamand(I, sbytTag) Then Exit Sub End If Next Placer(I, mtagRock) End Sub '-------3.0 sous-fonctions '________________sous-fonctions pour placer_______________ '| quand l'on place une tuile qui est | '| et cette dernier se joint à deux | '| autres ou plus identiques, elle se | '| combinent en une seule de niveau | '| superieure. Laisse des petits cinq | '| derriere | '|______________________________________________________| Function PasDansLaCollection(ByVal R As Byte) As Boolean '__si un seul de la collection est comme I , nous retournons Faux '__La fonction contains de la collection ne marche pas dans cette condition For Each J As Byte In mcollAccumulateur If R = J Then Return False End If Next Return True End Function Function VerificationDeHaut(ByVal I As Byte, ByVal bytTag As Byte) As Boolean Return ((I - 6) >= 0) AndAlso _ (mpicGrille(I - 6).Tag = bytTag) End Function Function VerificationDeBas(ByVal I As Byte, ByVal bytTag As Byte) As Boolean Return ((I + 6) < mpicGrille.Length) AndAlso _ (mpicGrille(I + 6).Tag = bytTag) End Function Function VerificationDeGauche(ByVal L As Byte, ByVal bytTag As Byte) As Boolean Return ((L Mod 6) <> 0) AndAlso _ (mpicGrille(L - 1).Tag = bytTag) End Function Function VerificationDeDroite(ByVal I As Byte, ByVal bytTag As Byte) As Boolean Return (((I + 1) Mod 6) <> 0) AndAlso _ (mpicGrille(I + 1).Tag = bytTag) End Function Sub VerificationAdjacenteDesIdentiques(ByVal L As Byte, ByVal bytTag As Byte) '____Lambda Dim IndexDeHaut = Function(I As Byte) I - 6 Dim IndexDeBas = Function(I As Byte) I + 6 Dim IndexDeGauche = Function(I As Byte) I - 1 Dim IndexDeDroite = Function(I As Byte) I + 1 '____ '__en haut If VerificationDeHaut(L, bytTag) AndAlso _ PasDansLaCollection(IndexDeHaut(L)) Then mcollAccumulateur.Add(IndexDeHaut(L)) End If '__en bas If VerificationDeBas(L, bytTag) AndAlso _ PasDansLaCollection(IndexDeBas(L)) Then mcollAccumulateur.Add(IndexDeBas(L)) End If '__a droite If VerificationDeDroite(L, bytTag) AndAlso _ PasDansLaCollection(IndexDeDroite(L)) Then mcollAccumulateur.Add(IndexDeDroite(L)) End If '__a gauche If VerificationDeGauche(L, bytTag) AndAlso _ PasDansLaCollection(IndexDeGauche(L)) Then mcollAccumulateur.Add(IndexDeGauche(L)) End If End Sub Function VerificationRecursiveDeToutLesÉlémentIdentiqueEnContact(ByVal P As Byte, ByVal bytTag As Byte) As Boolean '____Declaration Dim bytTot As Byte Dim bytStart As Byte = 1 '___Je m'excuse sincèrement. '___c'est environ le tier d'un A* pathfinding. '___A vrai dire ça n'a rien avoir avec le A*. '___Mais j'ai utilisé ce que j'ai appris dans cette derniere '___pour élaborer cette algorithme mcollAccumulateur.Clear() VerificationAdjacenteDesIdentiques(P, bytTag) While bytTot <> mcollAccumulateur.Count bytTot = mcollAccumulateur.Count For K As Byte = bytStart To bytTot Dim L As Byte = mcollAccumulateur.Item(K) '_____________ VerificationAdjacenteDesIdentiques(L, bytTag) '_____________ Next bytStart = bytTot End While Return (mcollAccumulateur.Count > 1) End Function '___________________sous-fonction pour placer OURS_____________________ '| Les ours eux sont différents, ils bougent | '| et sont très agacent. mais quand ils n'ont | '| pas la possibilité de bouger, ils meurent. | '| Cela fonctionne même avec un gros groupe | '| d'ours, si un seul peut bouger, ils survivent | '|____________________________________________________________________| Function OursQuiPeutBouger(ByVal L As Byte) As Boolean Return VerificationDeHaut(L, 0) Or _ VerificationDeBas(L, 0) Or _ VerificationDeDroite(L, 0) Or _ VerificationDeGauche(L, 0) End Function Function AuMoinUnOursPeutBouger(ByVal I As Byte) As Boolean VerificationRecursiveDeToutLesÉlémentIdentiqueEnContact(I, mtagOurs) For Each Ours As Byte In mcollAccumulateur If OursQuiPeutBouger(Ours) Then Return True End If Next For Each Ours As Byte In mcollAccumulateur mpicGrille(Ours).Tag = mtagGrave Next Return False End Function Sub BougerLesOurs(ByVal J As Byte) Dim I As Byte mcollAccumulateur.Clear() For I = 0 To mpicGrille.Length - 1 If mpicGrille(I).Tag = mtagOurs And I <> J Then mcollAccumulateur.Add(I) End If Next For Each Ours As Byte In mcollAccumulateur Select Case True Case VerificationDeDroite(Ours, 0) mpicGrille(Ours + 1).Tag = mtagOurs mpicGrille(Ours).Tag = 0 Case VerificationDeHaut(Ours, 0) mpicGrille(Ours - 6).Tag = mtagOurs mpicGrille(Ours).Tag = 0 Case VerificationDeGauche(Ours, 0) mpicGrille(Ours - 1).Tag = mtagOurs mpicGrille(Ours).Tag = 0 Case VerificationDeBas(Ours, 0) mpicGrille(Ours + 6).Tag = mtagOurs mpicGrille(Ours).Tag = 0 End Select mpicGrille(Ours).Image = My.Resources.Resources.WasABear Next End Sub '____________sous-fonction pour placer Diamand___________________ '| Le diamand est très pratique, il fusionne | '| avec n'importe quels tuiles s'il y en a | '| au moin deux pareils adjacentes. Sinon elle | '| devient une roche. | '|______________________________________________________________| Function EssaieDiamand(ByVal I As Byte, ByVal sbytTag As SByte) As Boolean If VerificationRecursiveDeToutLesÉlémentIdentiqueEnContact(I, sbytTag) Then For Each bytTuile As Byte In mcollAccumulateur mpicGrille(bytTuile).Tag = 0 mpicGrille(bytTuile).Image = My.Resources.Resources.Add5 mintScore = mintScore + 5 Next mpicGrille(I).Tag = sbytTag + 1 Return True End If Return False End Function End Class