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

Commenter

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

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_birdie)