Oxygen Basic
Programming => Example Code => Topic started by: Frankolinox on February 04, 2014, 10:02:50 AM
-
here's a working version of a menu demo with right click :) the trick is to desactivate a certain line, see in wndproc part..
'
' 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
.
-
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:
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
.
-
thank you charles for your correction..
here's the complete win api "menu rightclick demo", place it in: example/winGUI folder :)
'
' 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...
.
-
Thanks for a very nice demo.
There is much for me to learn from it.