[API]
SetMenu
DrawMenuBar
GetMenuItemCount
GetMenuItemRect
ClientToScreen
GetWindowRect
TrackPopupMenuEx
DestroyWindow
GetSystemMetrics
GetForegroundWindow
SetForegroundWindow

[INCLUDE]
CreateWindowEx
GetClassName
GetOptMonitorFromPoint
PostMessage
SendMessage
WindowToCursorPos

[CODE]
Public Function GetAPIPopupMenu(ByVal HWndCaller As Long, ByVal hMenu As Long, ByVal HWndControl As Long) As Long
  Dim xType1 As POINTAPI
  Dim xType2 As RECT
  Dim xLong1 As Long
  Dim xType4 As RECT
    
  Dim xMenuSize As POINTAPI
  Dim xLong2 As Long
  Dim xLong3 As Long
  Dim xLong4 As Long
    
    'xControlMode: 10(-12 reserved) -> ListBox
    ' -1-> mouse
    ' 0 -> nospecial
    ' 1 -> centerclient
    ' 2 -> outsidecontrol
    
    '0=SingleSel?
    '1=extended?
    '2=checkboxmode?
  If Not hMenu = 0& Then
    xLong4 = CreateWindowEx(0, "STATIC", vbNullString, &H8000003, 0&, 0&, 32&, 32&, 0&, 0&, 0&)
    '&H8000000
    Call SetMenu(xLong4, hMenu)
    Call DrawMenuBar(xLong4)
    Call SetMenu(xLong4, 0&)
    Call DrawMenuBar(xLong4)
    
    xLong1 = GetMenuItemCount(hMenu)
    Call GetMenuItemRect(xLong4, hMenu, xLong1 - 1&, xType2)
    xMenuSize.x = xType2.Right
    xMenuSize.y = xType2.Bottom
    Call GetMenuItemRect(xLong4, hMenu, 0&, xType2)
    If Not HWndCaller = 0& Then Call DestroyWindow(xLong4)
    
    xMenuSize.x = xMenuSize.x - xType2.Left
    xMenuSize.y = xMenuSize.y - xType2.Top
    xMenuSize.x = xMenuSize.x + GetSystemMetrics(7&) * 2&
    xMenuSize.y = xMenuSize.y + GetSystemMetrics(8&) * 2&
    
    'Call SystemParametersInfoA(48&, 0&, xType2, 0&)
    'Call GetOptMonitorFromPoint((xType2.Left + xType2.Right) / 2&, (xType2.Top + xType2.Bottom) / 2&, xType2)
    If HWndControl = 0& Then
      'Debug.Print "1"
      Call WindowToCursorPos(xMenuSize, xType1)
      Call GetOptMonitorFromPoint(xType1.x, xType1.y, xType2)
      Else
      'Debug.Print "2"
      Call ClientToScreen(HWndControl, xType1)
      Call GetWindowRect(HWndControl, xType4)
      Call GetOptMonitorFromPoint((xType4.Left + xType4.Right) / 2&, (xType4.Top + xType4.Bottom) / 2&, xType2)
      xType4.Bottom = xType4.Bottom - xType4.Top
      
      'Call SystemParametersInfoA(48&, 0&, xType2, 0&)
      'Call GetOptMonitorFromPoint((xType2.Left + xType2.Right) / 2&, (xType2.Top + xType2.Bottom) / 2&, xType2)
      
      Select Case UCase(GetClassName(HWndControl))
        Case "LISTBOX"
          xLong1 = SendMessage(HWndControl, &H19F&, 0&, 0&) 'LB_GETCARETINDEX
          xLong3 = SendMessage(HWndControl, &H18E&, 0&, 0&) 'LB_GETTOPINDEX
          xLong2 = SendMessage(HWndControl, &H1A1&, 0&, 0&) 'LB_GETITEMHEIGHT
          
          If Not (xLong1 > xLong3 - 1& And xLong1 < xLong3 + (xType4.Bottom \ xLong2) - 1&) Then
            xLong3 = xLong1 - (xType4.Bottom \ xLong2 - 1&) \ 2&
            If xLong3 < 0 Then xLong3 = 0&
            Call SendMessage(HWndControl, &H197&, xLong3, 0&) 'LB_SETTOPINDEX
            End If
          xLong1 = xLong1 - xLong3
          'Stop
          If xType1.y + (xLong1 + 1.25) * xLong2 + xMenuSize.y > xType2.Bottom Then
            xType1.y = xType1.y - xMenuSize.y + (xLong1 - 0.25) * xLong2
            Else
            xType1.y = xType1.y + (xLong1 + 1.25) * xLong2
            End If
            
            ' center l/r
        xType4.Right = xType4.Right - xType4.Left
        If xType4.Right > xMenuSize.x Then
          xType1.x = xType1.x + (xType4.Right - xMenuSize.x) \ 2&
          End If
            
        Case Else
          xType1.y = xType4.Bottom / 4&
          If xType4.Top + xType4.Bottom - xType1.y + xMenuSize.y > xType2.Bottom Then
            xType1.y = xType4.Top + xType1.y - xMenuSize.y
            Else
            xType1.y = xType4.Top + xType4.Bottom - xType1.y
            End If
          xType1.x = (xType4.Right - xType4.Left) / 4
          If xType4.Left + xType1.x + xMenuSize.x > xType2.Right Then
            xType1.x = xType4.Right - xType1.x - xMenuSize.x
            Else
            xType1.x = xType4.Left + xType1.x
            End If
        
        'If (xControlType And &HFFFF&) = 0& Then
        '  If xType4.Bottom > xMenuSize.y Then
        '    xType1.y = xType1.y + (xType4.Bottom - xMenuSize.y) \ 2&
        '    End If
        '  End If
        End Select
      
      
      If xType1.x + xMenuSize.x > xType2.Right Then
        xType1.x = xType2.Right - xMenuSize.x
        End If
      If xType1.y + xMenuSize.y > xType2.Bottom Then
        xType1.y = xType2.Bottom - xMenuSize.y
        End If
      End If
    If xType1.x < xType2.Left Then xType1.x = xType2.Left
    If xType1.y < xType2.Top Then xType1.y = xType2.Top
    
    #If ToolTip Then
      ToolTip_DisableInt
      #End If
    If HWndCaller = 0& Then
      xLong2 = GetForegroundWindow()
      Call SetForegroundWindow(xLong4)
      DoEvents
      Call SetForegroundWindow(xLong4)
      GetAPIPopupMenu = TrackPopupMenuEx(hMenu, &H182&, xType1.x, xType1.y, xLong4, 0&)
      If Not (xLong2 = 0& Or GetAPIPopupMenu = 0&) Then
        Call SetForegroundWindow(xLong2)
        End If
      Call DestroyWindow(xLong4)
      Else
      GetAPIPopupMenu = TrackPopupMenuEx(hMenu, &H182&, xType1.x, xType1.y, HWndCaller, 0&)
      Call PostMessage(HWndCaller, 0&, 0&, 0&)
      End If
    #If ToolTip Then
      ToolTip_IsEnabledInt = True
      #End If
    End If
  End Function
