Public Sub Destroy()
   If m_lTTHwnd <> 0 Then
      DestroyWindow m_lTTHwnd
   End If
End Sub

Public Property Get VisibleTime() As Long
   VisibleTime = mvarVisibleTime
End Property

Public Property Let VisibleTime(ByVal lData As Long)
   mvarVisibleTime = lData
End Property

Public Property Get DelayTime() As Long
   DelayTime = mvarDelayTime
End Property

Public Property Let DelayTime(ByVal lData As Long)
   mvarDelayTime = lData
End Property

一个窗体，窗体上一个listview控件，代码如下：

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Const LVM_FIRST = &H1000&
Const LVM_HITTEST = LVM_FIRST + 18

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type LVHITTESTINFO
   pt As POINTAPI
   flags As Long
   iItem As Long
   iSubItem As Long
End Type

Dim TT As CTooltip
Dim m_lCurItemIndex As Long

Private Sub Form_Load()
   With ListView1.ListItems
      .Add Text:="Test item #1"
      .Add Text:="Test item #2"
      .Add Text:="Long long long test item #3"
   End With

   Set TT = New CTooltip
   TT.Style = TTBalloon
   TT.Icon = TTIconInfo
End Sub

Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim lvhti As LVHITTESTINFO
   Dim lItemIndex As Long
  
   lvhti.pt.X = X / Screen.TwipsPerPixelX
   lvhti.pt.Y = Y / Screen.TwipsPerPixelY
   lItemIndex = SendMessage(ListView1.hwnd, LVM_HITTEST, 0, lvhti) + 1
  
   If m_lCurItemIndex <> lItemIndex Then
      m_lCurItemIndex = lItemIndex
      If m_lCurItemIndex = 0 Then   '''' no item under the mouse pointer
         TT.Destroy
      Else
         TT.Title = "Multiline tooltip"
         TT.TipText = ListView1.ListItems(m_lCurItemIndex).Text
         TT.Create ListView1.hwnd
      End If
   End If
End Sub

上一页  [1] [2]