Deplacement de form comme dans starcraft

Télécharger le projet
Commenter

Description

Et ben oui c'est pour faire des déplacements de formulaire de gauche à droite, de haut en bas ou en diagonales, et ça marche aussi de droite à gauche et de bas en haut mais pas toujours je sais pas pourquoi, j'ai fait ça hier soir en 20 minutes après Il était une fois dans l'ouest alors j'étais crevé et j'ai pas calculé...

Mettre le code dans un module, et appeller la sub deplace...
Dans le zip y a une sorte d'exemple ( ce qui m'a servi a le teste... )

Source / Exemple : 


Option Explicit

Public Type DeplaceType

    fromX As Long 'x de départ
    fromY As Long ' y de départ
    toX As Long 'x d'arrivée
    toY As Long 'y d'arrivée
    'during As Long ' durée de l'action, en milisecondes bien entendu 'annulé parce que ça ne marche pas chez moi, soit sa change rien, soit c'est trop lent
    
End Type

Public Sub deplace(frm As Form, deplacement As DeplaceType)
    
    Dim distanceAparcourir As Long
    Dim i As Long
    Dim deplaceHorz As Long
    Dim deplaceVert As Long
    Dim pas
    
    deplaceHorz = deplacement.toX - deplacement.fromX
    deplaceVert = deplacement.toY - deplacement.fromY
    frm.Visible = True
    
    
    
    If deplaceHorz > deplaceVert Then
    'si la distance horizontale à parcourir est > à la distance vericale à parcourir
    
        For i = 1 To deplaceHorz
            
            
            frm.Left = deplacement.fromX + i
            frm.Top = deplacement.fromY + (i / deplaceHorz) * deplaceVert
            
            'Sleep (deplacement.during / deplaceHorz) 'annulé parce que ça ne marche pas chez moi, soit sa change rien, soit c'est trop lent
            
            DoEvents
        
        Next i
        
    
    ElseIf deplaceHorz < deplaceVert Then
    'si la distance horizontale < à la distance vericale
        
        For i = 1 To deplaceVert
    
            frm.Top = deplacement.fromY + i
            frm.Left = deplacement.fromX + (i / deplaceVert) * deplaceHorz
            
            'Sleep (deplacement.during / deplaceVert) 'annulé parce que ça ne marche pas chez moi, soit sa change rien, soit c'est trop lent
            
            DoEvents
        
        Next i
        
    
    
    ElseIf deplaceHorz = deplaceVert Then
    'blablabla égale blablabla
    
        For i = 0 To deplacement.toX - deplacement.fromX
            
            frm.Top = deplacement.fromY + i
            frm.Left = deplacement.fromX + i
            
            'Sleep (deplacement.during / deplaceHorz) 'annulé parce que ça ne marche pas chez moi, soit sa change rien, soit c'est trop lent
            
            DoEvents
            
            
        Next i
    End If
    

    

End Sub

Conclusion :


Encore un prog pourri qui sert à rien de Alain Proviste...
Au fait si vous arrivez à faire un déplacement de bas-droit à haut-gauche envoyer le code rectifié.

guesavo@hotmail.com
Télécharger le projet

Codes Sources

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 (cs_Alain Proviste)