Jeu en gifs animés firecoin
Soyez le premier à donner votre avis sur cette source.
Vue 5 446 fois - Téléchargée 600 fois
Description
Voici un petit jeu en gifs animés
Le but étant de récupérer le plus de pièces possible en passant à travers les boules sans les toucher.
Des bonus apparaissent et permettent d'effectuer divers actions telles que gagner des points, détruire les boules, passer au travers, etc...
Pour les gifs animés, copiez la dll
gif89.dll dans votre system32 et tapez
regsvr32.exe gif89.dll dans exécuter.
Le but étant de récupérer le plus de pièces possible en passant à travers les boules sans les toucher.
Des bonus apparaissent et permettent d'effectuer divers actions telles que gagner des points, détruire les boules, passer au travers, etc...
Pour les gifs animés, copiez la dll
gif89.dll dans votre system32 et tapez
regsvr32.exe gif89.dll dans exécuter.
Source / Exemple :
Option Explicit
'Libraries pour la gestion de l'appuie des touches
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Dim Jeu As Integer
Dim foot As Integer 'Distance
Dim Sens As String 'Sens des boules
Dim Cpt As Integer 'Compteur de pièces
Dim Tps As Integer 'Temps que le bonus reste affiché
Dim TpsAff As Integer 'Temps d'affichage du bonus
Dim TpsBonus As Integer 'Temps que dure le bonus qd on l'a en milliseconde
Dim TabBoule(30, 1) As Integer 'Sens et vitesse
Dim Fairy As Integer 'Numéro de la fée affichée
Const Pressed = -32767
Private Sub Form_Load()
Randomize
Dim i As Integer
Show
foot = 36 'taille d'un pas (vitesse)
Fairy = 0 'On initialise la couleur de la fée
Cpt = 0 '0 pièces
For i = 0 To 30 'Initialisation du tableau des boules
TabBoule(i, 0) = 0 'Sens
TabBoule(i, 1) = 0 'Vitesse
Next i
Gif89a1.FileName = App.Path & "\left1.gif"
Gif89a1.AutoSize = True
Gif89a1.AutoStart = True
Gif89a2.FileName = App.Path & "\anneau.gif"
Gif89a2.AutoSize = True
Gif89a2.AutoStart = True
End Sub
'Nouvelle Partie
Private Sub New_Click()
Dim i As Integer
For i = 0 To 30
If TabBoule(i, 0) <> 0 Then
Unload Me.Gif89a3(i) 'On se décharge des boules
End If
TabBoule(i, 0) = 0 'On réinitialise
TabBoule(i, 1) = 0 'le tableau de boules
Next i
Me.Score = 0: Cpt = 0: TpsBonus = 0: TpsAff = 0
Me.Gif89a4.Visible = False
Me.Timer.Interval = 1 'on fait repartir le timer
End Sub
Private Sub Timer_Timer()
'Déplacement du personnage gestion de l'appuie sur les flèches
Select Case True
Case GetKeyState(&H28) < 0 'bas
If Me.Gif89a1.FileName <> App.Path & "\Down1.gif" Then
Me.Gif89a1.FileName = App.Path & "\Down1.gif"
End If
Me.Gif89a1.Top = ChkDpl(0, Me.Gif89a1.Top, 2, 1070, foot)
'Déplacement en diagonale
Select Case True
Case GetKeyState(&H25) < 0 'Gauche
Me.Gif89a1.Left = ChkDpl(Me.Gif89a1.Left, 0, 3, 1070, foot)
Case GetKeyState(&H27) < 0 'droite
Me.Gif89a1.Left = ChkDpl(Me.Gif89a1.Left, 0, 4, 610, foot)
End Select
Case GetKeyState(&H26) < 0 'haut
If Me.Gif89a1.FileName <> App.Path & "\Up1.gif" Then
Me.Gif89a1.FileName = App.Path & "\Up1.gif"
End If
Me.Gif89a1.Top = ChkDpl(0, Me.Gif89a1.Top, 1, 0, foot)
'Déplacement en diagonale
Select Case True
Case GetKeyState(&H25) < 0 'Gauche
Me.Gif89a1.Left = ChkDpl(Me.Gif89a1.Left, 0, 3, 1070, foot)
Case GetKeyState(&H27) < 0 'droite
Me.Gif89a1.Left = ChkDpl(Me.Gif89a1.Left, 0, 4, 610, foot)
End Select
Case GetKeyState(&H27) < 0 'droite
If Me.Gif89a1.FileName <> App.Path & "\right1.gif" Then
Me.Gif89a1.FileName = App.Path & "\right1.gif"
End If
Me.Gif89a1.Left = ChkDpl(Me.Gif89a1.Left, 0, 4, 610, foot)
Case GetKeyState(&H25) < 0 'gauche
If Me.Gif89a1.FileName <> App.Path & "\left1.gif" Then
Me.Gif89a1.FileName = App.Path & "\left1.gif"
End If
Me.Gif89a1.Left = ChkDpl(Me.Gif89a1.Left, 0, 3, 0, foot)
Case Else
Arret 'Le perso ne bouge plus
End Select
'Déplacement des boules
BoulesDpl
'Tps d'apparition de la fée
If TpsAff <> 0 Then
TpsAff = TpsAff - 1
'Collision avec la fée si elle est affichée
Collision Gif89a1.Left, Gif89a1.Top, _
Gif89a4.Left, Gif89a4.Top, _
Gif89a1.Width, Gif89a1.Height, _
Gif89a4.Width, Gif89a4.Height, "Z", "fee"
Else 'Si le temps d'affichage est mis à 0 en le touchant ou fin du compteur
If Me.Gif89a4.Visible = True Then _
Me.Gif89a4.Visible = False 'On fait disparaître la fée
End If
If TpsBonus <> 0 Then 'Fait clignoter le nom du bonus
If TpsBonus Mod 50 > 25 Then
If TpsBonus < 300 Then Me.Bonus.ForeColor = vbRed 'Change de couleur selon
If TpsBonus < 200 Then Me.Bonus.ForeColor = &H80FF& 'le temps qu'il reste
If TpsBonus < 100 Then Me.Bonus.ForeColor = vbYellow 'Avant de perdre le pouvoir
Else
Me.Bonus.ForeColor = vbBlack
End If
TpsBonus = TpsBonus - 1 'Réduction du TpsBonus de 6s
Else
Me.Bonus = ""
End If
End Sub
'Gestion des déplacements
Private Function ChkDpl(X As Integer, Y As Integer, Signe As Integer, Epaisseur As Integer, ByVal Vitesse As Integer) As Integer
Dim H As Integer
Dim L As Integer
Dim Dpl As Integer
Dpl = Vitesse
H = F2D.Height - Epaisseur 'calcul de la hauteur max
L = 4400 - Epaisseur 'calcul de la largeur max
Select Case Signe
Case 2 'vers le bas
If (Y + Dpl < H) Then
ChkDpl = Y + Dpl
Collision Gif89a1.Left, Gif89a1.Top, _
Gif89a2.Left, Gif89a2.Top, _
Gif89a1.Width, Gif89a1.Height, _
Gif89a2.Width, Gif89a2.Height, "Z", "coin"
Else
ChkDpl = Y
End If
Case 4 'vers la droite
If (X + Dpl < L) Then
ChkDpl = X + Dpl
Collision Gif89a1.Left, Gif89a1.Top, _
Gif89a2.Left, Gif89a2.Top, _
Gif89a1.Width, Gif89a1.Height, _
Gif89a2.Width, Gif89a2.Height, "Z", "coin"
Else
ChkDpl = X
End If
Case 1 'vers le haut
If (Y - Dpl > 0) Then
ChkDpl = Y - Dpl
Collision Gif89a1.Left, Gif89a1.Top, _
Gif89a2.Left, Gif89a2.Top, _
Gif89a1.Width, Gif89a1.Height, _
Gif89a2.Width, Gif89a2.Height, "Z", "coin"
Else
ChkDpl = Y
End If
Case 3 'vers la gauche
If (X - Dpl > 0) Then
ChkDpl = X - Dpl
Collision Gif89a1.Left, Gif89a1.Top, _
Gif89a2.Left, Gif89a2.Top, _
Gif89a1.Width, Gif89a1.Height, _
Gif89a2.Width, Gif89a2.Height, "Z", "coin"
Else
ChkDpl = X
End If
End Select
End Function
'Fait apparaître la pièce à un autre endroit qd on la touche
Private Sub DeplaceCoin()
Dim i As Integer
'On déplace la pièce
Gif89a2.Visible = False
Gif89a2.Left = ((3970 - Gif89a1.Width) * Rnd)
Gif89a2.Top = ((F2D.Height - 1070) * Rnd)
Gif89a2.Visible = True
Cpt = Cpt + 1
'On ajoute une boule
For i = 1 To 30
If TabBoule(i, 0) = 0 Then 'Si l'emplacement est vide
Load Gif89a3(i) 'création d'une nouvelle boule
Gif89a3(i).FileName = App.Path & "\boule.gif"
Gif89a3(i).AutoSize = True
Gif89a3(i).AutoStart = True
Gif89a3(i).Visible = True 'on les rend visibles et on les place
Gif89a3(i).Left = ((3970 - Gif89a1.Width) * Rnd)
Gif89a3(i).Top = ((F2D.Height - 1070) * Rnd)
TabBoule(i, 0) = (Rnd * 3) + 1 '1, 2, 3 ou 4 => Haut Bas Gauche Droite
TabBoule(i, 1) = (Rnd * 30) + 10 'vitesse
Exit For
End If
Next i
'Si on touche un certain nombre de pièces Apparition d'une fée => Bonus ou malus
If Cpt Mod 4 = 0 Then 'Tous les 4 anneaux
Fairy = (Rnd * 5) + 1 'On choisit une fée au hasard
Gif89a4.FileName = App.Path & "\fee" & Fairy & ".gif"
Gif89a4.AutoSize = True
Gif89a4.AutoStart = True
Gif89a4.Visible = True 'on les rend visibles et on les place
Gif89a4.Left = ((3970 - Gif89a4.Width) * Rnd)
Gif89a4.Top = ((F2D.Height - 1070) * Rnd)
TpsAff = 300 'Temps d'affichage du bonus => 6 secondes
End If
End Sub
'Gestion des collisions entre les différents objets
Private Sub Collision(X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer, L1 As Integer, H1 As Integer, L2 As Integer, H2 As Integer, Sens As String, Obj As String)
Select Case Sens
Case "Z" 'Gauche ou droite, même critère
Y1 = Y1 '+ 100
L1 = L1 '- 184
H1 = H1 '- 100
L2 = L2 - 20
H2 = H2 - 20
If (((X1 + L1) >= X2) And (X1 <= (X2 + L2))) Then
If (((Y1 + H1) >= Y2) And (Y1 <= (Y2 + H2))) Then
Select Case Left(Obj, 3)
Case "bou"
If TpsBonus <> 0 Then 'Si on a un bonus
FairyAction Fairy, Obj 'action spéciale
Else 'Sinon dès qu'on touche on perd
If Left(Obj, 5) = "boule" Then MsgBox "Perdu": Timer.Interval = 0: Arret: Me.New.SetFocus 'Perdu
End If
Case "coi": Me.Score = Me.Score + 80: DeplaceCoin 'On Change la pièce de place
Case "fee" 'Si la fée est visible et qu'on la touche
If Gif89a4.Visible = True Then
Efface Fairy 'On efface la fée et réalise quelques actions
End If
End Select
End If
End If
End Select
End Sub
'Arrêt de l'animation du personnage lorsqu'on ne le déplace pas
Private Sub Arret()
Select Case Me.Gif89a1.FileName
Case App.Path & "\Down1.gif": Me.Gif89a1.FileName = App.Path & "\Down0.gif"
Case App.Path & "\Up1.gif": Me.Gif89a1.FileName = App.Path & "\Up0.gif"
Case App.Path & "\left1.gif": Me.Gif89a1.FileName = App.Path & "\left0.gif"
Case App.Path & "\right1.gif": Me.Gif89a1.FileName = App.Path & "\right0.gif"
End Select
End Sub
'Efface la fée quand on la touche, attribution des bonus
Private Sub Efface(Couleur As Integer)
TpsBonus = 300 '6 secondes
Gif89a4.Visible = False 'On fait disparaître la fée
TpsAff = 0 'On réduit son temps d'affichage à 0
Me.Bonus.ForeColor = vbRed 'Couleur Rouge
Select Case Couleur 'Texte à afficher en cas de bonus ou malus :)
Case 1: Me.Bonus = "Destruction"
Case 2: Me.Bonus = "Invisible"
Case 3: Me.Bonus = "+ 160 pts": Me.Score = Me.Score + 160
Case 4: Me.Bonus = "Perdu": MsgBox "Perdu": Timer.Interval = 0: Arret: Me.New.SetFocus
Case 5: Me.Bonus = "- 160 pts": Me.Score = Me.Score - 160
End Select
End Sub
'Action en fonction de la couleur de la fée
Private Sub FairyAction(Couleur As Integer, Obj As String)
Select Case Fairy
Case 1 'Destruction
TabBoule(Right(Obj, 1), 0) = 0: TabBoule(Right(Obj, 1), 1) = 0
Unload Me.Gif89a3(Right(Obj, 1)) 'destruction de la boule q
Case 2 'On passe au travers - Invisible pas d'action
Case Else 'Gestion de la collision normale
MsgBox "Perdu": Timer.Interval = 0: Arret: Me.New.SetFocus 'Perdu
End Select
End Sub
'Déplacement des boules
Private Sub BoulesDpl()
Dim i As Integer
For i = 0 To 30
If i <> 0 Then
If (TabBoule(i, 0) <> 0) Then
Select Case TabBoule(i, 0) 'Gestion du déplacement
Case 2 'vers le bas
If Gif89a3(i).Top > (F2D.Height - 800) Then
TabBoule(i, 0) = 1
Else 'on change de sens
TabBoule(i, 0) = 2
End If
Case 1 'vers la haut
If Gif89a3(i).Top < 50 Then
TabBoule(i, 0) = 2
Else
TabBoule(i, 0) = 1
End If
Case 4 'vers la droite
If Gif89a3(i).Left > (3780) Then
TabBoule(i, 0) = 3
Else 'on change de sens
TabBoule(i, 0) = 4
End If
Case 3 'vers la gauche
If Gif89a3(i).Left < 50 Then
TabBoule(i, 0) = 4
Else
TabBoule(i, 0) = 3
End If
End Select
'Déplacement des boules
Select Case TabBoule(i, 0)
Case 3, 4 'Déplacement latéral X , Y, Sens , épaiseur, Vitesse
Gif89a3(i).Left = ChkDpl(Gif89a3(i).Left, 0, TabBoule(i, 0), 10, TabBoule(i, 1))
Case 1, 2
Gif89a3(i).Top = ChkDpl(0, Gif89a3(i).Top, TabBoule(i, 0), 10, TabBoule(i, 1))
End Select 'Collision avec le personnage
Collision Gif89a1.Left, Gif89a1.Top, _
Gif89a3(i).Left, Gif89a3(i).Top, _
Gif89a1.Width, Gif89a1.Height, _
Gif89a3(i).Width, Gif89a3(i).Height, "Z", "boule" & i
End If
End If
Next i
End Sub
Codes Sources
A voir également
- Firecoin app
- Coup de boule gif - Meilleures réponses
- Jeu de boules gif - Meilleures réponses
- Java app code - Guide
- Visual Basic / VB.NET : Un ocx pour positionner son app toujours au premier plan, icône tray, - Guide
- Multi-apps - Codes sources - Visual Basic / VB.NET (Formulaire)
- Visual Basic / VB.NET : Maya - app client serveur (chat & dl) - sans ip!!! - CodeS SourceS - Guide
- Fermer des app d'arrière plan - Codes sources - Visual Basic / VB.NET (API)
- Messages postés
-
940
- Date d'inscription
- jeudi 20 février 2003
- Statut
- Membre
- Dernière intervention
- 3 février 2011
91 déc. 2008 à 09:51
Moi j'aime bien le fond, tu voudrais que ça soit de quelle couleur? ^o)
Je voulais mettre une image dessus, mais les gifs sont transparent avec la couleur du form mais pas avec son image :s donc j'ai laissé le vert du coup.
J'ai utiliser un module parce qu'au départ je fais toujours ça, mais on peut tout mettre dans le form.
Pour les variables public j'aurais pu mettre dim, mais par habitude aussi j'ai mis public
Pour l'autosize, c'est pour ne pas à avoir à déterminé la taille de l'objet, le gif89 va la déterminer pour moi. gif4.visible = false c'est pour rendre la fée invisible qd le tpsAff est écoulé ou qu'on recommence.
2 raccourcis pour nouvelle partie, car Ctrl+A plus facile à faire que Ctrl+N (à mon avis) donc j'ai laissé les 2 :)
Pour la déclaration integer, jsuis au courant, mais j'ai eu la flemme de tout écrire, il devait être 3h du mat qd j'ai fait cette partie là.
Pour le perdu je comptais mettre le bonhomme qui tourne sur lui même et tombe, mais je n'ai pas trouver l'animation et pas eu le temps de la faire. Donc tout ceci sur la prochaine maj, en attendant, entraînez-vous!
- Messages postés
-
7393
- Date d'inscription
- mercredi 23 avril 2003
- Statut
- Membre
- Dernière intervention
- 6 avril 2012
591 déc. 2008 à 00:22
Petites améliorations possibles.
-Le fond vert brrrrr (flashee non?)
-Un simple Msgbox pour dire perdu??? (dommage non?)
- pourquoi 2 raccourcis pour nouvelle partie?
pour le code quelques petites améliorations.
-pourquoi utiliser un module?
-pourquoi mettre Jeu ,foot ,Sens ,Cpt ,Tps ,TpsAff ,TpsBonus en variables publiques??-pourquoi faire parfois Gif89a2.AutoSize True ET PARFOIS Me.Gif89a4.Visible False
Attentoin dans la déclaration Dim H, L, Dpl As Integer SEUL Dpl est de style integer H et L sont de type Variant
@+
Julien
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.