Листинг 1

Attribute VB_Name = "ListMenu"
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 LB_GETITEMHEIGHT = &H1A1

Public Sub ListMenuMouse(cl As Control, fm As Form, _
   Y As Single)
   '
   ' Выделение текущей позиции списка
   ' в соответствии с перемещением курсора мыши
   Dim ItemHeight As Long, NewIndex As Long
   With cl
       ' Высота элемента списка в пикселах
       ItemHeight = SendMessage(.hWnd, LB_GETITEMHEIGHT, _
           0, 0)
       ' Преобразование из пикселов в твипы
       ItemHeight = fm.ScaleY(ItemHeight, vbPixels, vbTwips)
       ' Вычисление индекса элемента списка
       NewIndex = .TopIndex + (Y \ ItemHeight)
       ' Проверка -- не вышел ли индекс за пределы списка?
       If NewIndex < .ListCount Then .ListIndex = NewIndex
   End With
End Sub