Tris (P)06/2010 MyLzz59

(Rubrique VB-VBA)

0) Intro

J'enrichis ce jour cette rubrique VB/VBA avec un nouveau programme VBA sous Excel, dans la continuité des deux précédents, Boules, et Bombes. Un programme "suggéré" par Taz lors d'un commentaire récent, que j'ai pris comme un "petit défi". Oh, toutes proportions gardées, car bien que ce programme soit un peu plus "étoffé" que les précédents, il n'en reste pas moins une réalisation simple..

Je vous propose de me suivre pas à pas dans la mise en place de ce nouveau jeu, en fait un ..Tétris dans une feuille Excel . Une petite remarque: n'hésitez pas à vous référer aux explications des deux programmes précédents, la "difficulté" étant croissante je me focaliserai sur les "nouveautés".

1) Un Tétris ?

a] Généralités

Ce jeu de pièces à imbriquer façon puzzle a été inventé en urss en 1984 par Alexei Pajitnov, et a très vite conquis la planète par sa simplicité d'utilisation et son côté prenant, alliant adresse et réflexion. Rappelons-en le principe..

Une aire de jeu rectangulaire verticale en haut de laquelle apparaissent aléatoirement des formes planes composées de carrés, lesquelles descendent lentement jusqu'à s'empiler les unes sur les autres, au bas de l'aire. L'utilisateur/trice peut influer sur ces pièces de deux façons: les faire tourner autour de leur pivot (leur carré le plus central), et les déplacer latéralement, vers la gauche ou la droite de l'aire.

Le but est de les empiler au mieux en fonction des formes, de manière à constituer des lignes horizontales complètes. Chaque fois qu'une telle ligne est formée, elle se supprime et les carrés situés dessus descendent en conséquence, fournissant des points au passage.

La partie est considérée comme perdue lorsque l'aire est saturée de pièces posées, empêchant l'entrée d'une nouvelle pièce. Il n'y a pas d'état gagné, ce sont les scores qui importent en fin de jeu.

b] Ma version ("Tris")


Commençons par une photo d'écran, ce sera plus clair . L'aire de Jeu (B2:K21) comporte 10 colonnes sur une hauteur de 20 lignes. Toutes les pièces générées sont formées de 4 cases agencées en "T" (comme la pièce du haut), en "I" (les deux jaunes en bas à droite), en "J" (comme celle représentée en Suivante), en "L" (la verte), ou en "O" (ou carré).

Trois compteurs comptabilisent respectivement: le nombre de Lignes complètes qui ont été supprimées, le nombre de Points gagnés via ces lignes complètes, et le numéro d'ordre séquentiel de la Pièce en haut de l'Aire.

La zone "Suivante" présente la pièce qui succèdera à celle en haut de l'Aire lorsqu'elle sera posée. Les couleurs (6 différentes) n'ont aucune incidence sur le jeu.

La zone "Automatique" comporte deux options de jeu, petite case vide ("M17" ou "M18") = option désactivée, non vide = activée. L'option Suivante signifie que la pièce suivante apparaît automatiquement en haut de l'Aire, sinon il faut l'appeler soi-même. Cela ne donne pas le choix d'une autre Suivante. L'option Descente enclenche une chute automatique de la Pièce à raison d'une ligne par seconde, sinon elle reste en haut de l'écran jusqu'à ce qu'on la "fasse tomber".

Les Double-Clic et Clic-Droit sur la Feuille Excel sont interceptés et désactivés, sauf sur le Titre du Jeu ("M20:P21"). Notez l'existence d'une petite fenêtre flottante nommée "Pilote Tris". Elle est vitale pour ce jeu, car c'est le seul moyen de récupérer les appuis de touches au clavier, et donc de faire fonctionner ce jeu ! Lorsque vous fermez cette fenêtre, une question apparaît.


Cliquer sur "Oui" réinitialise le jeu en vue d'une nouvelle partie. Les deux Options ne sont "lues" qu'à ce moment. "Non" ferme la fenêtre "Pilote Tris", ce qui arrête le jeu. "Annuler" (par défaut) supprime la question et retourne au jeu.

Si vous avez arrêté le "Pilote Tris", vous pouvez le relancer via un Double-Clic sur le Titre du Jeu. Les deux Options ne sont modifiables que lorsque le "Pilote Tris est arrêté.

Comptabilisation des Points: lorsqu'une Pièce est posée, une suppression de Lignes complètes peut se produire, et jusqu'à quatre Lignes peuvent être supprimées en une seule fois. La première Ligne vaut 10 Pts, la seconde 15 Pts, la 3ème 20 Pts, et la 4ème 25 Pts. Si la suppression vide totalement l'Aire, la partie ne prend pas fin, mais 1000 Pts supplémentaires sont crédités !

c] Les Touches

"Tris" se joue entièrement au clavier, mais de deux manières différentes. Manière simple: les 4 touches du Pavé Fléché, Manière plus détaillée: le Pavé Numérique.

Au Pavé Fléché: les Flèches Gauche et Droite déplacent la Pièce latéralement, la Flèche Bas fait "tomber" la Pièce, la Flèche Haut a deux fonctions, faire Tourner la Pièce de 90° vers la droite (sens des aiguilles d'une montre (à aiguilles )), et engager la Pièce Suivante si l'option Descente n'est pas active.

Au Pavé Numérique: les Touches "4" et "6" déplacent la Pièce latéralement, resp. Gauche et Droite, la Rotation Droite est sur la Touche "9" et une Rotation Gauche (90°) est associée à la Touche "7", engager la Pièce Suivante est affecté à la Touche "5", et faire "tomber" la Pièce en cours à la Touche "Entrée".

La Touche "Echap (Esc)" affiche la question ci-dessus.

2) Préparatifs

a] Dessiner l'Interface

Comme précédemment, je vous ai concocté un bout de code qui va réaliser le nécessaire, je suppose que vous savez dimensionner et colorier des cellules excel, cela ne présente aucun intérêt propre ici..

Récupérez par copier-coller ce code, faîtes-en au besoin un copier-coller dans WordPad pour "normaliser" les sauts de lignes, et partez d'un nouveau classeur excel (vierge). Dans l'éditeur VBA, repérez le Projet correspondant (nommé sans doute "classeurnn") dans l'Explorateur de Projets, via un Clic-Droit sur celui-ci ajoutez un Nouveau Module, et collez-y le code.

Cliquez n'importe où dans le code, entre "Sub MeFTris" et "End Sub", et lancez l'exécution (Touche "F5", ou l'icône triangle vert).

Ceci fait, vous devriez n'avoir qu'une seule Feuille "Tris", semblable à l'image ci-dessus en 1b]. Vous pouvez supprimer (sans sauvegarder) le module contenant notre code, il ne servira plus.

*** RENOMMEZ DANS VBA LA FEUILLE de l'interface ***
*** (sans doute "Feuil1") EN "Tris" ***


b] Mise en Place

Nous avons la Feuille Excel renommée "Tris" tant au niveau de son Onglet (par le code) que dans VBA (vous venez de le faire). Nous aurons besoin de deux autres éléments VBA, un module que nous allons renommer "pTris", et une UserForm (une fenêtre windows) que nous appellerons "UF1". Sur cette dernière, simplement changer sa Propriété Caption (son titre) en "Pilote Tris", et la réduire à la plus petite taille permise par l'éditeur..

Sauvegardez déjà votre classeur .

La répartition du Code se fera comme suit:

* ThisWorkBook: (rien)

* la feuille "Tris": les procédures événementielles d'interception des Double-Clic et Clic-Droit, ainsi que notre simulation de Timer (à une seconde) pour l'option "Descente".

* le module "pTris": les paramètres du jeu (constantes et variables publiques), ainsi qu'une "trousse à outils" de procédures effectuant des actions identifiées du jeu, telles que Générer une Pièce, Tourner la Pièce, Tester la position de la Pièce, ou Rechercher les Lignes complètes..

* la UserForm "UF1": contient toute la logique du Jeu, essentiellement la gestion des Touches.

c] Les Paramètres du Jeu

Pour leur majorité, ils sont regroupés en Zone Déclarations du module "pTris". On y trouve les coordonnées et couleurs du jeu, etc.. Détaillons:

* Quatre constantes définissant les bords de l'Aire de Jeu: CUp et CDn, CLf et Crt (haut, bas, gauche, droite)
* C0 est la couleur (gris-bleu) du fond de l'Aire (est frais )
* CUp0 et CLf0 sont les coordonnées du coin supérieur gauche de la Zone "Suivante"
* de XYLi à XYaD l'adresse excel des différents compteurs et options..
* XYTi: l'adresse complète de la Zone de Titre, pour le Double-Clic dessus.

Voilà pour les Constantes, venons-en aux Variables: en fait le jeu va gérer trois Pièces simultanément . Il y aura la Pièce en cours de jeu (Pièce No=1), la même Pièce dont on calculera les nouvelles coordonnées afin de les valider (ou espace de travail, No=2), et enfin la Pièce Suivante, stockée en attente (No=0). Chacune de ces 3 Pièces est formée de 4 carrés (numérotés 1 à 4), lesquels ont un couple de coordonnées (PY, PX), et d'une Couleur associée PC. Excepté la Pièce Suivante (No=0), les Pièces ont un couple de coordonnées supplémentaire (Y0, X0) représentant la position absolue de leur carré pivot dans l'Aire de Jeu, les couples (PY, PX) étant en coordonnées relatives au Pivot (lequel a donc (PY, PX) = (0, 0) )

Les deux booléens (vrai/faux) Sui et Dsc correspondent resp. aux options Suivante et Descente.

Sta est une variable à trois états: Sta=0 signifie qu'aucune Pièce n'est en cours, Sta=1 signifie qu'une Pièce est engagée dans l'Aire de Jeu, et enfin Sta=2 pour matérialiser que la partie est perdue..

' -----------------
' Zone Déclarations
' -----------------
Public Const CUp As Integer = 2, CDn As Integer = 21, CLf As Integer = 2, CRt As Integer = 11
Public Const C0 As Long = &HFFCCCC, CUp0 As Integer = 13, CLf0 As Integer = 13
Public Const XYLi = "M4", XYPt = "M7", XYPc = "M10"
Public Const XYaS = "M17", XYaD = "M18", XYTi = "$M$20:$P$21"
Public X0(1 To 2) As Integer, Y0(1 To 2) As Integer
Public PX(0 To 2, 1 To 4) As Integer, PY(0 To 2, 1 To 4) As Integer
Public PC(0 To 2) As Long, Sta As Integer, Sui As Boolean, Dsc As Boolean

d] La feuille excel "Tris"

Les procédures événementielles "BeforeDoubleClick" et "BeforeRightClick" permettent d'intercepter les actions resp. Double-Clic et Clic-Droit sur la feuille excel. Dans les deux cas, nous allons annuler l'action par défaut d'excel (Cancel = True). Pour le Double-Clic, rajoutons que sur le Titre, l'on lance le "Pilote Tris" (en non modal !!) ainsi que notre ersatz de Timer "MyTimer".

"MyTimer" est une boucle infinie de DoEvents, qui lorsqu'au moins 1 seconde s'est écoulée entre deux prises de temps successives et qu'une Pièce est engagée et que l'option Descente est activée, simule un appui au clavier sur le touche (inexistante) signifiant "descendre la Pièce d'une ligne".

' -----------------
' Annuler l'Edition
' -----------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True: If Target.Address = XYTi Then UF1.Show 0: MyTimer
End Sub

' --------------------------
' Annuler le Menu Contextuel
' --------------------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

' --------------------------
' Sorte de Timer (1 seconde)
' --------------------------
Private Sub MyTimer()
K& = Timer
Do
    DoEvents: K2& = Timer
    If K2& <> K& Then K& = K2&: If Dsc = True And Sta = 1 Then UF1.UFKD -1
Loop
End Sub

3) La Trousse à Outils (module pTris)

a] GenerePiece - Crée une nouvelle Pièce

Tirons aléatoirement une séquence (Z$). Elle contient 4 couples xxyy en coordonnées relatives par rapport au pivot, et nettoyons la Zone Suivante afin d'y dessiner la nouvelle Pièce (Z$).

Après recopie de la Pièce No=0 en No=2 (l'ancienne Suivante devient la future En Cours ), chargeons nos 4 couples xxyy dans les (PY(0,t), PX(0,t)) correspondants, et dessinons les carrés dans la Zone Suivante.

La Couleur de la Pièce est créée à partir d'une valeur tirée entre 1 et 6, que l'on va décomposer en binaire (3 bits: 2^0=1=rouge, 2^1=2=vert, 2^2=4=bleu) pour "allumer" la composante couleur associée (ex: 5=4+1=bleu+rouge=rose) du code couleur PC.

' ----------------------------------------------------------
' Crée une Pièce (en No=0, et Recopie la Précédente en No=2)
' ----------------------------------------------------------
Sub GenerePiece()
' Tirage
Select Case Int(Rnd * 5)
    Case 0: Z$ = "-1 0-1 1 0 0 1 0" ' L
    Case 1: Z$ = "-1 0 0 0 0 1 1 0" ' T
    Case 2: Z$ = " 0 0 0 1 1 0 1 1" ' O
    Case 3: Z$ = "-1 0 0 0 1 0 2 0" ' I
    Case 4: Z$ = "-1 0 0 0 1 0 1 1" ' J
End Select
' Nettoyage "Suivante"
With Tris
    .Range(.Cells(CUp0, CLf0), .Cells(CUp0 + 1, CLf0 + 3)).Interior.Color = C0
End With
' Affectation et Dessin "Suivante
T = 1 + Int(Rnd * 6)
PC(2) = PC(0): PC(0) = -(65536 * ((T And 4) <> 0) _
    + 256& * ((T And 2) <> 0) + 1& * ((T And 1) <> 0)) * 204
For T = 1 To 4
    PX(2, T) = PX(0, T): PX(0, T) = Val(Mid$(Z$, 4 * T - 3, 2))
    PY(2, T) = PY(0, T): PY(0, T) = Val(Mid$(Z$, 4 * T - 1, 2))
    Tris.Cells(CUp0 + PY(0, T), CLf0 + PX(0, T) + 1).Interior.Color = PC(0)
Next T
End Sub

b] TestePiece() - Fonction Booléenne

Renvoie True (Vrai) si la Pièce dont le No est donné en paramètre (No=1 ou No=2) est située à un emplacement autorisé. Pour chacun des 4 carrés de la Pièce, on vérifie qu'il figure dans les limites de l'Aire de Jeu, et qu'il n'est pas au même emplacement qu'une Pièce déjà posée.

L'on aurait pu pour cela vérifier la couleur de la case, j'ai opté pour l'astuce suivante: chaque case occupée par une Pièce contient une astérisque invisible car de la même couleur que la case, alors que les autres sont vides. La détection se fait donc sur l'état vide ou non, car les codes couleur peuvent ne pas être fidèles, par exemple ils seront approximés sur un vieil ordi dont l'affichage serait en 65000 couleurs seulement .

En interne un booléen B est à Vrai par défaut, jusqu'à ce qu'un carré en erreur le positionne à Faux..

' ----------------------------------------------
' Teste la Pièce (No=1: en cours, No=2: travail)
' ----------------------------------------------
Function TestePiece(No As Integer) As Boolean
If No = 1 Or No = 2 Then
    B = True
    For T = 1 To 4
        X = X0(No) + PX(No, T): Y = Y0(No) + PY(No, T)
        If X < CLf Or X > CRt Then
            B = False
        ElseIf Y < CUp Or Y > CDn Then
            B = False
        ElseIf Tris.Cells(Y, X).Text <> "" Then
            B = False
        End If
    Next T
Else
    B = False
End If
TestePiece = B
End Function

c] DessinePiece - Affiche ou Efface la Pièce No

Cette procédure affecte à chaque case de l'Aire de Jeu "occupée" par la Pièce No soit la couleur de fond et de police PC de la Pièce No ainsi qu'une astérisque (pour Aff à Vrai), ou la couleur de fond et aucun texte (pour Aff à Faux).

' ------------------------------------------------------
' Dessine (Aff=True) ou Efface (Aff=False) la Pièce (No)
' ------------------------------------------------------
Sub DessinePiece(No As Integer, Aff As Boolean)
For T = 1 To 4
    X = X0(No) + PX(No, T): Y = Y0(No) + PY(No, T)
    With Tris.Cells(Y, X)
        .Interior.Color = IIf(Aff, PC(No), C0)
        .Font.Color = IIf(Aff, PC(No), C0)
        .Value = IIf(Aff, "*", "")
    End With
Next T
End Sub

d] Recopie - Clône les (PY, PX) et PC entre les Pièces No=1 et No=2

Classiquement, l'on recopie la Pièce en cours (No=1) dans la zone de travail (No=2), on modifie cette Pièce (No=2), on teste le résultat via TestePiece(2), et si elle est validée on la reporte en Pièce en cours (No=1)..

Le booléen D12 détermine le sens de recopie. A Vrai le sens est No=1 vers No=2, à Faux de No=2 vers No=1.

' -----------------------------------
' Recopie 2=>1 (False) ou 1=>2 (True)
' -----------------------------------
Sub Recopie(D12 As Boolean)
PC(1 - D12) = PC(2 + D12): X0(1 - D12) = X0(2 + D12): Y0(1 - D12) = Y0(2 + D12)
For T = 1 To 4: PX(1 - D12, T) = PX(2 + D12, T): PY(1 - D12, T) = PY(2 + D12, T): Next T
End Sub

e] TGTD - Rotations Gauche et Droite

Le booléen Dr détermine le sens de rotation. A Vrai elle sera de 90° vers la droite (dans le sens des aiguilles d'une montre), à Faux vers la gauche.

Cette procédure commence par recopier les coordonnées de la Pièce No=1 sur la Pièce No=2 en effectuant la Rotation appropriée, et comptabilise dans (Y1, X1) les débordements de l'Aire de Jeu de la Pièce obtenue (No=2), débordements qu'il suffit de soustraire aux coordonnées du pivot pour ramener cette Pièce dans l'Aire de Jeu..

Dans le cas d'une Rotation Droite, la composante X devient Y, et Y devient -X. Dans le cas d'une Rotation Gauche, X devient -Y et Y devient X.

' --------------------------------------------
' Rotation 90° Gauche (False) ou Droite (True)
' --------------------------------------------
Sub TGTD(Dr As Boolean)
X1 = 0: Y1 = 0
For T = 1 To 4
    PY(2, T) = IIf(Dr, 1, -1) * PX(1, T): PX(2, T) = IIf(Dr, -1, 1) * PY(1, T)
    X = X0(1) + PX(2, T): Y = Y0(1) + PY(2, T)
    If X < CLf Then If X - CLf < X1 Then X1 = X - CLf
    If Y < CUp Then If Y - CUp < Y1 Then Y1 = Y - CUp
    If X > CRt Then If X - CRt > X1 Then X1 = X - CRt
    If Y > CDn Then If Y - CDn > Y1 Then Y1 = Y - CDn
Next T
X0(2) = X0(1) - X1: Y0(2) = Y0(1) - Y1
End Sub

f] TesteLignes - Traitement des Lignes complètes

Pour chaque Ligne du bas vers le haut de l'Aire de Jeu, on positionne un booléen B à Vrai, et l'on parcourt toute la Ligne. Si une case vide est trouvée, B passe à Faux.

Si B est resté à Vrai, c'est que la Ligne est complète. On incrémente alors le compteur Lignes de 1, celui de Points de 10 + T, où T est initialement à 0 (zéro), et enfin T de 5. Ensuite, si la Ligne n'est pas celle du haut de l'Aire de Jeu, alors on sélectionne tout le dessus de l'Aire, que l'on recopie une Ligne plus bas, écrasant la complète. Dans tous les cas l'on vide la Ligne du haut. Si la Ligne est celle du Bas, l'on redessine la Bordure épaisse tout en bas de l'Aire.

Autre partie, l'on teste à l'inverse le contenu de la Ligne du bas. Partant de B à Vrai, l'on positionne B à Faux si l'on trouve une case occupée. B resté à Vrai signifie que la Ligne du bas est vide, donc que toute l'Aire de jeu l'est. Dans ce cas, 1000 Points supplémentaires.

' ------------
' Teste Lignes
' ------------
Sub TesteLignes()
With Tris
    T = 0 ' 1ère Ligne: 10Pts, 2ème Ligne: 15Pts, etc..
    For Y1 = CDn To CUp Step -1
        ' Est-ce une Ligne ?
        B = True
        For X1 = CLf To CRt
            If .Cells(Y1, X1).Text = "" Then B = False
        Next X1
        ' Action
        If B Then
            .Range(XYLi).Value = .Range(XYLi).Value + 1 ' Lignes
            .Range(XYPt).Value = .Range(XYPt).Value + 10 + T: T = T + 5 ' Points
            ' Décalage du Dessus de la Ligne
            If Y1 > CUp Then
                .Range(.Cells(CUp, CLf), .Cells(Y1 - 1, CRt)).Copy _
                    Tris.Range(.Cells(CUp + 1, CLf), .Cells(Y1, CRt))
            End If
            With .Range(.Cells(CUp, CLf), .Cells(CUp, CRt))
                .Interior.Color = C0: .Font.Color = C0: .ClearContents
            End With
            ' Redessiner Bordure Epaisse en Bas
            If Y1 = CDn Then _
                .Range(.Cells(CDn, CLf), .Cells(CDn, CRt)) _
                    .Borders(xlEdgeBottom).Weight = xlThick
            Y1 = Y1 + 1
        End If
    Next Y1
    B = True ' Bonus: Ecran Vide=1000Pts
    For X1 = CLf To CRt
        If .Cells(CDn, X1).Text <> "" Then B = False
    Next X1
    If B Then .Range(XYPt).Value = .Range(XYPt).Value + 1000
End With
End Sub

g] Griser - rend monochrome tout le contenu de l'Aire de Jeu

Une coquetterie pour finir, cette procédure recalcule les couleurs de toutes les cases de l'Aire de Jeu afin de les convertir en une teinte grise, pour bien matérialiser que la partie est perdue..

Le principe est de sommer les trois composantes de la couleur (rouge, vert, bleu), diviser par 3 pour en obtenir la moyenne, et l'affecter aux 3 composantes de la nouvelle couleur grise (65793=65536+256+1=256^2+256^1+256^0).

' --------------
' Griser (Perdu)
' --------------
Sub Griser()
With Tris
    For Y1 = CDn To CUp Step -1: For X1 = CLf To CRt
        V& = .Cells(Y1, X1).Interior.Color: V2& = 0
        For T = 0 To 2: V2& = V2& + V& Mod 256: V& = V& \ 256: Next T
        V2& = 65793 * (V2& \ 3): .Cells(Y1, X1).Interior.Color = V2&
        .Cells(Y1, X1).Font.Color = V2&
    Next X1, Y1
End With
End Sub

4) "Pilote Tris" - Noyau de ce Jeu

Cette petite fenêtre flottante a pour fonction d'intercepter les appuis de Touches Clavier, et d'intéragir en fonction des phases du Jeu.

a] Initialisation

"Pilote Tris" démarre avec un Double-Clic sur la zone de Titre du Jeu, et initie une Nouvelle Partie. Commençons donc, dans la procédure événementielle "UserForm_Initialize" (UserForm est un nom imposé indépendant du nom réel de la fenêtre, ici UF1), par récupérer l'état des deux Options Suivante et Descente dans les booléens Sui et Dsc, lesquels seront valables durant toute l'existence de "Pilote Tris".

Après initialisation du générateur aléatoire, repositionnons Sta, l'indicateur de phase du Jeu, à zéro (aucune Pièce en cours), réinitialisons l'Aire de Jeu (UFCL, voir plus bas), générons (GenerePiece) une Pièce qui s'affichera dans la Zone Suivante, et simulons l'appui au clavier de la Touche "Engager Pièce Suivante" (code 101), afin de ne pas répéter le code associé.

' ----------------
' Démarrage Pilote
' ----------------
Private Sub UserForm_Initialize()
With Tris
    Sui = .Range(XYaS).Text <> "": .Range(XYaS).Value = IIf(Sui, "X", "")
    Dsc = .Range(XYaD).Text <> "": .Range(XYaD).Value = IIf(Dsc, "X", "")
End With
Randomize Timer: Sta = 0: UFCL: GenerePiece: UFKD 101
End Sub

b] Evénements Touches

Nous allons utiliser conjointement deux événements de détection des Touches Clavier, qui sont "UserForm_KeyDown" et "UserForm_KeyPress". KeyDown a l'avantage d'être indépendant du code pays configuré car elle récupère le numéro interne des touches et non le code ascii que lui associe le pilote du Clavier, de plus KeyPress ne gère pas le Pavé Fléché. Aussi allons-nous installer toute la gestion Clavier dans KeyDown, et juste déléguer à KeyPress la touche Echap (Esc). Certes nous aurions pu l'intégrer aussi, mais cela me semblait plus clair ainsi..

Commençons par KeyPress.. Si la Touche pressée a pour code ascii 27 (la Touche Echap), alors simulons une demande de fermeture de "Pilote Tris", en appelant l'événement associé, "UserForm_QueryClose", exactement comme lors d'un clic de souris sur la croix de fermeture de la Fenêtre.

Passons à KeyDown.. Nous nous contentons de ..passer le code de Touche à son presque clône, la procédure (non événementielle) UFKD !! La raison tient en la présence d'un format de paramètre non pratique, KeyCode n'est pas un simple entier (Integer) mais un MSForms.ReturnInteger ! Or, nous avons besoin de simuler des appuis touches à plusieurs endroits, et il est bien plus aisé de gérer un simple Integer que ce machin (). Aussi, dans UFKD, KeyCode devient un Integer ().

Nous analyserons UFKD un peu plus bas.

' ------------
' EVTs Touches
' ------------
' Touches du Jeu
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
UFKD KeyCode ' A cause du MSForms.ReturnInteger
End Sub
' Touche "Echap"
Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then UserForm_QueryClose 0, 1
End Sub

c] Fermeture de "Pilote Tris"

Comme dévoilé plus haut, le code de fermeture se tiendra dans l'événement de fermeture nommé "UserForm_QueryClose" (et non Terminate..)

La tentative de fermeture de "Pilote Tris", qu'elle soit réelle ou simulée, affiche une question à trois réponses. MsgBox() étant une Fonction, appliquons directement sa sortie dans un Select Case.

- [Oui] (Nouvelle Partie) : L'initialisation de "Pilote Tris" crée déjà une Nouvelle Partie, il suffit donc d'invoquer l'événement ("UserForm_Initialise").

- [Non] (Fermer "Pilote Tris") : l'on réinitialise l'Aire de Jeu (encore UFCL, voir ci-dessous), et l'on met fin à l'exécution du code par un simple End. Notez que ceci met également fin à MyTimer, lequel tournait en parallèle du "Pilote Tris"

- [Annuler] (retour au Jeu) : aucun code n'est nécessaire, la fenêtre modale MsgBox se refermant seule.

Parlons du "Cancel = True". Nombre d'événements permettent d'annuler l'exécution automatique de l'ordre associé à l'événement, comme c'était le cas (plus haut) pour les "WorkSheet_BeforeDoubleClick" et "WorkSheet_BeforeRightClick". Simplement ici, Cancel est au format Integer, mais fonctionne comme un booléen. Positionné à Vrai (comprendre différent de zéro, la seule valeur signifiant Faux, alors pourquoi pas à True = -1 en numérique ?), Cancel aura pour fonction d'interdire la fermeture automatique de "Pilote Tris". Notez que End s'en fiche..

' ----------------
' Fermeture Pilote
' ----------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = True
Select Case MsgBox("** Menu Principal **" + vbCr + vbCr _
    + "[Oui] Démarrer une Nouvelle Partie" + vbCr _
    + "[Non] Fermer la Fenêtre Pilote" + vbCr + "[Ann] Retour au Jeu" _
    , vbDefaultButton3 + vbYesNoCancel + vbInformation, Tris.Range("M20").Text)
Case vbYes: UserForm_Initialize
Case vbNo: UFCL: End
End Select
End Sub

d] UFCL - Nettoyage de l'Interface

Un truc simple, pour souffler . UFCL remet à zéro les trois Compteurs, efface la Zone Suivante, et nettoie l'Aire de Jeu (couleurs de fond et de police, suppression du texte).

' ------------------------
' Nettoyage de l'Interface
' ------------------------
Private Sub UFCL()
Tris.Range(XYLi).Value = 0: Tris.Range(XYPt).Value = 0: Tris.Range(XYPc).Value = 0
With Tris
    .Range(.Cells(CUp0, CLf0), .Cells(CUp0 + 1, CLf0 + 3)).Interior.Color = C0
End With
With Tris.Range(Tris.Cells(CUp, CLf), Tris.Cells(CDn, CRt))
    .Interior.Color = C0: .Font.Color = C0: .ClearContents
End With
End Sub

e] UFKD - Gestion Touches - Le "Noyau" du Jeu

Comme ce Jeu se joue entièrement au Clavier (réel ou simulé), toute sa logique se résume à une Gestion de Touches.. Distinguons les trois phases (Sta=0: aucune Pièce engagée, Sta=1: Pièce en cours, et Sta=2: partie perdue).

Sta=2: il n'y a rien à gérer, aussi aucune ligne de code ne lui est dédiée. Donc la structure principale sera Si Sta=1 Alors.. Sinon Si Sta=0 Alors.. (sinon rien). Dans les deux cas, interceptons certaines Touches.

Sta=0: aucune Pièce engagée. Seul l'appui d'une Touche d'Engagement (Flèche Haut du Pavé Fléché (KeyCode=38) ou le "5" du Pavé Numérique (KeyCode=101)) est vérifié. Repositionnons le Pivot de la Pièce de Travail au milieu de la Ligne du Haut de l'Aire., et générons une Pièce (GenerePiece), ce qui recopiera la Pièce No=0 en No=2. Notre Pièce de Travail est désormais prête à être testée..

Si elle peut apparaître dans l'Aire (TestePiece(2)=Vrai), alors l'on passe en phase Sta=1 (Pièce engagée), l'on incrémente le Compteur de Pièces, on la recopie dans Pièce en Cours (No=1) et on la dessine. Sinon, l'on passe en phase Sta=2 (partie perdue) où l'on grise l'Aire (Griser) et affiche "Perdu".

Sta=1: Pièce engagée. Effaçons tout d'abord la Pièce de là où elle se trouve, et testons les Touches d'actions dessus..

- Déplacements Latéraux (Flèches Gauche (37), Droite (39), "4" (100) et "6" (102)): l'on copie la Pièce en Cours sur Travail, et on décrémente ou incrémente sa position horizontale (Travail).

- Rotations (Flèche Haut (38), "7" (103) et "9" (105)): l'on appelle simplement la procédure TGTD, avec Faux pour "7" (Rotation Gauche), Vrai sinon (Rotation Droite).

- Descendre d'une Ligne (la Touche de KeyCode -1 n'existe pas, c'est MyTimer qui la simule): l'on copie la Pièce en Cours sur Travail, et on incrémente sa position verticale (Travail). Si ce nouvel emplacement est invalide, c'est que la Pièce s'est posée, aussi passons Sta à zéro.

- Faire tomber la Pièce (Flèche Bas (40) et Entrée (13)): comme précédemment, l'on copie la Pièce en Cours sur Travail, et on incrémente sa position verticale (Travail), ce jusqu'à ce qu'on ne puisse plus la poser au nouvel emplacement. Remontons alors d'une Ligne, et marquons-la comme posée (Sta=0).

Ceci fait, terminons. Si le nouvel emplacement obtenu est valide, transférons-le sur la Pièce en Cours. Ne reste plus qu'à la dessiner, et si elle est posée effectuer une vérification de Lignes Complètes (via la procédure TesteLignes) puis engager la Pièce Suivante si l'option Descente est activée.

' ---------------
' Gestion Touches
' ---------------
Public Sub UFKD(ByVal KeyCode As Integer)
If Sta = 1 Then
    ' En cours
    DessinePiece 1, False
    Select Case KeyCode
        ' Déplacements (Gauche: "4" ou Pavé Gauche, Droite: "6" ou Pavé Droite)
        Case 37, 100: Recopie True: X0(2) = X0(2) - 1 ' Gauche
        Case 39, 102: Recopie True: X0(2) = X0(2) + 1 ' Droite
        ' Bas (Auto)
        Case -1: Recopie True: Y0(2) = Y0(2) + 1: If TestePiece(2) = False Then Sta = 0
        ' Rotations (TG:"7", TD:"9" ou Pavé Haut)
        Case 38, 103, 105: TGTD KeyCode <> 103
        ' Tomber (Pavé Bas ou Entrée)
        Case 13, 40: Recopie True
            Do: Y0(2) = Y0(2) + 1: Loop While TestePiece(2): Y0(2) = Y0(2) - 1: Sta = 0
    End Select
    If TestePiece(2) Then Recopie False
    DessinePiece 1, True: If Sta = 0 Then TesteLignes: If Sui Then UFKD 101
ElseIf Sta = 0 Then
    ' Aucune
    Select Case KeyCode
        ' Nouveau ("5" ou Pavé Haut)
        Case 38, 101: X0(2) = (CLf + CRt) \ 2: Y0(2) = CUp: GenerePiece
            If TestePiece(2) Then
                Sta = 1: Tris.Range(XYPc).Value = Tris.Range(XYPc).Value + 1 ' Pièces
                Recopie False: DessinePiece 1, True
            Else
                Sta = 2: Griser: MsgBox "Perdu", vbCritical
            End If
    End Select
End If
End Sub

Le Code Complet de ce Jeu est disponible ICI..

-MyLzz59-