Popup Menus made easy in your applications

Here is a Lotus Script Library which easily handles the creation and Tracking of Popup Menus in your notes application. It automatically creates a return value based on the selected menu items position in the menu. You can insert single menu items, sub menu items and separator bars. Due to limited space in this forum, I am unable to include comments in the code. You can email me at noteshelp@bigpond.com
+++ Create the following Lotus Script Agent, to test the application

Option Public
Option Explicit

Use "PopupMenu"

Sub Initialize
     Dim Menus() As MenuHandles
     Dim MenuString As String
     Dim retval As Integer
'Prepare the menu and sub-menus
     MenuString = "1. Menu Item 1\Sub Item 1;1. Menu Item 1\Sub Item 2;1. Menu Item 1\Sub Item 3;"
     MenuString = MenuString + "-;"
     MenuString = MenuString + "Menu Item 2;3. Menu Item 3\Sub Item 1;"
'Create menu structure
     Call GetMenus(MenuString, Menus())
'Display the menus and wait for a menu selection
     retval = PopupMenu(Menus())
     Msgbox "The return value = " & retval,,"Popup Menu"
End Sub

+++ Create the following Script LIBRARY called "PopupMenu"

Option Public
Option Explicit

Public Const MFS_ENABLED = &H0
Public Const MFS_DEFAULT = &H1000
Public Const MFS_CHECKED = &H8
Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_TYPE = &H10
Public Const MFT_SEPARATOR = &H800
Public Const MFT_STRING = &H0
Public Const TPM_LEFTALIGN = &H0
Public Const TPM_TOPALIGN = &H0
Public Const TPM_NONOTIFY = &H80
Public Const TPM_RETURNCMD = &H100
Public Const TPM_LEFTBUTTON = &H0
Public Const MaxMenuItems = 20

Type MenuHandles
     hMenu As Long
     ID As Integer
     Name As String
     MenuCount As Integer
     SubMenuCount As Integer
     MenuItems(MaxMenuItems) As String
     MenuID(MaxMenuItems) As Integer
End Type

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

     x As Long
     y As Long
End Type

     cbSize As Long
     rcExclude As RECT
End Type

     cbSize As Long
     fMask As Long
     fType As Long
     fState As Long
     wID As Long
     hSubMenu As Long
     hbmpChecked As Long
     hbmpUnchecked As Long
     dwItemData As Long
     dwTypeData As String
     cch As Long
End Type

Declare Function SetRectEmpty Lib "user32.dll" (lpRect As RECT) As Long
Declare Function GetCursorPos Lib "user32.dll" Alias "GetCursorPos" (lpPoint As POINT_TYPE) As Long
Declare Function CreatePopupMenu Lib "user32.dll" Alias "CreatePopupMenu" () As Long
Declare Function TrackPopupMenuEx Lib "user32.dll" (Byval hMenu As Long, Byval fuFlags As Long, Byval x As Long, Byval y As Long, Byval hWnd As Long, lptpm As TPMPARAMS) As Long
Declare Function DestroyMenu Lib "user32.dll" Alias "DestroyMenu" (Byval hMenu As Long) As Long
Declare Function GetActiveWindow Lib "user32.dll" Alias "GetActiveWindow" () As Long
Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" (Byval hMenu As Long, Byval uItem As Long, Byval fByPosition As Long, lpmii As MENUITEMINFO) As Long

+++ Paste the following functions into the script library

Function GetMenus(MenuString As String, menus() As MenuHandles) As Integer
     Const MainMenu = 0
     Dim MenuItem As String
     Dim tMenuItem As String
     Dim NumMenus As Integer
     Dim NumItems As Integer
     Dim nMenu As Integer
     Dim MenuNumber As Integer
     Dim Counter1 As Integer
     Dim Counter2 As Integer
     Dim Counter3 As Integer
     Dim ID As Integer
     NumMenus = 0
     NumItems = 0
     Redim Preserve Menus(NumMenus)
     Menus(NumMenus).Name = "Main"
     Menus(NumMenus).MenuCount = 0
     Menus(NumMenus).SubMenuCount = 0
     While Instr(MenuString, ";") > 1
          MenuItem = Left$(MenuString, Instr(MenuString, ";") -1)
          If Instr(MenuItem, "\") Then
               tMenuItem = "%" & Left$(MenuItem, Instr(MenuItem, "\") -1)
               If SubMenu(Menus, tMenuItem, nMenu) Then
                    MenuNumber = Menus(nMenu).MenuCount
                    Menus(nMenu).Menuitems(MenuNumber) = Right$(MenuItem, Len(Menuitem) - Instr(MenuItem, "") - 1)
                    Menus(nMenu).MenuCount = Menus(nMenu).MenuCount + 1
                    Menus(MainMenu).SubMenuCount = Menus(MainMenu).SubMenuCount + 1
                    MenuNumber = Menus(MainMenu).MenuCount
                    Menus(MainMenu).Menuitems(MenuNumber) = tMenuItem
                    Menus(MainMenu).MenuCount = Menus(MainMenu).MenuCount + 1
                    NumMenus = NumMenus + 1
                    Redim Preserve Menus(NumMenus)
                    Menus(NumMenus).Name = Right$(tMenuItem, Len(tMenuItem) -1)
                    MenuNumber = Menus(NumMenus).MenuCount
                    Menus(NumMenus).MenuItems(MenuNumber) = Right$(MenuItem, Len(Menuitem) - Instr(MenuItem, "\") - 1)
                    Menus(NumMenus).MenuCount = Menus(NumMenus).MenuCount + 1
               End If
               MenuNumber = Menus(MainMenu).MenuCount
               Menus(MainMenu).Menuitems(MenuNumber) = MenuItem
               Menus(MainMenu).MenuCount = Menus(MainMenu).MenuCount + 1
          End If
          MenuString = Right$(MenuString, Len(MenuString) - Instr(MenuString, ";"))
     ID = 1
     For Counter1 = 0 To Menus(MainMenu).MenuCount - 1
          Menus(MainMenu).MenuID(Counter1) = ID
          ID = ID + 1
          MenuItem = Menus(MainMenu).MenuItems(Counter1)
          If Left$(MenuItem, 1) = "%" Then
               For Counter2 = 1 To Menus(MainMenu).SubMenuCount
                    If Menus(Counter2).Name = Right$(MenuItem, Len(MenuItem) -1) Then
                         Menus(Counter2).ID = ID - 1
                         For Counter3 = 0 To Menus(Counter2).MenuCount - 1
                              Menus(Counter2).MenuID(Counter3) = ID
                              ID = ID + 1
                    End If
          End If
End Function
Function PopupMenu(Menus() As Menuhandles) As Integer
     Dim MenuCounter As Integer
     Dim MenuCount2 As Integer
     Dim hMenu As Double
     Dim hMenuSub As Double
     Dim ID As Integer
     Dim itemCounter As Integer
     Dim hWnd As Long
     Dim mii As MENUITEMINFO
     Dim tpm As TPMPARAMS
     Dim curpos As POINT_TYPE
     Dim retval As Long
     For MenuCounter = Menus(0).SubMenuCount To 0 Step -1
          hMenu = CreatePopupMenu()
          Menus(MenuCounter).hMenu = hMenu
          ItemCounter = 0
          Forall MenuItems In Menus(MenuCounter).MenuItems
               If MenuItems = "" Then Exit Forall
               If Left$(MenuItems, 1) = "%" Then
                    For MenuCount2 = 1 To Menus(0).SubMenuCount
                         If Menus(MenuCount2).Name = Right$(MenuItems, Len(MenuItems) - 1) Then
                              hMenuSub = Menus(MenuCount2).hMenu
                              ID = Menus(MenuCount2).ID
                         End If
                    mii.cbSize = Len(mii)
                    mii.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE Or MIIM_SUBMENU
                    mii.fType = MFT_STRING
                    mii.fState = MFS_ENABLED Or MFS_DEFAULT
                    mii.wID = ID
                    mii.hSubMenu = hMenuSub
                    mii.dwTypeData = Right$(MenuItems, Len(MenuItems) - 1)
                    mii.cch = Len(mii.dwTypeData)
                    retval = InsertMenuItem(hMenu, 0, False, mii)
                    ItemCounter = ItemCounter + 1
                    If MenuItems = "-" Then
                         mii.cbSize = Len(mii)
                         mii.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
                         mii.fType = MFT_SEPARATOR
                         mii.fState = MFS_ENABLED
                         mii.wID = Menus(MenuCounter).MenuID(ItemCounter)
                         retval = InsertMenuItem(hMenu, 0, False, mii)
                         ItemCounter = ItemCounter + 1
                         mii.cbSize = Len(mii)
                         mii.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
                         mii.fType = MFT_STRING
                         mii.fState = MFS_ENABLED Or MFS_DEFAULT
                         mii.wID = Menus(MenuCounter).MenuID(ItemCounter)
                         mii.dwTypeData = MenuItems
                         mii.cch = Len(mii.dwTypeData)
                         retval = InsertMenuItem(hMenu, 0, False, mii)
                         ItemCounter = ItemCounter + 1
                    End If
               End If
          End Forall
     retval = GetCursorPos(curpos)
     hWnd = GetActiveWindow()
     tpm.cbSize = Len(tpm)
     retval = SetRectEmpty(tpm.rcExclude)
     PopupMenu = TrackPopupMenuEx(hMenu, TPM_TOPALIGN Or TPM_LEFTALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD Or TPM_LEFTBUTTON, curpos.x, curpos.y, hWnd, tpm)
     For MenuCounter = Menus(0).SubMenuCount To 0 Step -1 
End Function
Function SubMenu(Menus() As MenuHandles, tMenuItem As String, nMenuNumber As Integer) As Integer
     Dim MenuCount As Integer
     SubMenu = False
     Forall MenuItem In Menus(0).MenuItems
          If MenuItem = tMenuItem Then
               SubMenu = True
               For MenuCount = 1 To Menus(0).SubMenuCount
                    If Menus(MenuCount).Name = Right$(tMenuItem, Len(tMenuItem) -1) Then
                         nMenuNumber = MenuCount
                    End If
               Exit Forall
          End If
     End Forall
End Function

This was first published in May 2001

There are Comments. Add yours.

TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.