Popup Menus made easy in your applications

This Content Component encountered an error
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

{OPTIONS}
Option Public
Option Explicit

Use "PopupMenu"

{DECLARATIONS}
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"

{OPTIONS}
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

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

Type POINT_TYPE
     x As Long
     y As Long
End Type

Public Type TPMPARAMS
     cbSize As Long
     rcExclude As RECT
End Type

Public Type MENUITEMINFO
     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
               Else
                    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
          Else
               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, ";"))
     Wend
     
     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
                         Next
                    End If
               Next
          End If
     Next
     
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
                    Next
                    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
               Else
                    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
                    Else
                         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
     Next
     
     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 
          DestroyMenu(Menus(MenuCounter).hMenu)
     Next
     
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
               Next
               Exit Forall
          End If
     End Forall
     
End Function
This was first published in May 2001

Dig deeper on Lotus Notes Domino Administration Tools

0 comments

Oldest 

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:

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchDataCenter

SearchExchange

SearchContentManagement

Close