MouseMove High CPU Usage - Looking for better and elegant solution

Question

I'm working on an Access 2007 application and have some concerns about performance with MouseMove over labels and form. So far with my solution I'm getting high cpu usage on a dual core I5 3.0ghz. When I move the mouse cpu usage jumps to about 30-32% of one core.(With hyperthreading on) For such a trivial task as a MouseMove, I'd like to have something a bit more efficient :)

The code below as been shortened; I have 8 labels with MouseMove event handler.

Here's how it's implemented:

Private moveOverOn As Boolean

Private Property Get isMoveOverOn() As Boolean
isMoveOverOn = moveOverOn
End Property

Private Property Let setMoveOverOn(value As Boolean)
moveOverOn = value
End Property

'label MouseMove detection
Private Sub lbl_projects_completed_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift = 0 And isMoveOverOn = False Then
    Me.lbl_projects_completed.FontBold = True
    setMoveOverOn = True
End If
End Sub

'main form MouseMove detection
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If isMoveOverOn Then
    resetBold 'call a sub that reset all labels .FontBold
    setMoveOverOn = False
End If

End Sub

I don't know if it's possible, but I think that reducing the speed at which the MouseMove is refreshed would help for this task, unfortunately I wasn't able to find information about it.

I'm opened to suggestions, thanks for your time! :)

Answer 1

Finally I found what I was looking for to reduce the MouseMove strain on the CPU:

'put this in head of the form code
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'form MouseMove with sleep timer
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

'placeholder call sub to change the label FontBold Suggested by engineersmnky

Sleep (25)
End Sub

Answer 2

The accdb format has hover and press color properties for buttons, so if you don't mind converting to that format and the labels could be buttons that should work much better than what you have going on.

Answer 3

Okay so this will do what you want with less of an expense but just know mouse move does not update X,Y when over a control so it has intermittent issues with the event.

This is custom implementation of a mouseHover event using mouse move on the detail section so it is only called 1 time. It then loops through the controls (you can change this loop to only look at controls you want) and sees if the cursor is within 5 twips of the control on any side

It also accepts a fuzziness parameter because of the lack of updating when over a control. The default it 50 twips. Also know that the controls should be shrunk to the minimum size possible to fit the data as this function uses the controls height and width to determine if you are inside of the control.

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mouseHover X, Y
End Sub
Private Sub mouseHover(X As Single, Y As Single)
    Dim ctrl As Control
    'You may want to make an array of controls here to shorten the loop
    'i.e. 
    ' Dim ctrl_array() As Variant
    ' ctrl_array(0) = Me.lbl_projects_completed
    ' ctrl_array(1) = Me.some_other_label
    ' For Each ctrl in ctrl_array
    For Each ctrl In Me.Controls
       If ctrl.ControlType = acLabel Then
          If FuzzyInsideControl(ctrl.top, ctrl.left, ctrl.width, ctrl.height, X, Y) Then
                ctrl.FontBold = True
                ctrl.ForeColor = RGB(255, 0, 0)
                Exit For
            Else
                ctrl.ForeColor = RGB(0, 0, 0)
                ctrl.FontBold = False
            End If
        End If
    Next ctrl
End Sub
Private Function FuzzyInsideControl(top As Long, left As Long, width As Long, height As Long, X As Single, Y As Single, Optional fuzz As Integer = 50) As Boolean
    Dim coord_left As Long
    Dim coord_right As Long
    Dim coord_top As Long
    Dim coord_bottom As Long
    Dim inside_x As Boolean
    Dim inside_y As Boolean
    coord_top = top - fuzz
    coord_bottom = top + height + fuzz
    coord_left = left - fuzz
    coord_right = left + width + fuzz
    inside_y = Y > coord_top And Y < coord_bottom
    inside_x = X > coord_left And X < coord_right
    FuzzyInsideControl = inside_x And inside_y
End Function

While I still think that this is unnecessary it was an interesting question and fun to work with but there are some of limitations due to how mouseMove works

Edit

Changed the FuzzyInsideControl function for a cleaner more concise version should be more accurate although I will have to test tomorrow when I get back to a computer with access.