JEU EN GIFS ANIMÉS FIRECOIN

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