MenuDemo rightclick :)

[Frankolinox]

here's a working version of a menu demo with right click the trick is to desactivate a certain line, see in wndproc part..

Code: [Select]

 '
  ' MenuDemo with right click PopupMenu for oxygen by frankolinox 4.2.2014 :)
  '
  $ filename "t.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  ''include   "WinUtil.inc"
  include "minwin.inc"

  Type RECT
    long Left  
    long Top    
    long Right  
    long Bottom
  End Type
  type POINT
    long x
    long y
  end type
  TYPE POINTAPI
    long x
    long y
  END TYPE

%WM_CONTEXTMENU      = &H007B???
%TPM_LEFTBUTTON      = &H0000???
%TPM_RIGHTBUTTON     = &H0002???
%WM_RBUTTONUP        = &H0205???
%TPM_LEFTBUTTON      = &H0000???
%TPM_RIGHTBUTTON     = &H0002???
%TPM_LEFTALIGN       = &H0000???

DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" ( _
   BYVAL hWnd AS SYS _                                
 , BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" ( _
   BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

DECLARE FUNCTION ClientToScreen LIB "USER32.DLL" ALIAS "ClientToScreen" ( _
   BYVAL hWnd AS SYS _                                ' __in HWND hWnd
 , BYREF lpPoint AS POINT _                             ' __inout LPPOINT lpPoint
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION TrackPopupMenu LIB "USER32.DLL" ALIAS "TrackPopupMenu" ( _
   BYVAL hMenu AS SYS _                               ' __in HMENU hMenu
 , BYVAL uFlags AS SYS _                              ' __in UINT uFlags
 , BYVAL x AS LONG _                                    ' __in int x
 , BYVAL y AS LONG _                                    ' __in int y
 , BYVAL nReserved AS LONG _                            ' __in int nReserved
 , BYVAL hWnd AS SYS _                                ' __in HWND hWnd
 , OPTIONAL BYREF prcRect AS RECT _                     ' __in_opt CONST RECT *prcRect
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION CreateMenu LIB "USER32.DLL" ALIAS "CreateMenu" ( _
 ) AS LONG                                             ' HMENU

DECLARE FUNCTION GetMenu LIB "USER32.DLL" ALIAS "GetMenu" ( _
   BYVAL hWnd AS LONG _                                ' __in HWND hWnd
 ) AS LONG                                             ' HMENU

DECLARE FUNCTION LoadMenuA LIB "USER32.DLL" ALIAS "LoadMenuA" ( _
   BYVAL hInstance AS SYS _                           ' __in_opt HINSTANCE hInstance
 , BYREF lpMenuName AS ASCIIZ _                         ' __in LPCSTR lpMenuName
 ) AS DWORD                                             ' HMENU

DECLARE FUNCTION GetSubMenu LIB "USER32.DLL" ALIAS "GetSubMenu" ( _
   BYVAL hMenu AS SYS _                               ' __in HMENU hMenu
 , BYVAL nPos AS LONG _                                 ' __in int nPos
 ) AS SYS                                             ' HMENU

DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" ( _
   BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

  function WndProc ( hWnd, wMsg, wParam, lparam ) as sys callback
  '==============================================================

  'MENU ITEMS
  '
  %IDM_FILE_NEW     40001
  %IDM_FILE_OPEN    40002
  %IDM_FILE_SAVE    40003
  %IDM_FILE_SAVE_AS 40004
  %IDM_APP_EXIT     40005
  %IDM_EDIT_UNDO    40006
  %IDM_EDIT_CUT     40007
  %IDM_EDIT_COPY    40008
  %IDM_EDIT_PASTE   40009
  %IDM_EDIT_CLEAR   40010
  %IDM_APP_HELP     40011
  %IDM_APP_ABOUT    40012
  '
  static as sys hGraphics
  static sys hdc,hMenu,hMenuPopup,dis,hPopup
  static String txt,szAppName
  static rect crect
  static PaintStruct Paintst
  sys id,hInst
  static as sys hGraphic
  POINT pt  
  '
  select wMsg
  '==========
      
  case WM_CREATE
  hMenu = LoadMenuA(hMenu, szAppName)
  hMenu = GetSubMenu(hInst, 0)
  
  hMenu = CreateMenu  
  hMenuPopup = CreateMenu  
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_NEW,     "&New"
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_OPEN,    "&Open..."
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_SAVE,    "&Save"
  AppendMenu hMenuPopup, MF_STRING,    IDM_FILE_SAVE_AS, "Save &As..."
  AppendMenu hMenuPopup, MF_SEPARATOR, 0,                null
  AppendMenu hMenuPopup, MF_STRING,    IDM_APP_EXIT,     "E&xit"
  AppendMenu hMenu,      MF_POPUP,     hMenuPopup,       "&File"

  hMenuPopup = CreateMenu
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_UNDO,    "&Undo"
  AppendMenu hMenuPopup, MF_SEPARATOR, 0,                null
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_CUT,     "Cu&t"
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_COPY,    "&Copy"
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_PASTE,   "&Paste"
  AppendMenu hMenuPopup, MF_STRING,    IDM_EDIT_CLEAR,   "De&lete"
  AppendMenu hMenu,      MF_POPUP,     hMenuPopup,       "&Edit"

  hMenuPopup = CreateMenu
  AppendMenu hMenuPopup, MF_STRING,    IDM_APP_HELP,     "&Help"
  AppendMenu hMenuPopup, MF_STRING,    IDM_APP_ABOUT,    "&About MenuDemo..."
  AppendMenu hMenu,      MF_POPUP,     hMenuPopup,       "&Help"
  
  hMenu = GetSubMenu(hMenu, 0)
  '
  szAppName="Menu Demo_rightClick popup"
  ''-------------------------- thats the trick ! ---------------- //
  ''SetMenu       hwnd, hMenu  ' desactivate this line
  ''-------------------------- thats the trick ! ---------------- //
  
  SetWindowText hwnd,szAppName
  '
  'sys dis=MF_DISABLED or MF_GRAYED
  CheckMenuItem hMenu,IDM_FILE_NEW, MF_CHECKED
  EnableMenuItem hMenu,IDM_FILE_OPEN,dis
      
  case WM_COMMAND

  ''hMenu = GetMenu(hwnd)
  if wparam = %IDM_APP_EXIT THEN        
    'print "exit"
    SendMessage hwnd, WM_CLOSE, 0, 0
  end if
  
  '-------------------
    case %WM_LBUTTONDOWN      
    '===================
        GetCursorPos pt              
        ScreenToClient (hGraphic, pt)  
        print "here lButton: " + str(pt.x) + "," + str(pt.y)

'-------------- new part right-click-popup menu ----------------------------- //
      CASE %WM_RBUTTONUP
         pt.x = (LOWORD(lParam))        
         pt.y = (HIWORD( lParam))        
         ClientToScreen( hGraphics, pt)
         TrackPopupMenu(hMenu, %TPM_LEFTALIGN OR %TPM_LEFTBUTTON OR %TPM_RIGHTBUTTON, pt.x, pt.y, 0, hwnd, NULL) 'BYVAL %NULL        
  '-------------- new part right-click-popup menu ----------------------------- //        

  case WM_DESTROY
  '
  PostQuitMessage 0

  case WM_KEYDOWN

    Select wParam
    Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE
    End Select
      
  case else
  '
  function=DefWindowProc hWnd,wMsg,wParam,lParam
  '
  end select
  end function

  Function MainWindows(sys width,height,style)
  ===========================================
  '
  sys      a,b,c,hWnd
  WNDCLASS wc
  MSG      wm
  '
  inst=GetModuleHandle 0
  '
  with wc.                 '
    style=CS_HREDRAW or CS_VREDRAW
    lpfnWndProc   = @wndproc
    cbClsExtra    = 0
    cbWndExtra    = 0    
    hInstance     = inst
    hIcon         = LoadIcon 0, IDI_APPLICATION
    hCursor       = LoadCursor 0,IDC_ARROW
    hbrBackground = GetStockObject WHITE_BRUSH '
    lpszMenuName  = 0
    lpszClassName = strptr "wins"
  end with

  if not RegisterClass @wc
    MessageBox 0,"Registration failed","Problem",MB_ICONERROR
    exit function
  end if

  'Create the main window.
  hwnd = CreateWindowEx(
    0,                      'no extended styles          
    "wins",                 'class name                  
    "Main Window",          'window name  
    style,                  '                
    CW_USEDEFAULT,          'default horizontal position  
    CW_USEDEFAULT,          'default vertical position    
    width,                  'default width                
    height,                 'default height              
    null,                   'no parent or owner window    
    null,                   'class menu used              
    inst,                   'instance handle              
    null);                  'no window creation data      
  if not hWnd then
    MessageBox 0,"Unable to create window","problem",MB_ICONERROR
    exit function
  end if
  '
    sys hMenu,hMenuPopup,hSysMenu
  ''hSysMenu = GetSystemMenu(hWndFrame, FALSE)  
  
  ShowWindow hWnd,SW_NORMAL
  UpdateWindow hWnd
  '
  'MESSAGE LOOP
  '============
  '
  sys bRet
  '
  while bRet := GetMessage @wm, 0, 0, 0
    if bRet == -1 then
      'show an error message?
    else
      #ifdef EscapeKeyEnd
      if wm.message=WM_KEYDOWN
        if wm.wparam=27
          SendMessage hwnd,WM_DESTROY,0,0
        end if  
      end if
      #endif
      #ifdef RelayMessages
      m=wm.message
      select m
      '
      case WM_LBUTTONDBLCLK
      =====================
        '
        SendMessage hwnd,WM_COMMAND,1100-0x200+m, 0
        '
      case WM_KEYDOWN
      ===============
        '
        m=wm.wparam
        select m
        case VK_RETURN
          for i=1 to nchw
            if wm.hwnd=hchw(i)
              SendMessage hwnd,WM_COMMAND,2000+VK_RETURN,0
              if i>1 then continue while 'first window is editor
            end if
          next
        case VK_F1 to VK_F10
          SendMessage hwnd,WM_COMMAND,1001+m-VK_F1, 0
        case "A" to "Z"
          if CtrlKey
            SendMessage hwnd,WM_COMMAND,2000+m, 0
            if m=65 or m=70 or m=71 then continue while
          end if
        case VK_ESCAPE
          SendMessage hwnd,WM_COMMAND,2200+VK_ESCAPE, 0
          Continue do
        end select
        '
      end select
      '
      #endif
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  wend
  '
  end function ; end of WinMain

  MainWindows 420,300,WS_OVERLAPPEDWINDOW
new edit:

you can right-click with mouse so you can see the popup menu. that wasn't so easy to handle, but for my purpose that was a success

best regards, frank

.

[Charles Pegge]

Thanks Frank,

I used your example to create a cascading popup menu, and fixed the menu placement, so it always appears at the cursor position

Here it is in a replacement WndProc:

Code: [Select]

  function WndProc( hWnd, wMsg, wParam, lparam ) as sys, callback
  '==============================================================

  '
  static sys         hdc,hMenu,hMenuPopup,hCursorMenu
  static String      txt,szAppName
  static rect        crect
  static POINT       pt 
  static PaintStruct Paintst
  sys id,hInst
  static sys hGraphic
  '
  select wMsg
  '==========
     
  case WM_CREATE
  '
  szAppName="Menu Demo_rightClick popup"
  '
  SetWindowText hwnd,szAppName
  '
  hMenu = CreateMenu 
  hMenuPopup = CreateMenu 
  hMenuPopup1= CreateMenu 
  AppendMenu hMenuPopup1,  MF_STRING,    4011,        "Red"
  AppendMenu hMenuPopup1,  MF_STRING,    4012,        "Green"
  AppendMenu hMenuPopup1,  MF_STRING,    4013,        "Blue"
  AppendMenu hMenuPopup ,MF_POPUP,       hMenuPopup1, "&Colors"
  '
  hMenuPopup1= CreateMenu 
  AppendMenu hMenuPopup1,  MF_STRING,    4021,        "Sphere"
  AppendMenu hMenuPopup1,  MF_STRING,    4022,        "Cube"
  AppendMenu hMenuPopup1,  MF_STRING,    4023,        "Cone"
  AppendMenu hMenuPopup1,  MF_STRING,    4024,        "Cylinder"
  AppendMenu hMenuPopup ,MF_POPUP,       hMenuPopup1, "&Shapes"

  AppendMenu hMenuPopup ,  MF_SEPARATOR, 0,            null
  AppendMenu hMenuPopup ,  MF_STRING,    4005,        "E&xit"
  '
  AppendMenu   hMenu,     MF_POPUP,     hMenuPopup,  "&Objects"
  '
  CheckMenuItem  hMenu,4022, MF_CHECKED
  EnableMenuItem hMenu,4024, MF_DISABLED or MF_GRAYED
  '
  hCursorMenu = GetSubMenu(hMenu, 0)
     
  case WM_COMMAND

  if wparam = 4005 then 'Exit       
    SendMessage hwnd, WM_CLOSE, 0, 0
  end if
 
  case %WM_LBUTTONDOWN     
    GetCursorPos pt             
    ScreenToClient (hWnd, pt) 
    print "here lButton: " + str(pt.x) + "," + str(pt.y)

  case %WM_RBUTTONDOWN
    GetCursorPos pt             
    TrackPopupMenu(hCursorMenu, %TPM_LEFTALIGN OR %TPM_LEFTBUTTON OR %TPM_RIGHTBUTTON, pt.x, pt.y, 0, hwnd, NULL) 'BYVAL %NULL         

  case WM_DESTROY
  '
  PostQuitMessage 0

  case WM_KEYDOWN

    Select wParam
    Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE
    End Select
     
  case else
  '
  function=DefWindowProc hWnd,wMsg,wParam,lParam
  '
  end select
  end function

.

[Frankolinox]

thank you charles for your correction..

here's the complete win api "menu rightclick demo", place it in: example/winGUI folder

Code: [Select]

 '
  ' menu example with rightclick menu by frankolinox, 7.02.14, oxygenbasic
  '
  $ filename "t.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  include   "WinUtil.inc"

  %TPM_LEFTBUTTON   0x0000
  %TPM_RIGHTBUTTON  0x0002
  %TPM_LEFTALIGN    0x0000

  extern lib "user32.dll"
  ! GetCursorPos (POINT *pt) as sys
  ! GetSubMenu   (sys hMenu,nPos) as sys
  
  DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" ( _
   BYVAL hWnd AS SYS _                                
 , BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" ( _
   BYREF lpPoint AS POINT _                            
 ) AS LONG                                              

DECLARE FUNCTION ClientToScreen LIB "USER32.DLL" ALIAS "ClientToScreen" ( _
   BYVAL hWnd AS SYS _                                ' __in HWND hWnd
 , BYREF lpPoint AS POINT _                             ' __inout LPPOINT lpPoint
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION TrackPopupMenu LIB "USER32.DLL" ALIAS "TrackPopupMenu" ( _
   BYVAL hMenu AS SYS _                               ' __in HMENU hMenu
 , BYVAL uFlags AS SYS _                              ' __in UINT uFlags
 , BYVAL x AS LONG _                                    ' __in int x
 , BYVAL y AS LONG _                                    ' __in int y
 , BYVAL nReserved AS LONG _                            ' __in int nReserved
 , BYVAL hWnd AS SYS _                                ' __in HWND hWnd
 , OPTIONAL BYREF prcRect AS RECT _                     ' __in_opt CONST RECT *prcRect
 ) AS LONG                                              ' BOOL

DECLARE FUNCTION CreateMenu LIB "USER32.DLL" ALIAS "CreateMenu" ( _
 ) AS LONG                                             ' HMENU

DECLARE FUNCTION GetMenu LIB "USER32.DLL" ALIAS "GetMenu" ( _
   BYVAL hWnd AS LONG _                                ' __in HWND hWnd
 ) AS LONG                                             ' HMENU

DECLARE FUNCTION LoadMenuA LIB "USER32.DLL" ALIAS "LoadMenuA" ( _
   BYVAL hInstance AS SYS _                           ' __in_opt HINSTANCE hInstance
 , BYREF lpMenuName AS ASCIIZ _                         ' __in LPCSTR lpMenuName
 ) AS DWORD                                             ' HMENU

DECLARE FUNCTION GetSubMenu LIB "USER32.DLL" ALIAS "GetSubMenu" ( _
   BYVAL hMenu AS SYS _                               ' __in HMENU hMenu
 , BYVAL nPos AS LONG _                                 ' __in int nPos
 ) AS SYS                                             ' HMENU

DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" ( _
   BYREF lpPoint AS POINT _                            
 ) AS LONG                                              


  end extern

  MainWindow 420,200,WS_OVERLAPPEDWINDOW

  function WndProc( hWnd, wMsg, wParam, lparam ) as sys, callback
  '==============================================================
  '
  static sys         hdc,hMenu,hMenuPopup,hCursorMenu
  static String      txt,szAppName
  static rect        crect
  static POINT       pt  
  static PaintStruct Paintst
  sys id,hInst
  static sys hGraphic
  '
  select wMsg
  '==========
      
  case WM_CREATE
  '
  szAppName="Menu Demo_rightClick popup"
  '
  SetWindowText hwnd,szAppName
  '
  hMenu = CreateMenu  
  hMenuPopup = CreateMenu  
  hMenuPopup1= CreateMenu  
  AppendMenu hMenuPopup1,  MF_STRING,    4011,        "Red"
  AppendMenu hMenuPopup1,  MF_STRING,    4012,        "Green"
  AppendMenu hMenuPopup1,  MF_STRING,    4013,        "Blue"
  AppendMenu hMenuPopup ,MF_POPUP,       hMenuPopup1, "&Colors"
  '
  hMenuPopup1= CreateMenu  
  AppendMenu hMenuPopup1,  MF_STRING,    4021,        "Sphere"
  AppendMenu hMenuPopup1,  MF_STRING,    4022,        "Cube"
  AppendMenu hMenuPopup1,  MF_STRING,    4023,        "Cone"
  AppendMenu hMenuPopup1,  MF_STRING,    4024,        "Cylinder"
  AppendMenu hMenuPopup ,MF_POPUP,       hMenuPopup1, "&Shapes"
  AppendMenu hMenuPopup ,  MF_SEPARATOR, 0,            null
  AppendMenu hMenuPopup ,  MF_STRING,    4005,        "E&xit"
  '
  AppendMenu   hMenu,     MF_POPUP,     hMenuPopup,  "&Objects"
  '
  CheckMenuItem  hMenu,4022, MF_CHECKED
  EnableMenuItem hMenu,4024, MF_DISABLED or MF_GRAYED
  '
  hCursorMenu = GetSubMenu(hMenu, 0)
      
  case WM_COMMAND
  if wparam = 4005 then 'Exit        
    SendMessage hwnd, WM_CLOSE, 0, 0
  end if
  
  case %WM_LBUTTONDOWN      
    GetCursorPos pt              
    ScreenToClient (hWnd, pt)  
    print "here lButton: " + str(pt.x) + "," + str(pt.y)
  case %WM_RBUTTONDOWN
    GetCursorPos pt              
    TrackPopupMenu(hCursorMenu, %TPM_LEFTALIGN OR %TPM_LEFTBUTTON OR %TPM_RIGHTBUTTON, pt.x, pt.y, 0, hwnd, NULL) 'BYVAL %NULL        
  case WM_DESTROY
  '
  PostQuitMessage 0
  case WM_KEYDOWN
    Select wParam
    Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE
    End Select
      
  case else
  '
  function=DefWindowProc hWnd,wMsg,wParam,lParam
  '
  end select
  end function
best regards, nice day, here's the sun is shining and will get warm wheather in our town at the afternoon, I enjoy it...

.

[Haim]

Thanks for a very nice demo.
There is much for me to learn from it.