[To show a popupmenu just below a given control(hWnd)]

Code/Example below is identical to the VB6 project.
Code should be pasted into Form1, MDIForm1 and Module1.

For suggestions,
E.B. Knoppert, ProFinance WOERDEN Netherlands
profinance@wxs.nl


//Form1;

Option Explicit

Private Sub Command1_Click()

    ShowPopupAligned MDIForm1.MenuFile, Screen.ActiveControl, 0, 0, vbLeftJustify

End Sub

Private Sub Command2_Click()
    
    'It doesn't matter if the control (command2) is placed in another control. (Picturebox)
    ShowPopupAligned MDIForm1.MenuFile, Screen.ActiveControl, 0, 0, vbLeftJustify
    
End Sub

//MDIForm1;

Option Explicit

Dim x As Form

Private Sub Command1_Click()

    Dim W As Integer
    Dim H As Integer

    'We like to align menu at the right side of the button.
    'We need to know the height and Width of the command button in Pixels.
    'These values are neccessary as offset for the default position (leftside/below control)
    
    'Set scalemode of container
    Command1.Container.ScaleMode = vbPixels
    
    'Retrieve dimensions
    W = Command1.Width
    H = Command1.Height

    'Place menu with calculated offset.
    ShowPopupAligned MDIForm1.MenuFile, Screen.ActiveControl, W, -H, vbLeftJustify

End Sub

Private Sub MDIForm_Load()

    'Show form1
    Form1.Show
    
    'Create a copy of form1
    Set x = New Form1
    x.Show

    'Arrange both forms in MDI.
    Me.Arrange vbTileHorizontal

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    End
End Sub

Private Sub mnuFile_Click(Index As Integer)

    Select Case Index
    Case 3: Unload Me
    End Select
    
End Sub

//Module1;

Option Explicit

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

Public Type POINTAPI
        x As Long
        y As Long
End Type

Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

'
'**********************************************************************
'* Category :   32Bits, Code functions
'* Procedure:   ShowPopupAligned
'* Changed  :   1999-02-08, 13:00 (YMD) by :
'* Placed   :   1999-02-08, 13:00 (YMD) by :
'* Revision :
'*
'* Purpose  :   To show a popupmenu just below a given control(hWnd)
'* Example  :
'* Example with control given; (This should be the default usage!)
'* Sub Command1_Click ()
'*     ShowPopupAligned Menu1, Screen.ActiveControl, 0, 0, 0
'* End Sub
'*
'* It's possible to set menu to another control.
'* Sub Command1_Click ()
'*     ShowPopupAligned Menu1, Command1, 0, 0, vbLeftJustify
'* End Sub
'*
'* Example without control given,
'*  control/form beneat mousepointer is used;
'*
'* Sub Command1_Click ()
'*     ShowPopupAligned Menu1, Nothing, 0, 0, vbLeftJustify
'* End Sub
'*
'* A pixel based offset may be set.
'* The menu's positioning flags are also exposed;
'* 0 Left, 1 = Right, 2 = Centered (AlignmentConstants)
'**********************************************************************
'
'[CodeLib message : Move next section into General Declarations...]
'General Declarations / Constants for procedure : ShowPopupAligned
'Public Type RECT
'        Left As Long
'        Top As Long
'        Right As Long
'        Bottom As Long
'End Type
'
'Public Type POINTAPI
'        x As Long
'        y As Long
'End Type
'
'Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'
Sub ShowPopupAligned(Mnu As Menu, c As Control, ByVal XOffSet As Long, ByVal YOffSet As Long, ByVal MenuAligned As AlignmentConstants)

    On Error Resume Next
                       
    Dim chWnd   As Long
    Dim Pa      As POINTAPI
    Dim Rt      As RECT

    'If a control was specified, we need the hWnd only.
    If Not c Is Nothing Then

        chWnd = c.hwnd
    
    Else
        
        'No control specified, take the hWnd beneat mousepointer.
        Pa.x = Screen.Width
        Pa.y = Screen.Height
        
        GetCursorPos Pa
        
        chWnd = WindowFromPoint(Pa.x, Pa.y)

    End If

    Err = 0

    If chWnd = 0 Then Exit Sub
    
    'Retrieve current clientrect by using coordinate 0,0
    Pa.x = 0: Pa.y = 0
    ClientToScreen Mnu.Parent.hwnd, Pa
    
    'Retrieve current control position.
    GetWindowRect chWnd, Rt
        
    'Calculate offset.
    Pa.x = Rt.Left - Pa.x
    Pa.y = Rt.Bottom - Pa.y
    
    'Manual offset (in pixels!)
    Pa.x = Pa.x + XOffSet
    Pa.y = Pa.y + YOffSet
    
    'Convert to twips
    Pa.x = Pa.x * Screen.TwipsPerPixelX
    Pa.y = Pa.y * Screen.TwipsPerPixelY

    'Determine Popuplocation using it's flags.
    Select Case MenuAligned
    Case 1:     MenuAligned = vbPopupMenuRightAlign     'The right side of the pop-up menu is located at x.
    Case 2:     MenuAligned = vbPopupMenuCenterAlign    'The pop-up menu is centered at x.
    Case Else:  MenuAligned = vbPopupMenuLeftAlign      '(Default) The left side of the pop-up menu is located at x.
    End Select
    
    'Place Popup
    'Put forms scalemode in Twips (unfortunatly)
    If Not TypeOf Mnu.Parent Is MDIForm Then Mnu.Parent.ScaleMode = 1
    
    Mnu.Parent.PopupMenu Mnu, MenuAligned, Pa.x, Pa.y
    
    Err.Clear

End Sub
