Attribute VB_Name = "MMenu"
Option Explicit

'zunächst die benötigten Deklarationen
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 Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Const LB_GETITEMRECT = &H198
Private Const LB_ERR = (-1)

'Die nachfolgende Routine ermittelt den Index
'des Listen-Eintrags, anhand der Mauskoordinaten X und Y
Public Function PopUpListBox(objListBox As Control, _
  X As Single, Y As Single) As Long
    
  Dim lngClick_X As Long
  Dim lngClick_Y As Long
  Dim lngAnt As Long
  Dim aktRect As RECT
  Dim lngCount As Long
  
  PopUpListBox = LB_ERR
  
  'Das Steuerelement muss eine Listbox sein...
  If Not TypeOf objListBox Is ListBox Then
    PopUpListBox = LB_ERR
    Exit Function
  End If
  
  'X und Y Pixel lesen
  lngCount = 0
  lngClick_X = X \ Screen.TwipsPerPixelX
  lngClick_Y = Y \ Screen.TwipsPerPixelY
  Do While True
    'Aktuelle Auswahl als Rectangle lesen
    lngAnt = SendMessage(objListBox.hwnd, _
      LB_GETITEMRECT, lngCount, aktRect)
    
    'Wenn Fehler oder keine Markierung Exit Function
    If lngAnt < 1 Then
      PopUpListBox = LB_ERR
      Exit Function
    End If
    If (lngClick_X >= aktRect.Left) And _
     (lngClick_X <= aktRect.Right) And _
     (lngClick_Y >= aktRect.Top) And _
     (lngClick_Y <= aktRect.Bottom) Then
      PopUpListBox = lngCount
      Exit Function
    End If
    lngCount = lngCount + 1
  Loop
End Function

