[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

136pacman-excel.zip (1.48 Mo)

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:

kisspng pac man party ms pac man maze madness video game wood floors 5ae01a8ef34707 4876696615246363029965

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:

basewalls

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 :

capture

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

capture

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 ( édit: voir dernier post )

<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

capture

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/>

Pratique d'être insomniaque

Je vous présente les fantômes créés en 'shapes', dans l'ordre: Blinky, Pinky, Inky et Clyde

3

Et pour le réalisme des mouvements originaux, ils sont en 4 versions chacun:

1

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:

open close

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 )

buttons

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

capture
15test-pacman.zip (1.55 Mo)

<code'ialement/>

Bonsoir,

je me suis amusé à ceci qui peut (peut-être) simplifier le code d'animation... Il faut lui mettre la couleur noir en transparence...

pacman

@ bientôt

LouReeD

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 :

28pacman-lrd-5.zip (1.54 Mo)

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

Rechercher des sujets similaires à "vba jeu pacman 1980"