[AP] Popup menu

link: http://www-10.lotus.com/ldd/nd6forum.nsf/55c38d716d632d9b8525689b005ba1c0/497f6834e4652d54852571420033093f?OpenDocument

I found this "popup menu" on the internet a few years back. Don't remember who the author is. It works very well.

(Declarations)

Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Type POINTAPI

x As Long

y As Long

End Type

Type MSG

hwnd As Long

message As Long

wParam As Long

lParam As Long

time As Long

pt As POINTAPI

End Type

Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long

Declare Function CreatePopupMenu Lib "user32" Alias "CreatePopupMenu" () As Long

Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (Byval hMenu As Long, Byval wFlags As Long, Byval wIDNewItem As Integer, Byval lpNewItem As Any) As Long

Declare Function TrackPopupMenu Lib "user32" Alias "TrackPopupMenu" (Byval hMenu As Long, Byval wFlags As Long, Byval x As Long, Byval y As Long, Byval nReserved As Long, Byval hwnd As Long, lprc As Rect) As Long

Declare Function DestroyMenu Lib "user32" Alias "DestroyMenu" (Byval hMenu As Long) As Long

Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, Byval hwnd As Long, Byval wMsgFilterMin As Long, Byval wMsgFilterMax As Long) As Long

Declare Function GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long

Function PopMenu (pstrItem As String, mx As Long, my As Long) As Long

' Pop a menu at coordinates mx, my (pixels)

' or current cursor position if 0,0

' pstrItem is a semicolon-delimited string

' ie: "Item 1;Item 2;-;Item 3"

' A separator is created from a '-'

' Use of ampersand to underline character is Ok

'

' Returns number of item chosen, or 0 if user

' clicks off the menu or presses <Esc>

Const MF_ENABLED = &H0

Const TPM_LEFTALIGN = &H0

Const MF_SEPARATOR = &H800

Const SEP = ";"

Dim msgdata As MSG

Dim rectdata As RECT

Dim Cursor As POINTAPI

Redim strItem(1 To 20) As String

Dim i As Long

Dim j As Long

Dim last As Long

Dim hMenu As Long

Dim id As Integer

Dim junk As Long

On Error Goto errorHandling

If Right$(pstrItem, 1) <> SEP Then pstrItem = pstrItem + SEP

j = 1

Do

i = Instr(j, pstrItem, SEP)

If i Then

last = last + 1

strItem(last) = Mid$(pstrItem, j, i - j)

j = i + 1

End If

Loop Until i = 0

hMenu = CreatePopupMenu()

id = 1

For i = 1 To last

If strItem(i) <> "-" Then

junk = AppendMenu(hMenu, MF_ENABLED, id, strItem(i))

id = id + 1

Else

junk = AppendMenu(hMenu, MF_SEPARATOR, 0, "")

End If

Next

If mx = 0 And my = 0 Then

Call GetCursorPos(Cursor)

mx = Cursor.x

my = Cursor.y

End If

junk = TrackPopupMenu(hMenu, TPM_LEFTALIGN, mx, my, 0, GetActiveWindow(), rectdata)

junk = GetMessage(msgdata, GetActiveWindow(), 0, 0)

i = Abs(msgdata.wparam)

If msgdata.message = 273 Then

PopMenu = i

End If

Call DestroyMenu(hMenu)

Exit Function

errorHandling:

Call DestroyMenu(hMenu) 

Exit Function

End Function

I use it in a button, to add, edit or delete reference data, here's an example:

Sub PickRiskCode( doc As notesdocument, x% )

Dim docNew As New notesdocument( s.currentdatabase )

On Error Goto errorHandling

mEdit$ = "&Edit;"

mDelete$ = "&Delete;" 

menuitem$ = mEdit$ & mDelete$ 

If doc.getitemvalue( "RiskType_" & Cstr(x%) )(0) = "" Then

action% = 1

Else

action% = PopMenu( menuitem$,0,0)

For i% = 1 To 4

macro$ = |@Word("| & doc.getitemvalue( "RiskType_" & Cstr(x%))(0) & |";";";| & Cstr(i%) & |)|

v = Evaluate( macro$ )

docNew.replaceitemvalue "RiskCat_" & Cstr(i%), v 

docNew.replaceitemvalue "lastRiskCat_" & Cstr(i%), v 

Next 

End If

Select Case action%

Case 1 ' add 4 lines

If uiwork.DialogBox( "dlgRiskType", True, True, False, False, False, False, "Industry Categories", docNew, True, False ) Then

entry$ = docNew.getitemvalue( "RiskCat_1" )(0) & "; " & docNew.getitemvalue( "RiskCat_2" )(0) &_

"; " & docNew.getitemvalue( "RiskCat_3" )(0) & "; " & docNew.getitemvalue( "RiskCat_4" )(0)

Call doc.replaceitemvalue( "RiskType_" & Cstr(x%), entry$ )

End If

Case 2 ' add x lines

Call doc.replaceitemvalue( "RiskType_" & Cstr(x%), "" )

End Select

Exit Sub

errorHandling:

Print "PickRiskCode reports:"

Print pickServer$ & " : " & pickDb$ & " -> " & pickView$

Print Cstr(Err) & " " & Error$

Resume Next

End Sub