65.9K
CodeProject 正在变化。 阅读更多。
Home

为 VB6 控件添加 MouseLeave、MouseHover 事件

Hesham Amin
starIconstarIconstarIconstarIcon
emptyStarIcon
starIcon

4.28/5 (12投票s)

2004 年 4 月 25 日

CPOL

4分钟阅读

viewsIcon

113364

downloadIcon

4937

本文介绍如何在 Visual Basic 6 中创建具有两个额外鼠标事件：MouseLeave、MouseHover 的 ActiveX 控件。

Sample Image - Link_Label_Sample.jpg

引言

本文介绍如何在 Visual Basic 6 中创建具有两个额外鼠标事件的 ActiveX 控件。

  1. MouseLeave：当光标移出控件时触发。
  2. MouseHover：当用户将光标悬停在控件上一段预设时间（默认为 400 毫秒）后触发。

实现此目的的一种常用方法是使用时间间隔较小的 Timer 控件。在 Timer 事件中，程序员会检查光标的位置。(我非常讨厌这种方法。它很痛苦，需要大量工作和开销来跟踪光标)。
另一种方法是开始使用 VB.NET，它内置了这些事件。(但是您应该有更充分的理由切换到 .NET !!)。
本文介绍的替代方法是让 Windows 向您的控件发送 MouseLeave、MouseHover 消息（事件）。

如何实现？

我们需要三件事来实现这一点：

  1. 告知 Windows 您希望它发送所需事件。.

    这通过调用 TrackMouseEvent API 函数来实现，该函数指定所需的事件和悬停时间。这在主模块 (mdlProc.bas) 的 RequestTracking 函数中完成。

    Dim trk As tagTRACKMOUSEEVENT
trk.cbSize = 16
trk.dwFlags = TME_LEAVE Or TME_HOVER
trk.dwHoverTime = trak.HoverTime
trk.hwndTrack = trak.hwnd

TrackMouseEvent trk
  2. 接收 Windows 发送的消息。

    Visual Basic 没有内置的接收自定义消息的机制。您只能从窗体或控件代码窗口的事件列表中选择。
    因此，我们需要对控件的窗口进行子类化，以拦截发送到该窗口的所有消息。然后，我们可以处理我们需要处理的消息，并将其余消息转发给原始窗口过程。这通过调用 SetWindowLong API 来设置新的窗口过程来实现。

    SetWindowLong(ctl.hwnd, GWL_WNDPROC, AddressOf WindowProc)

    WindowProc 函数在 mdlProc.bas 中定义如下：

    Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
	ByVal wParam As Long, ByVal lParam As Long) As Long

    我们需要处理三个特定的消息：WM_MOUSELEAVE、WM_MOUSEHOVER、WM_MOUSEMOVE，并将其他消息（以及 WM_MOUSEMOVE 消息）直接转发给原始窗口过程。

    WindowProc = CallWindowProc(trak.PrevProc, hwnd, uMsg, wParam, lParam)
  3. 我们需要分派消息给窗口。

    请注意，所有消息都发送到 WindowProc 函数。但我们可能在窗体上有多个控件，因此我们想知道这条消息最初是发送给哪个控件的。
    为此，我们使用一个名为 trackCol 的集合来保存 clsTrackInfo 对象的引用。集合的键是窗口句柄 (hwnd)。我使用窗口句柄作为键，因为 WindowProc 函数以窗口句柄作为参数接收。因此，我们可以使用它在集合中查找 clsTrackInfo 对象。

    将控件添加到集合中。

    trackCol.Add trak, CStr(trak.hwnd)

    搜索所需控件。

    Set trak = trackCol.Item(CStr(hwnd))

    然后我们使用此代码检查消息的值并采取所需的操作：

    If uMsg = WM_MOUSELEAVE Then
    trak.RaiseMouseLeave
ElseIf uMsg = WM_MOUSEHOVER Then
    trak.RaiseMouseHover
ElseIf uMsg = WM_MOUSEMOVE Then
    RequestTracking trak
    WindowProc = CallWindowProc(trak.prevProc, hwnd, uMsg, wParam, lParam)
Else
    WindowProc = CallWindowProc(trak.prevProc, hwnd, uMsg, wParam, lParam)
    'Debug.Print uMsg
End If

控件的骨架

在 mdlProc.bas 中，我使用 clsTrackInfo 来存储在 trackCol 集合中。集合中的这些对象用于将模块代码连接到 UserControl。
直接存储 UserControl 的引用更有意义。但由于循环引用，这可能导致 Terminate 事件在某些情况下不被引发。
(更多关于此信息，请参阅：知识库)

控件的骨架代码

请注意，我声明了 MyTrak 并带有事件。

Dim WithEvents MyTrak As clsTrackInfo

代码如下

Option Explicit

Public Event MouseLeave()
Public Event MouseHover()

Dim WithEvents MyTrak As clsTrackInfo

Private Sub MyTrak_MouseHover()
RaiseEvent MouseHover
End Sub

Private Sub MyTrak_MouseLeave()
RaiseEvent MouseLeave
End Sub

Public Property Get HoverTime() As Long
HoverTime = MyTrak.HoverTime
End Property

Public Property Let HoverTime(newHoverTime As Long)
MyTrak.HoverTime = newHoverTime
PropertyChanged "HoverTime"
End Property

Private Sub UserControl_InitProperties()
Set MyTrak = New clsTrackInfo
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Set MyTrak = New clsTrackInfo
MyTrak.hwnd = UserControl.hwnd

MyTrak.HoverTime = PropBag.ReadProperty("HoverTime", 400)

If Ambient.UserMode Then
StartTrack MyTrak
End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "HoverTime", MyTrak.HoverTime, 400
End Sub

Private Sub UserControl_Terminate()
EndTrack MyTrak
Set MyTrak = Nothing
End Sub

我处理 MyTrak 对象的 MyTrak_MouseHover 和 MyTrak_MouseLeave 事件来触发所需事件。

注释

  1. StartTrack 在 UserControl_ReadProperties 中被调用以开始跟踪事件并将控件添加到 trackCol 集合中，而 EndTrack 在 UserControl_Terminate 事件中被调用以结束跟踪并从 trackCol 集合中移除控件。
    我使用了 UserControl_ReadProperties 而不是 UserControl_Initialize，以便能够检查 Ambient.UserMode 属性，该属性在 UserControl_Initialize 事件中不可用。
  2. WM_MOUSEHOVER 在用户将鼠标悬停在控件上特定时间后发送。默认悬停时间为 400 毫秒（与 Windows 默认值相同），但您可以更改它。
  3. 在 Windows 发送 WM_MOUSEHOVER 或 WM_MOUSELEAVE 事件的第一次之后，直到您重新请求，它才不会再次发送它们。因此，我在发送 WM_MOUSEMOVE 消息时调用 RequestTracking。
  4. 将 clsTrackInfo 的 Instancing 属性设置为 private。
  5. 在更改本文代码或一般使用 Visual Basic 中的窗口子类化时要小心。我的 IDE 在使其正常工作之前崩溃了多次！！。
  6. 在 MouseLeave、MouseHover 和 MouseMove 事件处理程序中处理所有错误。任何未处理的错误都可能导致 IDE 或应用程序崩溃或产生更多错误。因此，建议使用 On Error ... goto.. 或 On Error Resume Next。
    同样在错误处理（工具 -> 选项 -> 常规选项卡）中，选择在未处理的错误时中断或在类模块中中断，而不是在所有错误时中断。
  7. 最好不要使用 End 或通过在 IDE 中单击“结束”来结束应用程序……这会导致 Terminate 事件未被调用。

如果您不理解以上所有内容

您仍然可以使用该代码。

  1. 创建一个新的 ActiveX 控件项目。
  2. 将 mdlProc.bas、clsTrackInfo.cls 添加到项目中。
  3. 将上面的骨架代码复制并粘贴到您的控件中。

请随时通过此论坛联系作者以获取任何问题或评论。

历史

  • 2004 年 4 月 24 日：初始发布
© . All rights reserved.