Movingeffects 1.4 : effets de mouvements fluides pour vos controles

Description

tout commence en cours de SI (science de l'ingénieur) et voilà que le prof il nous sort des équations fantastiques pour les mouvements :
- accélération :
X(t) = (a/2)*t² + VitesseInit * T + PosInit
- mouvement régulier :
X(t) = VitesseInit * T + PosInit
- accélération :
X(t) = (a/2)*t² + VitesseInit * T + PosInit
(a est négatif)

a est l'accélération au choix

de ces équations j'en ai fait un algorithme pour que lors d'un déplacement d'un controle ou d'une fenêtre, le déplacement se divise en 3 parties : accélération, mvt régulier et décélération.
Puis je l'ai adapté pour que ça marche aussi à l'envers.
Ensuite je suis resté sur ma faim, je voulais aussi un mouvement selon 2 axes, X et Y donc.
Donc pour que tout soit synchro, j'ai fait Y en fonction de X grace au théorème de Thalès.

Puis après avoir réglé qq probs, voilà, ça marche super, je l'utilise déjà dans plein de programmes parce que je l'ai fait super facile à utiliser.
Y'a 2 fonctions, une pour le déplacement et une pour le redimensionnement.
Et voilà j'ai essayé de commenter un max, mais j'ai surtout commenté la première fonction, les autres sont pareils.
Maintenant y'a 4 vitesses, et à noter que dans le mouvement j'ai mis des doevents pour que votre programme soit encore opérationnel meme dans le mouvement.

vous inquiétez pas c super simple à utiliser

Source / Exemple :


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' -------------------------------------------------------------
' Fonction d'effets de mouvements très jolis
' merci aux équations de mr Voyer (c'est mon prof de SI) lol !
' (ced je t'avais dit que c'était trop de la balle ces machins)
' -------------------------------------------------------------
'                  Réalisé par Matthieu Napoli
'                           MadMatt
'                         version 1.4
' -------------------------------------------------------------
' le 30/06/05

' améliorations :
' - on peut faire des mouvements et des redimmensionnements dans tous les sens
' - plus rapide, plus précis, plus fluide
' - on peut régler la vitesse du mouvement et du redimensionnement
' - les vitesses sont mieux gérées et plus différentes

Public Const ME_LENT = 10
Public Const ME_MOYEN = 20
Public Const ME_RAPIDE = 30
Public Const ME_TRES_RAPIDE = 40

' Effet de mouvement
Public Function MoveEffect(Object1 As Object, x1 As Long, y1 As Long, x2 As Long, y2 As Long, Vitesse As Long)

    ' Cet algorithme ne permet pas de bouger l'objet seulement selon l'axe y
    If x1 = x2 Then MoveEffectY Object1, y1, y2, Vitesse: Exit Function

    Object1.Left = x1
    Object1.Top = y1
    
    ' TimeAdd est le temps ajouté à chaque boucle
    Dim TimeAdd As Single
    ' Les positions
    Dim X As Single
    Dim Y As Single
    ' T est le temps (l'unité de temps est fictive)
    Dim T As Single
    ' A est l'accélération
    Dim A As Single
    ' SleepTime est le temps d'attente entre chaque rafraîchissement
    Dim SleepTime As Long
    ' Temp1 est le temps mis pour la première phase
    Dim Temps1 As Single
    
    ' Phase d'accélération
    T = 0
    ' Détermine l'accélération et la vitesse
    Select Case Vitesse
        Case Is = ME_LENT
            A = 15
            SleepTime = 12
            TimeAdd = 0.25
        Case Is = ME_MOYEN
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
        Case Is = ME_RAPIDE
            A = 25
            SleepTime = 7
            TimeAdd = 0.3
        Case Is = ME_TRES_RAPIDE
            A = 30
            SleepTime = 5
            TimeAdd = 0.5
        Case Else
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
    End Select
    If x1 > x2 Then A = -A
    Do
        T = T + TimeAdd
        X = (A / 2) * T * T + x1
        ' grâce au théorème de thalès
        Y = ((y2 - y1) / 3) * (X - x1) / ((x2 - x1) / 3) + y1
        Object1.Left = X
        Object1.Top = Y
        DoEvents
        Sleep SleepTime
        DoEvents
        ' L'utilisation des valeurs absolues sont indispensables pour les mouvements
        ' en arrière.
    Loop Until Abs(X - x1) >= Abs((x2 - x1) / 3) And Abs(Y - y1) >= Abs((y2 - y1) / 3)
    
    Temps1 = T
    
    ' Récupère la vitesse et la position à la fin de l'accélération
    Dim V1x As Single
    Dim V1y As Single
    Dim x3, y3 As Single
    V1x = A * T
    ' on utilise le théorème de Thalès
    V1y = ((y2 - y1) / T) * V1x / ((x2 - x1) / T)
    x3 = X
    y3 = Y
    
    ' Remet le compteur à zéro
    T = 0
    
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        X = V1x * T + x3
        ' merci encore thalès
        Y = ((y2 - y3) / 3) * (X - x3) / ((x2 - x3) / 3) + y3
        Object1.Left = X
        Object1.Top = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(X - x3) >= Abs(2 * (x2 - x3) / 3) And Abs(Y - y3) >= Abs(2 * (y2 - y3) / 3)
    
    ' Récupère les positions
    Dim x4, y4 As Single
    Dim V2x, V2y As Single
    ' Les vitesses n'ont pas changées : pas d'accélération
    V2x = V1x
    V2y = V1y
    ' Relève les positions
    x4 = X
    y4 = Y

    ' Remet le compteur à zéro
    T = 0
    ' Calcul de l'accélération
    ' on calcule la pente de la droite de la vitesse par rapport au temps
    ' (variation de la vitesse) / (variation du temps)
    ' (variation du temps) = distance / vitesse (v=d/t donc t=d/v)
    ' pour la vitesse on prend la moyenne des 2 extrèmes car c'est une droite
    A = (0 - V2x) / ((x2 - x4) / (V2x / 2))

    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        X = (A / 2) * T * T + V2x * T + x4
        ' merci encore thalès
        Y = ((y2 - y4) / 3) * (X - x4) / ((x2 - x4) / 3) + y4
        Object1.Left = X
        Object1.Top = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(X - x4) + 9 >= Abs(x2 - x4) And Abs(Y - y4) + 9 >= Abs(y2 - y4)
    
    ' Synchronise bien la position demandée avec celle obtenue
    Object1.Top = y2
    Object1.Left = x2
    
    ' et voilà

End Function

' L'effet de déplacement de l'objet selon l'axe vertical seulement
Public Function MoveEffectY(Object1 As Object, y1 As Long, y2 As Long, Vitesse As Long)
    Object1.Top = y1
    ' TimeAdd est le temps ajouté à chaque boucle
    Dim TimeAdd As Single
    ' La position Y
    Dim Y As Single
    ' T est le temps (l'unité de temps est fictive)
    Dim T As Single
    ' A est l'accélération
    Dim A As Long
    ' SleepTime est le temps d'attente entre chaque rafraîchissement
    Dim SleepTime As Long
    ' Phase d'accélération
    T = 0
    ' Détermine l'accélération
    Select Case Vitesse
        Case Is = ME_LENT
            A = 15
            SleepTime = 12
            TimeAdd = 0.25
        Case Is = ME_MOYEN
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
        Case Is = ME_RAPIDE
            A = 25
            SleepTime = 7
            TimeAdd = 0.3
        Case Is = ME_TRES_RAPIDE
            A = 30
            SleepTime = 5
            TimeAdd = 0.5
        Case Else
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
    End Select
    If y1 > y2 Then A = -A
    Do
        T = T + TimeAdd
        Y = (A / 2) * T * T + y1
        Object1.Top = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(Y - y1) >= Abs((y2 - y1) / 3)
    ' Récupère la vitesse et la position à la fin de l'accélération
    Dim V1y As Single
    Dim y3 As Single
    V1y = A * T
    y3 = Y
    ' Remet le compteur à zéro
    T = 0
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        Y = V1y * T + y3
        Object1.Top = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(Y - y3) >= Abs(2 * (y2 - y3) / 3)
    ' Récupère les positions
    Dim y4 As Single
    Dim V2y As Single
    ' Les vitesses n'ont pas changées : pas d'accélération
    V2y = V1y
    ' Relève les positions
    y4 = Y
    ' Remet le compteur à zéro
    T = 0
    ' Calcul de l'accélération
    A = (0 - V2y) / ((y2 - y4) / (V2y / 2))
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        Y = (A / 2) * T * T + V2y * T + y4
        Object1.Top = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(Y - y4) + 9 >= Abs(y2 - y4)
    Object1.Top = y2
End Function

' L'effet de redimmensionnement
' Exactement la même chose que précédemment sauf qu'on redimmensionne au lieu de déplacer
Public Function ScaleEffect(Object1 As Object, x1 As Long, y1 As Long, x2 As Long, y2 As Long, Vitesse As Long)

    ' Cet algorithme ne permet pas de redimmensionner l'objet seulement selon l'axe y
    If x1 = x2 Then ScaleEffectY Object1, y1, y2, Vitesse: Exit Function

    Object1.Width = x1
    Object1.Height = y1
    
    ' TimeAdd est le temps ajouté à chaque boucle
    Dim TimeAdd As Single
    ' Les positions
    Dim X As Single
    Dim Y As Single
    ' T est le temps (l'unité de temps est fictive)
    Dim T As Single
    ' A est l'accélération
    Dim A As Long
    ' SleepTime est le temps d'attente entre chaque rafraîchissement
    Dim SleepTime As Long
        
    ' Phase d'accélération
    T = 0
    ' Détermine l'accélération
    Select Case Vitesse
        Case Is = ME_LENT
            A = 15
            SleepTime = 12
            TimeAdd = 0.25
        Case Is = ME_MOYEN
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
        Case Is = ME_RAPIDE
            A = 25
            SleepTime = 7
            TimeAdd = 0.3
        Case Is = ME_TRES_RAPIDE
            A = 30
            SleepTime = 5
            TimeAdd = 0.5
        Case Else
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
    End Select
    If x1 > x2 Then A = -A
    Do
        T = T + TimeAdd
        X = (A / 2) * T * T + x1
        ' grâce au théorème de thalès
        Y = ((y2 - y1) / 3) * (X - x1) / ((x2 - x1) / 3) + y1
        Object1.Width = X
        Object1.Height = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(X - x1) >= Abs((x2 - x1) / 3) And Abs(Y - y1) >= Abs((y2 - y1) / 3)
    
    ' Récupère la vitesse et la position à la fin de l'accélération
    Dim V1x As Single
    Dim V1y As Single
    Dim x3, y3 As Single
    V1x = A * T
    ' on utilise le théorème de Thalès
    V1y = ((y2 - y1) / T) * V1x / ((x2 - x1) / T)
    x3 = X
    y3 = Y
    
    ' Remet le compteur à zéro
    T = 0
    
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        X = V1x * T + x3
        ' merci encore thalès
        Y = ((y2 - y3) / 3) * (X - x3) / ((x2 - x3) / 3) + y3
        Object1.Width = X
        Object1.Height = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(X - x3) >= Abs(2 * (x2 - x3) / 3) And Abs(Y - y3) >= Abs(2 * (y2 - y3) / 3)
    
    ' Récupère les positions
    Dim x4, y4 As Single
    Dim V2x, V2y As Single
    ' Les vitesses n'ont pas changées : pas d'accélération
    V2x = V1x
    V2y = V1y
    ' Relève les positions
    x4 = X
    y4 = Y

    ' Remet le compteur à zéro
    T = 0
    ' Calcul de l'accélération
    A = (0 - V2x) / ((x2 - x4) / (V2x / 2))
    
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        X = (A / 2) * T * T + V2x * T + x4
        ' merci encore thalès
        Y = ((y2 - y4) / 3) * (X - x4) / ((x2 - x4) / 3) + y4
        Object1.Width = X
        Object1.Height = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(X - x4) + 9 >= Abs(x2 - x4) And Abs(Y - y4) + 9 >= Abs(y2 - y4)
    Object1.Width = x2
    Object1.Height = y2

End Function

' L'effet de redimmensionnement de l'objet selon l'axe vertical seulement
Public Function ScaleEffectY(Object1 As Object, y1 As Long, y2 As Long, Vitesse As Long)
    Object1.Height = y1
    ' TimeAdd est le temps ajouté à chaque boucle
    Dim TimeAdd As Single
    ' La position Y
    Dim Y As Single
    ' T est le temps (l'unité de temps est fictive)
    Dim T As Single
    ' A est l'accélération
    Dim A As Long
    ' SleepTime est le temps d'attente entre chaque rafraîchissement
    Dim SleepTime As Long
    ' Phase d'accélération
    T = 0
    ' Détermine l'accélération
    Select Case Vitesse
        Case Is = ME_LENT
            A = 15
            SleepTime = 12
            TimeAdd = 0.25
        Case Is = ME_MOYEN
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
        Case Is = ME_RAPIDE
            A = 25
            SleepTime = 7
            TimeAdd = 0.3
        Case Is = ME_TRES_RAPIDE
            A = 30
            SleepTime = 5
            TimeAdd = 0.5
        Case Else
            A = 20
            SleepTime = 10
            TimeAdd = 0.25
    End Select
    If y1 > y2 Then A = -A
    Do
        T = T + TimeAdd
        Y = (A / 2) * T * T + y1
        Object1.Height = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(Y - y1) >= Abs((y2 - y1) / 3)
    ' Récupère la vitesse et la position à la fin de l'accélération
    Dim V1y As Single
    Dim y3 As Single
    V1y = A * T
    y3 = Y
    ' Remet le compteur à zéro
    T = 0
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        Y = V1y * T + y3
        Object1.Height = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(Y - y3) >= Abs(2 * (y2 - y3) / 3)
    ' Récupère les positions
    Dim y4 As Single
    Dim V2y As Single
    ' Les vitesses n'ont pas changées : pas d'accélération
    V2y = V1y
    ' Relève les positions
    y4 = Y
    ' Remet le compteur à zéro
    T = 0
    ' Calcul de l'accélération
    A = (0 - V2y) / ((y2 - y4) / (V2y / 2))
    ' Phase de vitesse constante
    Do
        T = T + TimeAdd
        Y = (A / 2) * T * T + V2y * T + y4
        Object1.Height = Y
        DoEvents
        Sleep SleepTime
        DoEvents
    Loop Until Abs(Y - y4) + 9 >= Abs(y2 - y4)
    Object1.Height = y2
End Function

Conclusion :


euh je croi que j'ai tout dit, j'en ai dit pas mal quand meme.
pas de capture c pas possible de capturer un mouvement ;-)

please des notes et des commentaires merci bien ;-)

@ +
MadMatt

(par contre pour cette source si vous y utilisez laissez l'en-tête c'est sympa pour l'auteur merci :-)

Codes Sources

A voir également

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.