Bouger et redimensionner un controle avec la souris pendant l'execution

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 412 fois - Téléchargée 48 fois

Contenu du snippet

A pour but de permettre à l'utilisteur de votre appliq de modifier la taille et la position d'un controle sur une feuille et ce à l'aide de la souris. Il suffit pour ce faire de placer la ligne suivante dans l'evenement MOVE du controle : MoveObjet <nom du controle>, Button, X, Y.
Le bouton gauche enfoncé permet de redimensionner et le bouton droit permet de bouger (vous pouvez bien entendu changer ce choix).
Parallelement à cette ligne de code, créez un module comprenant les procedures reprises sous "Code spécifique" et l'affaire est jouée....-)))

Source / Exemple :


'Bouger ou redimensionner un objet
'   Bouton gauche enfoncé = redimension
'   Bouton droit enfoncé = bouger

Option Explicit
Dim OldX As Integer
Dim OldY As Integer

'---------------------------------------------------------
' Code des evenements Move des objets de la feuilles
'---------------------------------------------------------

'Quelques exemples

'Picturebox
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MoveObjet Picture1, Button, X, Y
End Sub

'Bouton
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MoveObjet Command1, Button, X, Y
End Sub

'Frame
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MoveObjet Frame1, Button, X, Y
End Sub

'Text
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MoveObjet Text1, Button, X, Y
End Sub

'List
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Pour un objet List : attribuez faux au parametre integralheight
    MoveObjet List1, Button, X, Y
End Sub

'---------------------------------------------------------
' Code spécifique...
'---------------------------------------------------------

'Il serait plus propre de positionner ces procedures dans un module.  Elles seraient
'alors disponibles pour toutes les feuilles de l'application.

Public Sub MoveObjet(Obj As Object, Button As Integer, X As Single, Y As Single)
    
    Select Case Button
        Case 1  'Bouton Gauche
            NewSize Obj, X, Y
        Case 2  'Bouton droit
            NewPosition Obj, X, Y
        Case Else
            OldX = X
            OldY = Y
    End Select

End Sub

Public Sub NewSize(Obj As Object, X As Single, Y As Single)
On Error Resume Next

    If X = OldX And Y = OldY Then Exit Sub

    If X > OldX Then
        Obj.Width = Obj.Width + (X - OldX)
    End If
    If X < OldX Then
        Obj.Width = Obj.Width - (OldX - X)
    End If
    
    If Y > OldY Then
        Obj.Height = Obj.Height + (Y - OldY)
    End If
    If Y < OldY Then
        Obj.Height = Obj.Height - (OldY - Y)
    End If
    
    OldX = X
    OldY = Y
    
End Sub

Public Sub NewPosition(Obj As Object, X As Single, Y As Single)
On Error Resume Next

    If X = OldX And Y = OldY Then Exit Sub
    
    If X > OldX Then
        Obj.Left = Obj.Left + (X - OldX)
    End If
    If X < OldX Then
        Obj.Left = Obj.Left - (OldX - X)
    End If
    If Y > OldY Then
        Obj.Top = Obj.Top + (Y - OldY)
    End If
    If Y < OldY Then
        Obj.Top = Obj.Top - (OldY - Y)
    End If
    
    Obj.Container.Refresh
    
End Sub

Conclusion :


Ceci est "brut de fonderie"...à chacun d'y apporter sa touche perso....(ca serait sympa de me faire connaitre vos améliorations)

Bientot j'y ajouterai la possiblité de sauvegarder l'etat de chaque objet et de les reaficher sous leur nouvelle forme lors du chargement suivant...

A voir également

Ajouter un commentaire

Commentaires

tilp
Messages postés
10
Date d'inscription
mardi 12 octobre 2004
Statut
Membre
Dernière intervention
16 novembre 2008
-
Félicitations ! Simple et efficace.
Merci.
bbcluny
Messages postés
66
Date d'inscription
mardi 25 mars 2003
Statut
Membre
Dernière intervention
29 septembre 2008
-
Tres bon code, Merci
mams160
Messages postés
3
Date d'inscription
dimanche 29 décembre 2002
Statut
Membre
Dernière intervention
22 février 2003
-
SUPER Je suis subjugué, le code est super simple et ça marche terrible !!!
Thanks
cs_Mikax
Messages postés
13
Date d'inscription
jeudi 4 avril 2002
Statut
Membre
Dernière intervention
3 mars 2004
-
Comment bloquer le contrôle dans la form qui le contient ?

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.