Remove Highlight From Previous Label When MouseMove Is On Another Label

[angsuman]

Hello All,

I have created an user form which has a frame. The frame contains several labels. My objective is to highlight the label when mouse points to a label but highlight should disappear once mouse moves to next label and the next label should be highlighted.

Following is my code:

Code is my user form:

Dim Labels() As New LblClass

    Dim LabelCount          As Long
    Dim ctl                 As Control


    ' Create the Label objects
    LabelCount = 0
    For Each ctl In Frame1.Controls
       If TypeName(ctl) = "Label" Then
          LabelCount = LabelCount + 1
          ReDim Preserve Labels(1 To LabelCount)
          Set Labels(LabelCount).LabelGroup = ctl
       End If
    Next ctl


Created a class called LblClass and this class has following code:

Public WithEvents LabelGroup As MSForms.Label


Private Sub LabelGroup_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)


   LabelGroup.ForeColor = vbWhite
   LabelGroup.SpecialEffect = 1
   LabelGroup.BackStyle = 1
   LabelGroup.BackColor = &H808000
   


End Sub

With above code, when mouse moves over a label it is highlighted. Next when mouse moves over a new label, new label is highlighted and old label is still highlighted. This continues. How can I remove the highlight from my previous label when mouse moves over new label.

Thanks
Angsuman

 

[MickG]

Try this for your "LblClass" module

Option Explicit
Public WithEvents LabelGroup [COLOR="Navy"]As[/COLOR] MSForms.Label

Private [COLOR="Navy"]Sub[/COLOR] LabelGroup_MouseMove(ByVal Button [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] ByVal Shift [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] ByVal X [COLOR="Navy"]As[/COLOR] Single, ByVal Y [COLOR="Navy"]As[/COLOR] Single)
[COLOR="Navy"]Dim[/COLOR] Ctrl [COLOR="Navy"]As[/COLOR] MSForms.Control
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ctrl [COLOR="Navy"]In[/COLOR] LabelGroup.Parent.Parent.Controls
  [COLOR="Navy"]If[/COLOR] TypeName(Ctrl) = "Label" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Ctrl.name = LabelGroup.name [COLOR="Navy"]Then[/COLOR]
       Ctrl.BackColor = &H808000
     [COLOR="Navy"]Else[/COLOR]
        Ctrl.BackColor = LabelGroup.Parent.Parent.BackColor
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Ctrl
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[angsuman]

Thank you Mick. This perfectly worked. I only changed LabelGroup.Parent.Parent.Controls to LabelGroup.Parent.Controls

 

[angsuman]

Hello Mick,

After using the code, I got what I expected. However that caused screen flickering. To solve this problem, I have modified the code and added DoEvents as below:

Option Explicit
Public WithEvents LabelGroup [COLOR=Navy]As[/COLOR] MSForms.Label

Private [COLOR=Navy]Sub[/COLOR] LabelGroup_MouseMove(ByVal Button [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] ByVal Shift [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] ByVal X [COLOR=Navy]As[/COLOR] Single, ByVal Y [COLOR=Navy]As[/COLOR] Single)
[COLOR=Navy]Dim[/COLOR] Ctrl [COLOR=Navy]As[/COLOR] MSForms.Control
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Ctrl [COLOR=Navy]In[/COLOR] LabelGroup.Parent.Controls
  [COLOR=Navy]If[/COLOR] TypeName(Ctrl) = "Label" [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]If[/COLOR] Ctrl.name = LabelGroup.name [COLOR=Navy]Then[/COLOR]
       Ctrl.BackColor = &H808000
     [COLOR=Navy]Else[/COLOR]
        Ctrl.BackColor = LabelGroup.Parent.BackColor
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
DoEvents
[COLOR=Navy]Next[/COLOR] Ctrl
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Unfortunately the mouse movement has become erratic. When I point to one label it keeps hovering over few other labels randomly. Is there any other way to solve the problem of flickering and keeping the mouse pointer fixed on one label only.

Thanks
Angsuman

 

[MickG]

I have always found the "Mouse_Move" rather erratic ,but in my example of 20 odd labels it appears quite good.
The "Doevents", did help, and I also added an "If" statement for the value of "X" that also helped (see Code below)
Other than that, the "Click" event might help, if acceptable.

Option Explicit
Public WithEvents LabelGroup As MSForms.Label

Private Sub LabelGroup_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim Ctrl As MSForms.Control

For Each Ctrl In LabelGroup.Parent.Parent.Controls
  DoEvents
   If X > 5 And X < Ctrl.Width - 5 Then
      If TypeName(Ctrl) = "Label" Then
        If Ctrl.name = LabelGroup.name Then
            Ctrl.BackColor = &H808000
        Else
            Ctrl.BackColor = LabelGroup.Parent.Parent.BackColor
        End If
      End If
    End If
Next Ctrl
End Sub