Simulation de rebonds

Commenter

Contenu du snippet

(Y a aussi un *.zip)
Oh c'est joli, on dirait des lucioles...
Vous pouvez changer les paramètres (Nombre de particules, Vitesse...) en touchant un peu à la procédure "Sub Ini ()". Les valeurs Interval et MaxVitesse... Vous comprendrez...
Pour changer le nombre de particules, faut changer la constante NombreParticules.
Que dire de plus ? Ah oui, Il vous faut une feuille (Form1) et un module (Module1)
Le code est un peu commenté... Ah oui une dernière chose, pardon encore à Mr.X pour avoir volé sa source de pause dans le code : Xwait.

Source / Exemple : 


'A mettre dans le module :

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Type Position
    X As Single
    Y As Single
End Type

Type Vecteur
    VectX As Single
    VectY As Single
End Type

Type Balle
    PositionBalle As Position
    VecteurBalle As Vecteur
    Gravité As Single
End Type

Function Rebondir(Balle1 As Balle, Surface As Object)

'Si la Valeur "X" c'est à dire la position horizontale de la Balle dépasse une des limites de la feuille
'(supérieure à la largeur de celle-ci ou inférieure ou égale à l'origine) alors on calcule le vecteur X Inversé de la balle
' Pour faire repartir la balle dans le sens inverse (celà uniquement si le vecteur est positif : imaginons que la balle soit
' allée beaucoup trop loin et qu'elle ne puisse revenir en une seule étape. Elle est hors-limites mais si les valeurs de son vecteur
' sont inversées... -> boucle sans fin.

    If Balle1.PositionBalle.X + Balle1.VecteurBalle.VectX >= Surface.Width Then
        If Balle1.VecteurBalle.VectX > 0 Then
            Balle1.VecteurBalle.VectX = Balle1.VecteurBalle.VectX - (Balle1.VecteurBalle.VectX * 2)
        End If
    ElseIf Balle1.PositionBalle.X + Balle1.VecteurBalle.VectX <= 0 Then
        If Balle1.VecteurBalle.VectX < 0 Then
            Balle1.VecteurBalle.VectX = Balle1.VecteurBalle.VectX - (Balle1.VecteurBalle.VectX * 2)
        End If
    End If
    
'Pareil pour la valeur "Y"
    If Balle1.PositionBalle.Y + Balle1.VecteurBalle.VectY >= Surface.Height Then
        If Balle1.VecteurBalle.VectY > 0 Then
            Balle1.VecteurBalle.VectY = Balle1.VecteurBalle.VectY - (Balle1.VecteurBalle.VectY * 2)
        End If
    ElseIf Balle1.PositionBalle.Y + Balle1.VecteurBalle.VectY <= 0 Then
        If Balle1.VecteurBalle.VectY < 0 Then
            Balle1.VecteurBalle.VectY = Balle1.VecteurBalle.VectY - (Balle1.VecteurBalle.VectY * 2)
        End If
    End If
       
'On affecte les Valeurs X et Y
    Balle1.PositionBalle.X = Balle1.PositionBalle.X + Balle1.VecteurBalle.VectX
    Balle1.PositionBalle.Y = Balle1.PositionBalle.Y + Balle1.VecteurBalle.VectY

End Function

Public Sub xWait(ByVal MilsecToWait As Long)
    Dim lngEndingTime As Long
  
    lngEndingTime = GetTickCount() + (MilsecToWait)
    Do While GetTickCount() < lngEndingTime
        DoEvents
    Loop
End Sub

'Puis à mettre dans le code de la feuille :

Option Explicit
Const NombreParticules As Integer = 100                             'Le nombre total de particules
Dim Balles(0 To NombreParticules) As Balle                          'Les "Balles"
Dim Interval As Integer, MaxVitesse As Integer                      'Les autres variables (Fréquence de mise à jour et Vitesse Maximum

Private Sub Form_Click()
End
End Sub

Private Sub Form_Load()
Dim i
Me.Show
Me.DrawWidth = 5
'Pour afficher la feuille (obligatoire, sinon la boucle exécutée juste après empèche cet affichage)
Init
Do
For i = 0 To NombreParticules
    Rebondir Balles(i), Me          'Appel à la Fonction d'actualisation des positions
    Me.PSet (Balles(i).PositionBalle.X - Balles(i).VecteurBalle.VectX, Balles(i).PositionBalle.Y - Balles(i).VecteurBalle.VectY), Me.BackColor
    Me.PSet (Balles(i).PositionBalle.X, Balles(i).PositionBalle.Y), vbWhite
    'Afficher les points sur la feuille (Position Recalculée) et effacer les points obsolètes (Tour d'avant : Position - Vecteur)
Next i
xWait Interval                      'Faire une pause marquant le délai d'actualisation
DoEvents                            'Indispensable ! pour que la boucle ne soit pas "femée"
Loop
End Sub

Sub Init()
Dim i
Interval = 10                       'Initialisation des variables d'Intervalle d'actualisation
MaxVitesse = 200                    'et de Vitesse Maximale.
For i = 0 To NombreParticules
    Randomize Timer                 'Indispensable pour avoir un "vrai" tirage aléatoire
    Balles(i).PositionBalle.X = (Me.Width) * Rnd        '|Place le point au hasard sur la feuille (X)
    Balles(i).PositionBalle.Y = (Me.Height) * Rnd       '|(Y)
    Balles(i).VecteurBalle.VectX = ((MaxVitesse * 2) * Rnd) - MaxVitesse    '|Génère une vitesse au hasard (X)
    Balles(i).VecteurBalle.VectY = ((MaxVitesse * 2) * Rnd) - MaxVitesse    '|(Y)
Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
End                 'Pour arrêter l'application (obligatoire, à cause de la boucle sinon la feuille sera rechargée à chaque fois)
End Sub

Conclusion :


Voilà... Y a aussi un *.zip

A voir également

S'inscrire maintenant

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.

Du même auteur (Whiterabbit83)