patricktoulon
XLDnaute Barbatruc
bonjour a tous
je suis entrain de me faire un cecoupeur d'image et j'ai créé un label redimensionnables avec des poignées
je voudrais raccourcir le code en globalisant certaines actions (peut etre ) (mais sans classe pour 4 poignées c'est pas intéressant)
ensuite j'aimerais rectifier la cohérence du bouton avec le mouse up du label(cadre rouge)
le bouton a la base affiche ou masque les poignées
le mouse up du cadre rouge les affiche aussi sauf que je voudrais que la condition du bouton soit respectée
merci messieux ![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
je suis entrain de me faire un cecoupeur d'image et j'ai créé un label redimensionnables avec des poignées
je voudrais raccourcir le code en globalisant certaines actions (peut etre ) (mais sans classe pour 4 poignées c'est pas intéressant)
ensuite j'aimerais rectifier la cohérence du bouton avec le mouse up du label(cadre rouge)
le bouton a la base affiche ou masque les poignées
le mouse up du cadre rouge les affiche aussi sauf que je voudrais que la condition du bouton soit respectée
VB:
Option Explicit
Dim XX#, YY#
Dim yz#, xz#
Private Sub CommandButton1_Click()
With CommandButton1
'If .Caption = "resize" Then cropseur_MouseUp 1, 1, 1, 1: .Caption = "Noresize" Else .Caption = "resize": cropseur_MouseDown 1, 1, 1, 1
End With
End Sub
'enclenche le movable de cropseur et cache les poignées de redimentionnement
Private Sub cropseur_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
HG.Visible = False
HD.Visible = False
BG.Visible = False
BD.Visible = False
XX = X: YY = Y
End Sub
'deplace le cropseur
Private Sub cropseur_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
cropseur.Move cropseur.Left + (X - XX), cropseur.Top + (Y - YY)
End If
End Sub
'arrete le movable du cropseur
Private Sub cropseur_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If CommandButton1.Caption <> "resize" Then
HG.Visible = True
HD.Visible = True
BG.Visible = True
BD.Visible = True
End If
HG.Move cropseur.Left - HG.Width, cropseur.Top - HG.Height
HD.Move cropseur.Left + cropseur.Width, cropseur.Top - HG.Height
BG.Move cropseur.Left - BG.Width, cropseur.Top + cropseur.Height
BD.Move cropseur.Left + cropseur.Width, cropseur.Top + cropseur.Height
XX = 0: YY = 0
End Sub
'vu la dimention des poigné de redimentionnement
'on en a pas vraiment besoin on peut partire de zero dans le move
'memo position curseur poignée haute gauche
'Private Sub HG_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'XX = X: YY = Y
'End Sub
'memo position curseur poignée haute droite
'Private Sub HD_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'XX = X: YY = Y
'End Sub
'memo position curseur poignée basse gauche
'Private Sub BG_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'XX = X: YY = Y
'End Sub
'memo position curseur poignée basse droite
'Private Sub BD_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'XX = X: YY = Y
'End Sub
Private Sub HG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
yz = YY + Y
xz = XX + X
HG.Move HG.Left + (X - XX), HG.Top + (Y - YY)
BG.Left = HG.Left
HD.Top = HG.Top
rollcrops
End If
End Sub
Private Sub HD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
yz = YY + Y
xz = XX + X
HD.Move HD.Left + (X - XX), HD.Top + (Y - YY)
BD.Left = HD.Left
HG.Top = HD.Top
rollcrops
End If
End Sub
Private Sub BG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
yz = YY + Y
xz = XX + X
BG.Move BG.Left + (X - XX), BG.Top + (Y - YY)
HG.Left = BG.Left
BD.Top = BG.Top
rollcrops
End If
End Sub
Private Sub BD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
yz = YY + Y
xz = XX + X
BD.Move BD.Left + (X - XX), BD.Top + (Y - YY)
HD.Left = BD.Left
BG.Top = BD.Top
rollcrops
End If
End Sub
Sub rollcrops()
cropseur.Move HG.Left + HG.Width, HG.Top + HG.Height, (HD.Left - HG.Left) - HG.Width, (BG.Top - HG.Top) - HG.Height
End Sub
Private Sub UserForm_Activate()
cropseur_MouseUp 0, 0, 0, 0
End Sub