Soyez le premier à donner votre avis sur cette source.
Vue 5 446 fois - Téléchargée 600 fois
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
1 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!
1 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.