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功能更簡潔的清潔版本應該更加準確，但是當我回到有權訪問的計算機時，我將不得不明天進行測試。