[VBA Excel] - Jeu Pacman 1980
Bonjour à tous,
Suite à la finalisation d'une première version jouable de mon pacman, je souhaites partager le fil d'une nouvelle version from scratch.
L'idée étant de se rapprocher au plus possible du jeu original
Venant de l'univers Web (JS, PHP, Shell, etc ) je débute en VBA, mais heureusement comme on dit: quand on sait coder, peu importe le langage ^
En pleine phase d'apprentissage VBA donc, je vais essayer de réfléchir et de proposer des solutions propres et efficaces pour les différents problèmes que je vais rencontrer lors de cette création, bien entendu vous êtes les bienvenus pour m'aider !
<code'ialement/>
ICI la première version-> https://forum.excel-pratique.com/excel/vba-cherche-methode-pour-recolorier-une-image-172187#p1068774
Fichier modifié pour l'affichage
Allez c'est parti, je commence par créer le visuel, en cherchant "pacman original" je suis tombé sur ce .PNG qui me semble pas mal:
Tentative d'alignement sur une grille Excel: Bof ça ne rentre pas ...
On passe par la case retouche photoshop pour bien aligner et avoir un rendu "original", pas si mal:
Voilà maintenant que tout est bien aligné, on peut le 'poser' sur une grille, chopper les bonnes couleurs et placer les 'dots' comme sur l'original
Maintenant on a une jolie grille de jeu sur laquelle on va pouvoir travailler !!
Prochains posts pour structurer un peu tout ça:
_ fonction pour mettre en page tout ça, que ce soit centré à l'ouverture du fichier
_ fonction qui va déclarer et placer les dots et balls
_ fonction qui va déclarer les chemins possible et le passage de droite à gauche
<code'ialement/>
Suite
Quelques déclarations pour cette partie:
Type Elements
Picture As String
Place As Range
Colors As Double
End Type
Public Map As Elements
Public Dots As Elements
Public Balls As Elements
Et une petite fonction bien maigre pour le moment:
Function DefineElements()
Map.Picture = "map"
Set Map.Place = Range("B1:AC31")
End Function
Du coup maintenant pour le fichier test on va créer des Sub qui vont avec ces différents boutons
Pour l'alignement, pour le moment on le centre verticalement pour ajuster selon les écrans, comme ceci:
'Bouton Aligner
Sub CenteringGame()
DefineElements
Map.Place.Select
ActiveWindow.Zoom = True
End Sub
'Bouton Afficher MAP
Sub DisplayMap()
DefineElements
MoveObject Map.Picture, Map.Place
SetPictureDisplayMode Map.Picture, True
End Sub
'Bouton cacher MAP
Sub HideMap()
DefineElements
SetPictureDisplayMode Map.Picture, False
End Sub
'Fonction commune pour positionner l'image
Function MoveObject(ObjectName As String, ThisPosition As Range)
Dim ThisImage As Shape
Dim ThiscellLocation As Range
Set ThisImage = ActiveSheet.Shapes(ObjectName)
Set ThiscellLocation = ThisPosition
ThisImage.Top = ThiscellLocation.Top + (ThiscellLocation.Height / 2) - (ThisImage.Height / 2)
ThisImage.Left = ThiscellLocation.Left + (ThiscellLocation.Width / 2) - (ThisImage.Width / 2)
End Function
'Fonction commune pour afficher/cacher l'image
Function SetPictureDisplayMode(ThisPictureName As String, ThisMode As Boolean)
ActiveSheet.Shapes(ThisPictureName).Visible = ThisMode
End Function
Ensuite pour les dots, on va juste les déclarer tranquillement avec l'enregistreur ^
Sub DefineDots()
Set Dots.Place = Union( _
Range("Q27:S27,Q28:Q29,K27:N27,N28:N29,K25:K26,I24:N24,N21:N23,I21:M21,C21:G21,C22:C23,D24:E24,E25:E26,C27:G27,C28:C30,D30:AA30,C2:C3,D2:N2,Q2:AB2,H3:H5,C5,N3:N5,Q3:Q5,W3:W5,AB3"), _
Range("T7:T8,W7:W27,X9:AB9,AB7:AB8,X21:AB21,AB22:AB23,Z24:AA24,Z25:Z26,X27:AB27,AB28:AB30,Q21:Q24,R21:V21,R24:V24,T26:T27,T25,C6:AB6,C7:C9,H7:H27,D9:G9,K7:K9,L9:N9,Q9:T9,AB5,O24:P24") _
)
Set Balls.Place = Range("C4,AB4,C24,AB24")
Dots.Colors = -5195270
Balls.Colors = -5195270
End Sub
Puis les fonctions des bouton:
Sub DisplayDots()
DefineDots
Dots.Place.Font.Color = Dots.Colors
Balls.Place.Font.Color = Balls.Colors
End Sub
Sub HideDots()
DefineDots
Dots.Place.Font.ColorIndex = xlAutomatic
Balls.Place.Font.ColorIndex = xlAutomatic
End Sub
Voilà c'est tout pour le moment, je met le fichier de test pour ceux qui veulent faire joujou avec
<code'ialement/>
Bonsoir,
dans le CenteringGame, j'ajouterais un masquage des entêtes de ligne et colonne, masquage des onglet et du ruban en mettant le tout en plein écran...
Comme cela il y aura une utilisation maximal de l'écran et permet d'être à minima à 100% de zoom, car lors de mon test, les Gums ne sont plus rondes du fait que le zoom est passé à 70%...
Mais si vous faites cela, de mon coté, on m'a conseillé de passer par une feuille "accueil" qui prévient que l'application Excel va passer en mode plein écran (Faites le lien, SevenSfruitS)
@ bientôt
LouReeD
Bonsoir,
Pour la déformation des gums ( ce que j'appelle balls ) c'est dû à la taille de la police qui sort le caractère spécial de sa cellule !
Je remplace donc le caractère dans la cellule par un 'shape', petite modification du code au passage.
Pour la déclaration du type:
Type Elements
Picture(1 To 4) As String
Place(1 To 4) As Range
Colors As Double
Rgb(1 To 3) As Byte
End Type
également modification des définitions:
Set Balls.Place(1) = Range("C4")
Set Balls.Place(2) = Range("AB4")
Set Balls.Place(3) = Range("C24")
Set Balls.Place(4) = Range("AB24")
Balls.Picture(1) = "ball1"
Balls.Picture(2) = "ball2"
Balls.Picture(3) = "ball3"
Balls.Picture(4) = "ball4"
Ensuite on vient les placer /afficher / masquer avec les mêmes méthodes que pour la map:
For ThisElement = 1 To 4
MoveObject Balls.Picture(ThisElement), Balls.Place(ThisElement)
SetPictureDisplayMode Balls.Picture(ThisElement), True
Next ThisElement
On re-clique sur "afficher dots" ... Et huuup là, c'est beau
Alors oui, par la suite on va tout masquer (ruban, etc .. ), là c'est pour maquetter tranquillement !
Merci pour ces conseil et d'avoir pris le temps de tester et de me lire
<code'ialement/>
Bonsoir, Suite !!!
Définition des chemins possibles, juste un range en fait, pas trop fou fou comme modif
Function DefineRoads()
Set Roads = Union( _
Range("R21:V21,W16:W27,X21:AB21,AB22:AB24,Z24:AA24,X27:AB27,Z25:Z26,AB28:AB30,C30:AA30,C22:C24,D24:E24,E25:E26,C27:C29,D27:H27,H22:H26,I24:M24,K25:K27,L27:N27,N28:N29,Q27:Q29,R27:T27,R24:V24,T25:T26,C2:C9,D9:H9,D2:AB2"), _
Range("K7:K9,L9:N9,N10:N11,Q9:Q11,R9:T9,T7:T8,H7:H8,H10:H20,C15:G15,I15:AB15,W7:W14,X9:AA9,K12:T12,T13:T14,K13:K14,K16:K20,L18:T18,T16:T17,T19:T20,C21:N21,N22:N24,Q21:Q24,O24:P24,D6:AA6,H3:H5,N3:N5,Q3:Q5,W3:W5,AB3:AB9") _
)
End Function
A l'inverse de la première version de jeu, ici on va orienter les mouvements sur cette 'route' et non sur des 'murs'.
Nouvelle Classe Personnages pour le pacman qui servira aussi pour les fantômes!
Type Characters
Picture(1 To 4) As Object
PictureName(1 To 4) As String
Position(1 To 4) As Range
NextPosition(1 To 4) As Range
Rgb(1 To 4, 1 To 3) As Byte
Rotate(1 To 4) As Integer
Direction(1 To 4) As String
IsHit(1 To 4) As Boolean
IsHungry(1 To 4) As Boolean
Timing(1 To 4) As Date
Speed(1 To 4) As Date
IsOnMoves(1 To 4) As Boolean
IsOpen(1 To 4) As Boolean
DEBUG As Boolean
End Type
Public Pacman As Characters
'Public Ghosts As Characters
Ceci étant fait, on définit les variables du pacman:
Function DefinePacman()
Set Pacman.Picture(1) = ActiveSheet.Shapes("pacOpen")
Set Pacman.Picture(2) = ActiveSheet.Shapes("pacClose")
Pacman.PictureName(1) = "pacOpen"
Pacman.PictureName(2) = "pacClose"
Set Pacman.Position(1) = Range("BF13")
Set Pacman.NextPosition(1) = Range("A1")
Pacman.Rgb(1, 1) = 255
Pacman.Rgb(1, 2) = 255
Pacman.Rgb(1, 3) = 87
Pacman.Direction(1) = "right"
Pacman.IsHit(1) = False
Pacman.IsHungry(1) = False
Pacman.Timing(1) = 0.8
Pacman.Speed(1) = 0.8
Pacman.IsOnMoves(1) = False
Pacman.Rotate(1) = 0
Pacman.Rotate(2) = 0
Pacman.IsOpen(1) = True
MoveObject Pacman.PictureName(1), Pacman.Position(1)
MoveObject Pacman.PictureName(2), Pacman.Position(1)
SetPictureDisplayMode Pacman.PictureName(1), True
SetPictureDisplayMode Pacman.PictureName(2), False
End Function
Comme vous pouvez le constater, l'objet pacman est en 2 Shapes, un bouche ouverte et l'autre presque fermée:
Lors du déplacement, le pacman va être animé en affichant successivement ces deux shapes, avec ce genre de fonction, ici pour le test:
Function AnimatePacman()
If Pacman.DEBUG = False Then
If Pacman.IsOpen(1) = True Then
SetPictureDisplayMode Pacman.PictureName(2), True
SetPictureDisplayMode Pacman.PictureName(1), False
Pacman.IsOpen(1) = False
Else
SetPictureDisplayMode Pacman.PictureName(1), True
SetPictureDisplayMode Pacman.PictureName(2), False
Pacman.IsOpen(1) = True
End If
Application.OnTime Now + TimeValue("00:00:01"), "AnimatePacman"
End If
End Function
Vous pouvez tester avec les boutons ( la tempo n'est pas gérée pour le moment, pas d'inquiétude )
Voilà c'est tout pour aujourd'hui
Le fichier avec les modifs ( je vais supprimer les autres, je ne laisserai que le dernier à chaque fois )
<code'ialement/>
Bonsoir,
je suis embêtant, mais bon, ce n'est que des propositions...
Le deuxième soucis de l'application Ontime en plus de la limite à la seconde, c'est qu'à chaque "lancement" le sablier de la souris se met "en marche", alors pas longtemps, mais toutes les secondes...
Ci joint votre fichier avec deux procédures nouvelles et une variable "public" nouvelle et boolean.
là encore j'utilise le Do Loop :
un Do Loop qui change la visibilité du pacclose puisque celui-ci est devant le open, donc visible = close, invisible = open cette boucle s'arrête lors que l'on clique sur stop, car la variable AnimLRD passe à faux. Dans cette boucle il y a une deuxième boucle Do Loop qui elle s'interrompt en fonction de la valeur de la cellule Durée qui indique la vitesse de mouvement du pacman. Avec le DoEvents il est tout à fait possible de "faire autre chose", reste à voir si c'est compatible avec le fait de modifier une valeur de cellules par VBA. L'avantage "esthétique" c'est qu'il n'y a pas le sablier.
Votre fichier modifié :
Je me suis "amusé" à faire la même chose avec les fantômes afin que leur bas "de draps" aient les vagues qui bougent, soit au moins deux images par fantôme soit 2 x 4 à mettre en mémoire... Mais le fichier est "au boulot" et la sécurité empêche tout transfert avec macro...
@ bientôt
LouReeD
Bonjour LouReeD
Comme mentionné, c'était juste pour le test, le ontime sera remplacé par une boucle comme dans le 1er jeu
Pas mal du tout cette façon de faire:
ActiveSheet.Shapes("pacClose").Visible = Not ActiveSheet.Shapes("pacClose").Visible
Pour le drapé du bas des fantômes, ça peut être fun, mais j'hésites il y'a déjà l'animation des yeux selon la direction, à voir !!
Bonne journée
<code'ialement/>
Pour le drapé c'est seulement deux images comme pour le pac, sauf qu'il faut changer ces deux images en fonction de la direction, chose qui sera faite au moins pour une : la direction des yeux.
Pour la technique du NOT je l'ai vu y a pas mal de temps et c'est vrai que c'est simple.
@ bientôt
LouReeD
Bien vu, je valide !!!
Oui ça peut faire 8 images, au final c'est raisonnable pour un joli effet !!
Petite question, j'ai modifié le code pour le structurer comme j'ai l'habitude de le faire en javascript.
Donc j'ai créé un module pour chaque type, c'est quand même plus lisible je trouve, sauf que ça ne fonctionne pas comme je voudrais
J'ai dû louper un truc, on est condamné à laisser la définition des variables sur le même module que d'où ou les utilise ?
ci joint le fichier test avec ces modifs, Vous pouvez voir que les sub des boutons donnent une alerte !!!
SI jamais vous avez 2mn ^ merci par avance pour m'expliquer la combine
J'ai trouvéééé
J'avais appelé un module du même nom qu'une variable (Map) du coup Excel ne comprenait plus ce que je voulais
Voici donc le fichier avec le ménage fait, bien structuré et la boucle des mouvements en place !!
Bonsoir, suite
Beaucoup d'ajouts pour cette fois:
Placement du pacman sur la map, définition des mouvements, de l'avance automatique, du passage par le portail, capture des ball et dots.
On garde toujours la boucle du mouvement de départ à laquelle on vient ajouter les différentes fonctions:
Public Function GameMovements()
DisableKeyPad
Dim Tempo As Date
Do
Tempo = Timer
AnimatePacman
CheckCollisionDots
ContinuePacMovement
CheckCollisionBalls
Do
DoEvents
GetAsyncKeyPad
Loop While Tempo + Pacman.Timing(1) > Timer
Loop While Pacman.IsAnimate(1)
End Function
Perso je trouve ça super lisible et pratique à modifier, mais je suis preneur de tout avis
On va pouvoir aussi réutiliser ces fonctions génériques pour le déplacement des fantômes:
Function SetCharacterMoves(ThisRow As Integer, ThisCol As Integer, ThisCharacter As Characters)
If Not Intersect(Gates.InLeft, ThisCharacter.Position(1).Offset(ThisRow, ThisCol)) Is Nothing Then
Set ThisCharacter.Position(1) = Gates.OutRight
ElseIf Not Intersect(Gates.InRight, ThisCharacter.Position(1).Offset(ThisRow, ThisCol)) Is Nothing Then
Set ThisCharacter.Position(1) = Gates.OutLeft
Else
Set ThisCharacter.Position(1) = ThisCharacter.Position(1).Offset(ThisRow, ThisCol)
End If
MoveObject ThisCharacter.PictureName(1), ThisCharacter.Position(1)
MoveObject ThisCharacter.PictureName(2), ThisCharacter.Position(1)
End Function
Public Function IsOnTheRoad(ThisRow As Integer, ThisCol As Integer, ThisCharacter As Characters) As Boolean
If Intersect(Roads, ThisCharacter.Position(1).Offset(ThisRow, ThisCol)) Is Nothing Then
ThisCharacter.IsOnMoves(1) = False
IsOnTheRoad = False
Else
ThisCharacter.IsOnMoves(1) = True
IsOnTheRoad = True
End If
End Function
On verra ensuite pour encore optimiser les fonctions communes !
Pour le moment on active le test avec le bouton 'animate pacman'.
Prochaine étape: déclarer les autres variables du jeu, comme le score, les bonus, l'affichage, etc
Bonsoir !
Et bravo ! Je suis fan ! J'aimerais savoir faire ceci aussi vite !
Mais bon pas facile de tout comprendre pour un néophyte comme moi !
manque peut-être un peu de commentaire dans les fonctions, mais bon vu que c'est progressif !
On voit bien "l'habitué des codes" !
Encore bravo, et j'ai cette impression que vous allez au bout du projet !
@ bientôt
LouReeD
Bonjour
Merci !! Et moi je vois que j'ai la chance d'être tombé sur le bon acolyte pour venir à bout de ce petit projet !!
C'est vrai que je ne suis pas généreux en commentaires, après je pense que tout est bien nommé !??
Par exemple ça donnerait ça, perso je trouve que c'est de la répétition, vu le nommage des variables et des fonction:
'Fonction test collision avec les 'balls'
Public Function CheckCollisionBalls()
Dim ThisElement As Byte
'pour les 4 boules
For ThisElement = 1 To 4
' si pacman entre en collision avec la boule en cours
If Not Intersect(Balls.Place(ThisElement), Pacman.Position(1)) Is Nothing Then
'et si la boule n'a pas déjà été mangée
If Not Balls.isSwallowed(ThisElement) Then
'désactiver l'affichage de la boule
SetPictureDisplayMode Balls.Picture(ThisElement), False
'définir que la boule est mangée
Balls.isSwallowed(ThisElement) = True
'ajouter au score le bonus de la boule
Score.Actual = Score.Actual + Balls.Bonus(1)
End If
End If
Next ThisElement
End Function
Une fonction commence par un verbe (une fonction fait quelque chose), un bolleen pas Is ( est vrai ou est faux) un range contient place ou position, etc
Et le fait d'ajouter des fonctions qui ne contiennent qu'une ligne c'est justement pour structurer et aider à la lecture, du fait du nommage
Certains développeurs nomment n'importe comment ( a, i, j, toto ) et imbriquent tout ça dans une soupe immonde, pas bien indenté, c'est l'horreur.
Dans ce cas je comprends vraiment l'utilité des commentaires.
Certains passages peuvent prêter à confusion et dans ce cas je vais prendre le temps de mettre quelques indications, désolé
Alors sinon pour la suite, pas grand chose de plus, clignotement des balls, modification des boutons et ajout d'un score.
C'est du basique pour le moment, aucune idée de comment ça sera affiché au final, mais il faut bien avancer
<code'ialement/>
Bonsoir,
Sympa ce petit GIF
Il me semblait de ce que j'avais pu lire qu'on ne peut pas intégrer un gif animé directement dans un fichier excel comme un photo, mais "l'appeler" avec son chemin, donc avoir un gif à part, je peux me tromper ! ?
Après voir aussi si on a besoin de modifier sa couleur.
<code'ialement/>
Bonjour,
Insertion image, puis couleur transparente sur le noir par exemple.
pour l'exemple :
Je n'ai pas réussi à modifier le code pour le flip alors PacMan se met à danser vers la gauche !
@ bientôt
Chez moi le GIF n'est pas animé, si je ne me trompes pas on ne peut pas insérer un gif animé
Sinon oui l'idée est bonne !!
<code'ialement/>
2007! Forcément ! Mois sous 365 ça marche...
Bon ça change tout pour "mon" ArkaLouReeD... Pour les capsules...
@ bientôt
LouReeD