Discussion :

[LiNuXaDDiKt]

Salut à tous,

Je tente de construire une petite application avec des objets (des Labels) dynamiques. J'ai réussi jusqu'à maintenant à partir de code trouvé sur Internet à faire à peu près tout ce dont j'ai besoin sauf une petite chose.

Ce que je tente de faire, c'est de mettre en surbrillance le texte d'un label lorsque la souris passe dessus exactement comme un URL dans une page Web.

La première partie fonctionne, c'est à dire que le texte devient en bleu et souligné quand la souris passe dessus (zoLabel_MouseMove dans la Classe).

Ce que je ne réussi pas à faire c'est que ça s'annule quand la souris n'est plus sur le texte précédemment mis en surbrillance.

Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
 
***** Feuille FrmControlArray *****
 
Option Explicit
Option Compare Text
 
Private oControlArray() As CtrlArray
Private Const clControlCount As Long = 5
 
Public Sub DoSomethingWithClick(LabelText As String)
    MsgBox LabelText
End Sub
 
Private Sub CmdClose_Click()
    Unload Me
End Sub
 
Private Sub UserForm_Initialize()
 
    Dim ThisBox As Long, NewLabel As Control 
 
    ReDim oControlArray(1 To clControlCount)
 
    For ThisBox = 1 To clControlCount
        Set NewLabel = Me.Controls.Add("Forms.Label.1")
        With NewLabel
            .Left = 10
            .Top = 15 * ThisBox
            .Height = 12
            .Width = 100
            .Visible = True
            .Caption = "LABEL : " & ThisBox
            .BorderStyle = 0
        End With
        Set oControlArray(ThisBox) = New CtrlArray
        oControlArray(ThisBox).Initialise NewLabel, ThisBox
    Next
 
    Set NewLabel = Nothing
 
End Sub
 
Private Sub UserForm_Terminate()
    Dim ThisBox As Long
    For ThisBox = 1 To clControlCount
        Set oControlArray(ThisBox) = Nothing
    Next
End Sub
 
 
***** Classe CtrlArray *****
 
Option Explicit
Option Compare Text
 
Private WithEvents zoLabel As MSForms.Label
Private zlIndex As Long
 
Private Sub zoLabel_Click()
    Call FrmControlArray.DoSomethingWithClick(zoLabel.Caption)
End Sub
 
Private Sub Class_Terminate()
    Set zoLabel = Nothing
End Sub
 
Sub Initialise(oControl As Object, lControlIndex As Long)
    zlIndex = lControlIndex
    Set zoLabel = oControl
End Sub
 
Property Get Index() As Long
    Index = zlIndex
End Property
 
Function Control(sName As String) As Object
        Set Control = zoLabel
End Function
 
Private Sub zoLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With zoLabel
        .ForeColor = vbBlue
        .Font.Underline = True
    End With
End Sub

Notez que c'est du VBA et non du VB6 (Important)

Je n'ai rien d'un professionnel en VBA alors soyez indulgent. C'est d'ailleurs la raison pour laquelle je cherche de l'aide :-)

[ouskel'n'or]

Pour faire ça, tu dois réinitialiser ta couleur dans le mouse_move de ton userform.

A+

[LiNuXaDDiKt]

Voici ce que j'ai tenté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
***** Dans ma classe j'ai ajouté *****
 
Function ResetLinks()
    With zoLabel
        .ForeColor = vbBlack
        .Font.Underline = False
    End With
End Function
 
***** Dans mon Userform j'ai ajouté ceci *****
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Count As Long
    For Count = 1 To clControlCount
        oControlArray(Count).ResetLinks
    Next
End Sub

Ca fonctionne mais c'est pénible car ça boucle continuellement quand la souris bouge... De plus, l'utilisation processeur grimpe de façon inquiétante :-(

J'ai aussi tenté, à la suggestion d'un confrère de travail, de mettre un autre label en dessous de celui que je veux modifié. De ce fait, quand le curseur quite le label du dessus il doit inévitablement passer sur le label du dessous qui réinitialise celui du dessus...

Le seul hic c'est que quand la souris passe trop rapidement sur le label le résultat n'est pas constant...

Il ne faut pas oublier que le but est de créer plusieurs Labels dans un UserForm (de 1 à 200 environs). Alors plus on ajoute de label plus les labels clignotent. C'est tout à fait normal compte tenu des boucles à répétition.

Auriez-vous d'autre suggestions?

[ThierryAIM]

travailler le X et le Y dans zoLabel_MouseMove :

[ouskel'n'or]

Si c'est ce à quoi je pense, en effet, définir une plage xy, dans le zolabel lui-même, en dehors de laquelle la surbrillance est désactivée, règlerait le problème. Pour ça, tu as
Hauteur de zolabel = zolabel.height
Largeur = zolabel.width
position X = zolabel.left
position Y = zolabel.top

Ta plage devra se situer entre left et left + Width et entre top et top + height

Tu fais tes calculs et tu dis...

A+