Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres abréger un code sans classe

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
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
merci messieux
 

Pièces jointes

  • control poignée resize.xlsm
    20.9 KB · Affichages: 13
Solution
Patrick regarde une idée,
j'ai mis dans un tableau variant les labels (Pour chaqu'une des combinaisons)
re je precise les tags respectifsde:
HG.tag=HD:BG
HD.tag=HG:BD
BG.tag=BD:HG
BD.tag=BG:HD
Dim Pos As Variant
'MsgBox Me.HG.Name
Pos = Array(Me.HG, Me.BG, Me.HD)
'MsgBox Pos(1).Name

Cela fonctionne le principe à l'air correcte !

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...
Trier par date Trier par votes

patricktoulon

XLDnaute Barbatruc
pour le moment je vais garder ton principe
j'ai nettoyé tous ce qui était inutile
j'ai changer le nom du cadre rouge pour "CpR"

et j'ai solutionné le soucis du bouton avec une variable globale module
VB: 
Option Explicit
Dim XX#, YY#
Dim yz#, xz#
Dim mode&
Private Sub CommandButton1_Click()
    With CommandButton1
        If .Caption = "resize" Then
        mode = 1: Cpr_MouseUp 0, 0, 0, 0: .Caption = "Noresize"
        Else
        mode = 0: .Caption = "resize": Cpr_MouseDown 0, 0, 0, 0
    End If
    End With
End Sub

'enclenche le movable de Cpr et cache les poignées de redimentionnement
Private Sub Cpr_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 Cpr
Private Sub Cpr_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        CpR.Move CpR.Left + (X - XX), CpR.Top + (Y - YY)
    End If
End Sub
'arrete le movable du Cpr
Private Sub Cpr_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HG.Visible = mode: HD.Visible = mode: BG.Visible = mode: BD.Visible = mode
    HG.Move CpR.Left - HG.Width, CpR.Top - HG.Height
    HD.Move CpR.Left + CpR.Width, CpR.Top - HG.Height
    BG.Move CpR.Left - BG.Width, CpR.Top + CpR.Height
    BD.Move CpR.Left + CpR.Width, CpR.Top + CpR.Height
    XX = 0: YY = 0
End Sub



Private Sub HG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Array(HG, BG, HD)
End Sub

Private Sub HD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Pos, Array(HD, BD, HG)
End Sub

Private Sub BG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Array(BG, HG, BD)
End Sub

Private Sub BD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Array(BD, HD, BG)
End Sub

Sub rollcrops(B, X, Y, Poignées)
    If B = 1 Then
        Poignées(0).Move Poignées(0).Left + (X - 2), Poignées(0).Top + (Y - 2)
        Poignées(1).Left = Poignées(0).Left
        Poignées(2).Top = Poignées(0).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top - (HG.Top + HG.Height)
    End If
End Sub
Private Sub UserForm_Activate()
    Cpr_MouseUp 0, 0, 0, 0
End Sub
c'est l'userform2
 

Pièces jointes

  • control poignée resize.xlsm
    24.7 KB · Affichages: 8
Vote positif 0 Vote négatif

laurent950

XLDnaute Barbatruc
L'idée serait bien évidement d'intercepter : les labels clické
- HG_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
- HD_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
- BG_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
- BD_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
et Remplacer par :
- UserForm_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

L'objet intercepté sur l'userforme suite à une commande (Donc Identifié suite à cette derniére commande UserForm_MouseMove)

' ********************************************************************************************************
Avec le tableau ci dessous :
dim Poignées as variant
Poignées = Array([{Me.HG, Me.BG, Me.HD}],[{Me.HD, Me.BD, Me.HG}],[{Me.BG, Me.HG, Me.BD)}],[{Me.BD, Me.HD, Me.BG}])

' Etat :
'si "HG_MouseMove" = Poignées(1)(1) /
'si "HD_MouseMove" = Poignées(2)(1) /
'si "BG_MouseMove" = Poignées(3)(1) /
'si "BD_MouseMove" = Poignées(4)(1) /
' ********************************************************************************************************
' Ci dessous le principe
VB: 
if "HG_MouseMove" = Poignées(1)(1) then
    If B = 1 Then
        Poignées(1)(1).Move Poignées(1)(1).Left + (X - 2), Poignées(1)(1).Top + (Y - 2)
        Poignées(1)(2).Left = Poignées(1)(1).Left
        Poignées(1)(3).Top = Poignées(1)(1).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top - (HG.Top + HG.Height)
    End If           
elseif "HD_MouseMove" = Poignées(2)(1) then
    If B = 1 Then
        Poignées(2)(1).Move Poignées(2)(1).Left + (X - 2), Poignées(2)(1).Top + (Y - 2)
        Poignées(2)(2).Left = Poignées(2)(1).Left
        Poignées(2)(3).Top = Poignées(2)(1).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top - (HG.Top + HG.Height)
    End If
elseif "BG_MouseMove" = Poignées(3)(1) then
    If B = 1 Then
        Poignées(3)(1).Move Poignées(3)(1).Left + (X - 2), Poignées(3)(1).Top + (Y - 2)
        Poignées(3)(2).Left = Poignées(3)(1).Left
        Poignées(3)(3).Top = Poignées(3)(1).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top - (HG.Top + HG.Height)
    End If
elseif "BD_MouseMove" = Poignées(4)(1) then
    If B = 1 Then
        Poignées(4)(1).Move Poignées(4)(1).Left + (X - 2), Poignées(4)(1).Top + (Y - 2)
        Poignées(4)(2).Left = Poignées(4)(1).Left
        Poignées(4)(3).Top = Poignées(4)(1).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top - (HG.Top + HG.Height)
    End If
end if
' ********************************************************************************************************
' Donc la réduction ci-dessous
' A reduire le code avec une boucle for
VB: 
for i = lbound(Poignées) to ubound(Poignées)
  if "HG_MouseMove" = Poignées(i)(1) then
    If B = 1 Then
        Poignées(i)(1).Move Poignées(i)(1).Left + (X - 2), Poignées(i)(1).Top + (Y - 2)
        Poignées(i)(2).Left = Poignées(i)(1).Left
        Poignées(i)(3).Top = Poignées(i)(1).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top -         (HG.Top + HG.Height)
   End if
End if
next i
Maintenant comment intercepté cette objet de l'userform avec cette commande ?
UserForm_MouseMove

si une fois intercepté c'est simple de faire cela
L'objet intercepté est donc = UserForm_MouseMove
et donc
'si "HG_MouseMove" = Poignées(1)(1) / 'si "L'objet intercepté est donc" = Poignées(1)(1) /

Voila Patrick l'idée que j'en ai eu mais je ne sais pas faire cela ? c'est comme cela que j'ai eu l'idée de cette premiére approche que tu as adopté en principe

Laurent
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
l'idée est intéressante mais va a l'encontre de mon projet de simplification tu crois pas
on retombe dans une usine a gaz

peut etre par les api postmessage et send message

Voila Patrick l'idée que j'en ai eu mais je ne sais pas faire cela ? c'est comme cela que j'ai eu l'idée de cette premiére approche que tu as adopté en principe
Cliquez pour agrandir...
alors t'a tout faux les commandes move sont bien identitaires pour chacunes 4

je crois avoir un projet comme ça très très vieux dans mes disques (2010 a 2012) avec les api getcursorpos avec GetInputState et GetQueueStatus
mais honnêtement c'est pas mieux que ce que l'on a fait
le mot d'ordre c'est " la simplification"
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
pour le moment je vais garder ton principe
j'ai nettoyé tous ce qui était inutile
j'ai changer le nom du cadre rouge pour "CpR"
VB: 
Option Explicit
Dim XX#, YY#
Dim yz#, xz#

Private Sub CommandButton1_Click()
    With CommandButton1
        'If .Caption = "resize" Then Cpr_MouseUp 0,0,0,0: .Caption = "Noresize" Else .Caption = "resize": Cpr_MouseDown 0,0,0,0
    End With
End Sub

'enclenche le movable de Cpr et cache les poignées de redimensionnement
Private Sub Cpr_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 Cpr
Private Sub Cpr_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        CpR.Move CpR.Left + (X - XX), CpR.Top + (Y - YY)
    End If
End Sub
'arrete le movable du Cpr
Private Sub Cpr_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HG.Visible = True: HD.Visible = True: BG.Visible = True: BD.Visible = True
    HG.Move CpR.Left - HG.Width, CpR.Top - HG.Height
    HD.Move CpR.Left + CpR.Width, CpR.Top - HG.Height
    BG.Move CpR.Left - BG.Width, CpR.Top + CpR.Height
    BD.Move CpR.Left + CpR.Width, CpR.Top + CpR.Height
    XX = 0: YY = 0
End Sub



Private Sub HG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Array(HG, BG, HD)
End Sub

Private Sub HD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Pos, Array(HD, BD, HG)
End Sub

Private Sub BG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Array(BG, HG, BD)
End Sub

Private Sub BD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rollcrops Button, X, Y, Array(BD, HD, BG)
End Sub

Sub rollcrops(B, X, Y, Poignées)
    If B = 1 Then
        Poignées(0).Move Poignées(0).Left + (X - 2), Poignées(0).Top + (Y - 2)
        Poignées(1).Left = Poignées(0).Left
        Poignées(2).Top = Poignées(0).Top
        CpR.Move HG.Left + HG.Width, HG.Top + HG.Height, HD.Left - (HG.Left + HG.Width), BG.Top - (HG.Top + HG.Height)
    End If
End Sub
Private Sub UserForm_Activate()
    Cpr_MouseUp 0, 0, 0, 0
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2010 [RESOLU]Adapter Module de Classe
2
Réponses
29
Affichages
2 K
cp4
  • Question
Autres Petite mise a jour (exceptionnellement pour cp4) du calendar V4.1(OLDVERSION)
2
Réponses
21
Affichages
1 K
patricktoulon
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
599
dadu35
D
N
  • Résolu(e)
Microsoft 365 Code fonction pour création code aléatoire
2 3
Réponses
32
Affichages
605
NONO14
N
H
  • Question
XL 2013 Evènement "MouseMove" dans une module de classe pour plusieurs userform
Réponses
6
Affichages
811
patricktoulon
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
463
fanch55
  • Résolu(e)
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
603
patricktoulon
Y
  • Résolu(e)
XL 2019 Besoin d'aide "Erreur d'execution '424' : Objects requis"
Réponses
2
Affichages
460
YAP32
Y
N
  • Résolu(e)
Microsoft 365 Aide pour un code Vba
2 3
Réponses
32
Affichages
966
Nicolas JACQUIN
  • Résolu(e)
XL 2010 Masque de saisie textbox Téléphone Public
Réponses
8
Affichages
686
cathodique
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…