Attribute VB_Name = "mod_LoadResEx_PopupHelper"
' Copyright (C) 2004-2008 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA




' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues


Option Explicit
Option Base 0

'Private Type RECT
'  Left As Long
'  Top As Long
'  Right As Long
'  Bottom As Long
'  End Type

Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
  End Type

Private Type MONITORINFO
  cbSize As Long
  rcMonitor As RECT
  rcWork As RECT
  dwFlags As Long
  End Type
'Private Declare Function MonitorFromPoint Lib "user32.dll" (pt As POINTAPI, ByVal dwFlags As Long) As Long
Private Declare Function MonitorFromPoint Lib "user32.dll" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long
Private Const MONITOR_DEFAULTTOEAREST As Long = &H2&
Private Declare Function GetMonitorInfoA Lib "user32.dll" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetMenuItemRect Lib "user32" (ByVal hWnd As Long, ByVal hMenu As Long, ByVal uItem As Long, lprcItem As RECT) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type ICONINFO
  fIcon As Long
  xHotspot As Long
  yHotspot As Long
  hbmMask As Long
  hbmColor As Long
  End Type

Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
  
Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Public Type POINTAPI
  x As Long
  y As Long
  End Type
'Private Type RECT
'  Left As Long
'  Top As Long
'  Right As Long
'  Bottom As Long
'  End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

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, W_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 SystemParametersInfoAnsi(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 SystemParametersInfoAnsi(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 HWndCaller = 0& Then
      xLong2 = GetForegroundWindow()
      Call SetForegroundWindow(xLong4)
      DoEvents
      Call SetForegroundWindow(xLong4)
      GetAPIPopupMenu = TrackPopupMenuEx(hMenu, &H180&, 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, &H180&, xType1.x, xType1.y, HWndCaller, 0&)
      Call PostMessage(HWndCaller, 0&, 0&, 0&)
      End If
    End If
  End Function

Public Sub GetOptMonitorFromPoint(ByVal x As Long, ByVal y As Long, ByRef RectMonitor As RECT)
  Dim xLong1 As Long
  'Dim xType1 As POINTAPI
  Dim xType2 As MONITORINFO
  
  'Stop
  Call SystemParametersInfoAnsi(48&, 0&, RectMonitor, 0&)
  'xType1.x = x
  'xType1.y = y
  'On Error GoTo NoMMApiEr
  xLong1 = MonitorFromPoint(x, y, MONITOR_DEFAULTTOEAREST)
  On Error GoTo 0
  If Not xLong1 = 0& Then
    xType2.cbSize = Len(xType2)
    If Not GetMonitorInfoA(xLong1, xType2) = 0& Then
      Call RtlMoveMemory(RectMonitor, xType2.rcWork, 16&)
      End If
    End If
'HMONITOR MonitorFromPoint(
'  POINT pt,      // a specified point
'  DWORD dwFlags  // flags if no monitor contains specified point
');

  
'MonitorFromPoint
  
  
NoMMApiRs:
  On Error GoTo 0
  Exit Sub
  
NoMMApiEr:
  Resume NoMMApiRs
  End Sub

Public Sub WindowToCursorPos(ByRef xWindowSize As POINTAPI, ByRef xType1 As POINTAPI)
  Dim xLong1 As Long
  Dim xCursorPlusX As Long
  Dim xCursorPlusX2 As Long
  Dim xCursorPlusY As Long
  Dim xCursorPlusY2 As Long
  Dim xType2 As RECT
  Dim xType3 As ICONINFO
  
  'Call SystemParametersInfoAnsi(48&, 0&, xType2, 0&)
  Call GetCursorPos(xType1)
'  Call GetOptMonitorFromPoint(xWindowSize.X, xWindowSize.Y, xType2)
  Call GetOptMonitorFromPoint(xType1.x, xType1.y, xType2)
  
'  Call GetCursorPos(xType1)
  xLong1 = LoadCursor(&H7F00&)
  Call GetIconInfo(xLong1, xType3)
  If Not xType3.hbmMask = 0& Then Call DeleteObject(xType3.hbmMask)
  If Not xType3.hbmColor = 0& Then Call DeleteObject(xType3.hbmColor)
  
  
  If xType3.xHotspot > 16& Then
    xCursorPlusX = 36& - xType3.xHotspot
    xCursorPlusX2 = 16&
    Else
    xCursorPlusX = 16&
    xCursorPlusX2 = 4& + xType3.xHotspot
    End If
  If xType3.yHotspot > 16& Then
    xCursorPlusY = 36& - xType3.yHotspot
    xCursorPlusY2 = 16&
    Else
    xCursorPlusY = 16&
    xCursorPlusY2 = 4& + xType3.yHotspot
    End If
    
    
  If xType1.x + xWindowSize.x + xCursorPlusX > xType2.Right Then
    xType1.x = xType1.x - xWindowSize.x - xCursorPlusX2
    'If xType1.x + xWindowSize.x + xCursorPlusX > xType2.Right Then
    If xType1.x + xWindowSize.x > xType2.Right Then
      xType1.x = xType2.Right - xWindowSize.x
      End If
    Else
    xType1.x = xType1.x + xCursorPlusX
    End If
    
  If xType1.y + xWindowSize.y + xCursorPlusY > xType2.Bottom Then
    xType1.y = xType1.y - xWindowSize.y - xCursorPlusY2
    If xType1.y + xWindowSize.y + xCursorPlusY > xType2.Bottom Then
      xType1.y = xType2.Bottom - xWindowSize.y
      End If
    Else
    xType1.y = xType1.y + xCursorPlusY
    End If
  If xType1.x < xType2.Left Then xType1.x = xType2.Left
  If xType1.y < xType2.Top Then xType1.y = xType2.Top
  'Debug.Print xType1.x, xType1.y
  End Sub
