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

我不知道是否可能，但我认为降低MouseMove的速度刷新将有助于此任务，不幸的是我无法找到有关它的信息。

我愿意接受建议，谢谢你的时间！：）

Answer 1

accdb格式具有悬停并按下按钮的颜色属性，因此，如果您不介意转换为该格式，标签可能是比您正在进行的工作更好的按钮。

Answer 2

好的，这样可以用更少的费用做你想做的事情，但只知道鼠标移动不会在控件上更新X，Y，所以它有事件的间歇性问题。

这是使用鼠标移动详细信息部分的mouseHover事件的自定义实现，因此它只被调用一次。然后它循环通过控件（你可以改变这个循环只看你想要的控件）并看看光标是否在任何一侧的控件的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功能以获得更清晰更简洁的版本应该更准确，虽然我将在明天回到具有访问权限的计算机时进行测试。

Answer 3

最后我找到了我想要的东西来减少CPU上的MouseMove应变：

'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

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

3 个答案: