Friday, June 8, 2012

VB6 Code - Cara Menampilkan ToolTipText Pada ListBox

Mengenai cara menampilkan ToolTipText pada saat pointer mouse bergerak di atas ListItem ListBox menggunakan VB6 Code. Adapun cara menampilkan ToolTipText pada ListBox adalah sebagai berikut:

Option Explicit 

Private Type
POINTAPI
x As Long
Y As Long
End Type

Private Declare Function
ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function
LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long
Private Declare Function
SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private
WithEvents lst As ListBox
Private Const LB_SETHORIZONTALEXTENT = &H194

Public Property Let
List(New_List As ListBox)
Set lst = New_List
End Property

Private Sub
lst_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' lst.ListIndex = ItemUnderMouse(lst.hwnd, X, Y)
Dim l As Long
Dim a As Long
a =
lst.Parent.TextWidth(lst.List(ItemUnderMouse(lst.hwnd, x, Y))) / Screen.TwipsPerPixelX
l = lst.Parent.TextWidth("AAAAAAAAAAAAAAAAAAAAAAA") / Screen.TwipsPerPixelX
If a > l Then
If
lst.ToolTipText <> lst.List(ItemUnderMouse(lst.hwnd, x, Y)) Then
lst.ToolTipText = lst.List(ItemUnderMouse(lst.hwnd, x, Y))
End If
Else
lst.ToolTipText = ""
End If
End Sub

' Return the index of the item under the mouse.
Public Function ItemUnderMouse(ByVal list_hWnd As Long, ByVal x As Single, ByVal Y As Single)
Dim pt As POINTAPI
pt.x = x \ Screen.TwipsPerPixelX
pt.Y = Y \ Screen.TwipsPerPixelY
ClientToScreen list_hWnd, pt
ItemUnderMouse = LBItemFromPt(list_hWnd, pt.x, pt.Y, False)
End Function