Nested Menus [Windows]

[RASHAD]

- Right click over 1st. Drop down Menu to show Popup Menu
- Left click to process

Code: Select all

#TPM_RECURSE   = $0001
#TPM_NONOTIFY  = $0080
#TPM_RETURNCMD = $0100

Procedure LeftClick ()
  In.INPUT 
  In\type        = #INPUT_MOUSE
  In\mi\dwFlags  = #MOUSEEVENTF_LEFTDOWN
  SendInput_(1,@In,SizeOf(INPUT))
  In\mi\dwFlags  = #MOUSEEVENTF_LEFTUP  
  SendInput_(1,@In,SizeOf(INPUT))
EndProcedure

Procedure WinCallback(hwnd, uMsg, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
   Select uMsg                  
      Case #WM_MENURBUTTONUP      
            GetCursorPos_(p.POINT)
            TrackPopupMenuEx_(MenuID(1),#TPM_RECURSE,p\x,p\y,WindowID(0),0)               
            SetCursorPos_(WindowX(0)+30,WindowY(0)+10)
            LeftClick()
            SetCursorPos_(p\x,p\y)
  EndSelect
  ProcedureReturn result
EndProcedure

If OpenWindow(0,0,0,600,400, "Popup-Menu Example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CreateMenu(0, WindowID(0))
  MenuTitle("Project")
  MenuItem(1, "Open"   +Chr(9)+"Ctrl+O")
  MenuItem(2, "Save"   +Chr(9)+"Ctrl+S")
  MenuItem(3, "Save as"+Chr(9)+"Ctrl+A")
  MenuItem(4, "Close"  +Chr(9)+"Ctrl+C")
    
  CreatePopupMenu(1)     
      MenuItem(5, "Pop # 1 Open")     
      MenuItem(6, "Pop # 1 End")      

 SetWindowCallback(@WinCallback())
 
Repeat
  Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
            Quit = 1
            
      Case #PB_Event_Menu           
        Select EventMenu()
            Case 1 : Debug " Item # 1"
            Case 5 : Debug "PopMenu # 1: Open"
            Case 6 : Debug " PopMenu # 1: End"

     
        EndSelect
  EndSelect
Until Quit = 1
  EndIf

[rsts]

It's beautiful

Many thanks friend.

[RASHAD]

Ver. 2
True Nested Menu(More than one level)

Code: Select all

Global ActMenu

#TPM_RECURSE   = $0001
#TPM_NONOTIFY  = $0080
#TPM_RETURNCMD = $0100

Procedure LeftClick ()
  In.INPUT 
  In\type        = #INPUT_MOUSE
  In\mi\dwFlags  = #MOUSEEVENTF_LEFTDOWN
  SendInput_(1,@In,SizeOf(INPUT))
  In\mi\dwFlags  = #MOUSEEVENTF_LEFTUP  
  SendInput_(1,@In,SizeOf(INPUT))
EndProcedure

Procedure WinCallback(hwnd, uMsg, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
   Select uMsg
    Case #WM_INITMENUPOPUP
            If lParam = 1 Or lParam = 2
               ActMenu = 0
            EndIf
            ActMenu + 1
                             
    Case #WM_MENURBUTTONUP
          GetCursorPos_(p.POINT)
          Item = TrackPopupMenuEx_(MenuID(ActMenu),#TPM_RECURSE|#TPM_RETURNCMD,p\x,p\y,WindowID(0),0)
          Select Item
              Case 14
                    Debug "PopMenu # 1: Open"
              Case 15
                    Debug "PopMenu # 1: End"
              Case 16
                    Debug "PopMenu # 2: Open"
              Case 17
                    Debug "PopMenu # 2: End"
          EndSelect
          ActMenu = 0             
          SetCursorPos_(WindowX(0)+30,WindowY(0)+10)
          LeftClick()
          SetCursorPos_(p\x,p\y)
  EndSelect
  ProcedureReturn result
EndProcedure

If OpenWindow(0,0,0,600,400, "Popup-Menu Example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CreateMenu(0, WindowID(0))
    MenuTitle("File")
      MenuItem( 1, "&Load...")
      MenuItem( 2, "Save")
      MenuItem( 3, "Save As...")
      MenuBar()
      OpenSubMenu("Recents")
        MenuItem( 5, "Pure.png")
        MenuItem( 6, "Basic.jpg")
        OpenSubMenu("Even more !")
          MenuItem( 12, "Yeah")
        CloseSubMenu()
        MenuItem( 13, "Rocks.tga")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "&Quit")

    MenuTitle("Edition")
      MenuItem( 8, "Cut")
      MenuItem( 9, "Copy")
      MenuItem(10, "Paste")
      
    MenuTitle("?")
      MenuItem(11, "About")

  CreatePopupMenu(1)     
      MenuItem(14, "Pop # 1 Open")     
      MenuItem(15, "Pop # 1 End") 
      
  CreatePopupMenu(2)     
      MenuItem(16, "Pop # 2 Open")     
      MenuItem(17, "Pop # 2 End")           

 SetWindowCallback(@WinCallback())
 
Repeat
  Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
            Quit = 1
            
      Case #PB_Event_Menu   
        Select EventMenu()
            Case 1 : Debug " Item # 1"           
     
        EndSelect
        ActMenu = 0
  EndSelect
Until Quit = 1
  EndIf

[jassing]

Rashad -- nice as always, but after the 3rd popup, if I right click; it errors out, vs just ignoring the click.

[RASHAD]

Hi jassing
Good point
Fix code

Code: Select all

Procedure WinCallback(hwnd, uMsg, wParam, lParam)
   Result = #PB_ProcessPureBasicEvents
   Select uMsg
    Case #WM_INITMENUPOPUP
            If lParam = 1 Or lParam = 2
               ActMenu = 0
            EndIf
            ActMenu + 1
                             
    Case #WM_MENURBUTTONUP
          If ActMenu < 3
            GetCursorPos_(p.POINT)
            Item = TrackPopupMenuEx_(MenuID(ActMenu),#TPM_RECURSE|#TPM_RETURNCMD,p\x,p\y,WindowID(0),0)
            Select Item
                Case 14
                      Debug "PopMenu # 1: Open"
                Case 15
                      Debug "PopMenu # 1: End"
                Case 16
                      Debug "PopMenu # 2: Open"
                Case 17
                      Debug "PopMenu # 2: End"
            EndSelect
            ActMenu = 0             
            SetCursorPos_(WindowX(0)+30,WindowY(0)+10)
            LeftClick()
            SetCursorPos_(p\x,p\y)
          EndIf
  EndSelect
  ProcedureReturn result
EndProcedure

[jassing]

As always, you're spot on! Thanks for that -- I have no need but can see it as a slick thing to have in toolbox.

[Kwai chang caine]

Cool idea..thanks RASHAD