Attribute VB_Name = "mod_LoadResEx_PopupHelper"
' Copyright (C) 2004-2007 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 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
Private 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, ByVal xControlType As Long) As Long
  Dim xType1 As POINTAPI
  Dim xType2 As RECT
  Dim xLong1 As Long
  Dim xType4 As RECT
    
  Dim xCursorPlusX As Long
  Dim xCursorPlusX2 As Long
  Dim xCursorPlusY As Long
  Dim xCursorPlusY2 As Long
  Dim xType3 As ICONINFO
      
  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&, ByVal 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&)
    
    If HWndControl = 0& Then
      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 + xMenuSize.x + xCursorPlusX > xType2.Right Then
        xType1.x = xType1.x - xMenuSize.x - xCursorPlusX2
        If xType1.x + xMenuSize.x + xCursorPlusX > xType2.Right Then
          xType1.x = xType2.Right - xMenuSize.x
          End If
        Else
        xType1.x = xType1.x + xCursorPlusX
        End If
        
      If xType1.y + xMenuSize.y + xCursorPlusY > xType2.Bottom Then
        xType1.y = xType1.y - xMenuSize.y - xCursorPlusY2
        If xType1.y + xMenuSize.y + xCursorPlusY > xType2.Bottom Then
          xType1.y = xType2.Bottom - xMenuSize.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
      Else
      Call ClientToScreen(HWndControl, xType1)
      Call GetWindowRect(HWndControl, xType4)
      xType4.Bottom = xType4.Bottom - xType4.Top
      
      Select Case xControlType And &HFFFF&
        Case &H1&
            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
        Case &H10&
          xLong1 = SendMessage(HWndControl, &H19F&, 0&, 0&)
          xLong3 = SendMessage(HWndControl, &H18E&, 0&, 0&)
          xLong2 = SendMessage(HWndControl, &H1A1&, 0&, 0&)
          
          
          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&)
            End If
          xLong1 = xLong1 - xLong3
          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
        Case Else
          xType1.y = xType1.y + 8 'some spacing
          xControlType = 0&
        End Select
      
      If xControlType And &H80000000 Then
        xType4.Right = xType4.Right - xType4.Left
        If xType4.Right > xMenuSize.x Then
          xType1.x = xType1.x + (xType4.Right - xMenuSize.x) \ 2&
          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 If
      
      
      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, ByVal 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, ByVal 0&)
      Call PostMessage(hWndCaller, 0&, 0&, 0&)
      End If
    End If
  End Function
