PopUp-menu Script help please

This is my code :

Sub CreateSectionMenu()
Dim MenuNum
Set mainmenu = nothing
Set mainmenu = DesktopX.CreatePopupMenu '-- Create Main Menu
MenuNum = 1
strQuery = "SELECT * FROM ShopCategories1"
Set RS2 = CreateObject("ADODB.Recordset")
RS2.Open strQuery, Connection, 3, 3
RS2.MoveFirst
While Not RS2.EOF
mainmenu.AppendMenu 0, MenuNum, RS2("ShopCategoryA_en")
msgbox MenuNum & " - " & RS2("ShopCategoryA_en")
MenuNum = MenuNum + 1
RS2.MoveNext
Wend
RS2.Close
Set RS2 = Nothing
Call ExecuteSectionMenu(result,snum)
End Sub

The msgbox code is for testing purposes only and shows the wright values. Nevertheless the menu doesn't show up. Did I oversee anything ? This is just a copy of other menus that work flawlessly. Only this one is giving me a headache...
1,990 views 4 replies
Reply #1 Top
Never mind my dumbness.

I forgot to add :

result = mainmenu.TrackPopupMenu(0, System.CursorX, System.CursorY)
Reply #2 Top
hihi. The fun of debugging. The worst bit is when the bug is a missing ".". Those a really hard to notice sometimes. I've spent hours over them pesky little four pixels some times.
Reply #3 Top
I am trying to find a more professional use of DX Pro at the moment, writing frontends for Access-databases (which I use since V 1). Screenshots will follow.
Reply #4 Top
I think you must create the temporary array of future menu items before applying them into menu... So you code may be modified like:

Dim xarray(),n

Sub CreateSectionMenu()
n = 0
On Error Resume Next
strQuery = "SELECT * FROM ShopCategories1"
Set RS2 = CreateObject("ADODB.Recordset")
RS2.Open strQuery, Connection, 3, 3
RS2.MoveFirst
While Not RS2.EOF
Redim Preserve xarray(n)
xarray(n) = RS2("ShopCategoryA_en")
n = n + 1
RS2.MoveNext
Wend
RS2.Close
Set RS2 = nothing

Set mainmenu = nothing
Set mainmenu = DesktopX.CreatePopupMenu '-- Create Main Menu
x = 1
For i = 0 To UBound(xaray)
mainmenu.AppendMenu 0, x, xaray(i)
msgbox x & " - " & xaray(i)
Next
result = mainmenu.TrackPopupMenu(0, System.CursorX, System.CursorY)
Call ExecuteSectionMenu(result,1)
End Sub

Sub ExecuteSectionMenu(n,x)
For i = 0 To UBound(xarray)
Select Case n
Case x "your object" = xarray(i)
End Select
x = x + 1
Next
Erase xarray
Set mainmenu = nothing
End Sub

Hope this will help you...

Long Live DX PRO!