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...
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.