MouseMove高CPU使用率 - 寻找更好更优雅的解决方案

Question

我正在开发Access 2007应用程序，并对MouseMove在标签和表单上的性能有所担忧。 到目前为止，在我的解决方案中，我在双核I5 3.0ghz上获得了较高的CPU使用率。 当我移动鼠标cpu使用率跳转到一个核心的30-32％左右（使用超线程） 对于像MouseMove这样简单的任务，我想有一些效率更高:)

下面的代码被缩短了;我有8个标签与MouseMove事件处理程序。

下面是它是如何实现的：

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 

我不知道这是否是可能的，但我认为，减少鼠标移动 刷新时的速度将有助于完成这个任务，不幸的是我没有能够找到关于它的信息。

我接受了建议，感谢您的时间！ :)

Answer 1

最后我找到了我一直在寻找，以减轻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

accdb格式具有悬停并按下按钮的颜色属性，所以如果您不介意转换为该格式，并且标签可能是按钮应该比您所做的更好。

Answer 3

好吧，这样做可以用更少的费用做你想要的，但只要知道鼠标移动不会更新X，Y时就超过了控件，因此它在事件中存在间歇性问题。

这是使用鼠标移动到细节部分的mouseHover事件的自定义实现，因此它只被称为1次。然后，它通过控件循环（可以将此循环更改为仅查看您想要的控件），并查看光标是否位于任何一侧的控件的5缇内

它还接受模糊参数，因为缺少通过控件进行更新。它的默认值是50缇。也知道控件应缩小到可能的最小尺寸以适合数据，因为此功能使用控件的高度和宽度来确定您是否在控件内。

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 

虽然我仍然认为这是不必要的，这是一个有趣的问题和乐趣的工作，但也有一定的局限性所致的mouseMove如何工作

编辑

改变了FuzzyInsideControl功能更简洁的清洁版本应该更加准确，但是当我回到有权访问的计算机时，我将不得不明天进行测试。