Autres abréger un code sans classe

patricktoulon

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

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

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

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

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

Discussions similaires

cp4
  • Résolu(e)
XL 2010 [RESOLU]Adapter Module de Classe
2
Réponses
29
Affichages
2 K
cp4
cp4
patricktoulon
  • Question
Autres Petite mise a jour (exceptionnellement pour cp4) du calendar V4.1(OLDVERSION)
2
Réponses
21
Affichages
1 K
patricktoulon
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
604
NONO14
N
H
  • Question
XL 2013 Evènement "MouseMove" dans une module de classe pour plusieurs userform
Réponses
6
Affichages
810
patricktoulon
patricktoulon
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
463
fanch55
fanch55
patricktoulon
  • Résolu(e)
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
603
patricktoulon
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
Nicolas JACQUIN
cathodique
  • Résolu(e)
XL 2010 Masque de saisie textbox Téléphone Public
Réponses
8
Affichages
686
cathodique
cathodique

Membres actuellement en ligne

10 membres et 99 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 109
Messages
2 116 323
Membres
112 717
dernier inscrit
doguet