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
Private Const LB_ITEMFROMPOINT = &.H1A9
编写列表框的鼠标移动事件代码如下: Private Sub List1_MouseMove(Button As Integer, Shift As Integer, _X As Single, Y As Single)
Dim lXPoint As Long Dim lYPoint As Long Dim lIndex As Long If Button = 0 Then lXPoint = CLng(X / Screen.TwipsPerPixelX) lYPoint = CLng(Y / Screen.TwipsPerPixelY)
With List1 ’获得当前条目的索引号 lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, _ ByVal ((lYPoint * 65536) lXPoint)) If (lIndex >= 0) And (lIndex < = .ListCount) Then ’判断条目的长度是否大于列表框宽度 If TextWidth(.List(lIndex)) > .Width Then .ToolTipText = .List(lIndex) Else .ToolTipText = "" End If End If End With End If
End Sub 在Form_Load事件中为列表框添加 几个条目供验证使用:
Private Sub Form_Load()
With List1 .AddItem "智能列表框Listbox" .AddItem "这是一个长条目信息,将鼠标移到其上, 你就能看到完整信息" End With
End Sub 第二种方法的思路和第一种是基本类似的,但直接使用字体的大小属性来判断,不需要使用API函数,看一下下面的代码就明白了。可以使用下面的代码来替换上面的列表框鼠标移动事件代码: Private Sub List1_MouseMove (Button As Integer, Shift As Integer, _ X As Single, Y As Single) Dim Ypos As Integer, iOldFontSize As Integer iOldFontSize = Me.Font.Size Me.Font.Size = List1.Font.Size Ypos = Y \ Me.TextHeight("Xyz") List1.TopIndex Me.Font.Size = iOldFontSize If Ypos < List1.ListCount Then List1.ToolTipText = List1.List(Ypos) Else List1.ToolTipText = "" End If End Sub 程序运行环境:中文VB 5.0专业版,中文WIN95。