Skip to content

Instantly share code, notes, and snippets.

@CarlTBarnes
Last active April 13, 2021 03:09
Show Gist options
  • Save CarlTBarnes/e2902bb0280fe25554aa67b2e9292c51 to your computer and use it in GitHub Desktop.
Save CarlTBarnes/e2902bb0280fe25554aa67b2e9292c51 to your computer and use it in GitHub Desktop.
Menu Open Message WM_INITMENU to modify menus before opening
!Often right when Menus are being opened you want to change the Menus
!based on the other variables and things.
!Simple example of SubClass Window to get a WM_INITMENU Message before Menus display
!This adds Time to an Item text to show it changing at time it opens
!It also adds Time when closed, you get a Message when window close also WM_EXITMENULOOP
PROGRAM
INCLUDE 'TplEqu.CLW'
INCLUDE 'KeyCodes.CLW'
MAP
MenuOpenTest PROCEDURE()
DB PROCEDURE(STRING DebugMessage)
DBClear PROCEDURE() !Clear DebugView Buffer
MODULE('RTL')
ClaFieldNameRTL PROCEDURE(LONG pFEQ),CSTRING,RAW,NAME('Cla$FIELDNAME'),DLL(dll_mode)
ClaEventNameRTL PROCEDURE(LONG EventPlusA000h),*CSTRING,RAW,NAME('WslDebug$MsgName'),DLL(dll_mode)
END
MODULE('api')
CallWindowProc(LONG lpPrevWndProc,UNSIGNED hWnd,UNSIGNED MsgNo,UNSIGNED wParam,LONG lParam),LONG,RAW,PASCAL,NAME('CallWindowProcA'),DLL(1)
OutputDebugString(*CSTRING cMsg),PASCAL,DLL(1),RAW,NAME('OutputDebugStringA')
GetLastError(),LONG,PASCAL,DLL(1)
END
END
CODE
MenuOpenTest()
RETURN
!----------------------------
MenuOpenTest PROCEDURE
MAP
SubClassMain PROCEDURE(UNSIGNED hWnd,UNSIGNED Msg,UNSIGNED wParam,LONG lParam),LONG,PASCAL
END
LongStack LONG !A Local STACK variable CANNOT be accessed in Subclass Call Back
LongThread LONG,THREAD !This Thread variable CAN be accessed in Subclass Call Back
Window WINDOW('Menu Open Hook'),AT(,,254,138),CENTER,GRAY,IMM,SYSTEM,STATUS,FONT('Segoe UI',9),RESIZE
MENUBAR,USE(?MENUBAR1)
MENU('&Menu1'),USE(?Menu1)
ITEM('Item 1'),USE(?Menu1Item1)
ITEM('Item 2'),USE(?Menu1Item2)
ITEM(''),SEPARATOR,USE(?SEPARATOR1)
MENU('Print Sub Menu'),USE(?Menu1PrintSubMenu)
ITEM('&Print...<9>Ctrl+P'),USE(?PrintPrint)
ITEM('Printer Set&up...'),USE(?PrintPrinterSetup)
ITEM('Page &Layout...'),USE(?PrintPageLayout)
ITEM('Print Pre&view'),USE(?PrintPreview)
END
ITEM('Item 3'),USE(?Menu1Item3)
ITEM('Item 4'),USE(?Menu1Item4)
END
MENU('&SheetMenu'),USE(?SheeMenu)
ITEM('Tab 1 Sub Menu'),USE(?SheeMenuTab1),DISABLE
ITEM('Tab 2 Sub Menu'),USE(?SheeMenuTab2),DISABLE
ITEM('Tab 3 Sub Menu'),USE(?SheeMenuTab3),DISABLE
END
END
SHEET,AT(117,18,133,40),USE(?SHEET1)
TAB('Tab 1'),USE(?TAB1)
END
TAB('Tab 2'),USE(?TAB2)
END
TAB('Tab 3'),USE(?TAB3)
END
END
STRING('Sheet Menu items Enable based on Tab'),AT(123,38),USE(?STRING1)
CHECK('Print Menu Disabled '),AT(4,54),USE(?PrintDisabled)
BUTTON('Popup Menu'),AT(4,74),USE(?PopupBtn),TIP('Will this get Menu Events?')
END
Prior_WndProc LONG,STATIC !WndProc Must be Static
CODE
LongThread=1001
DBClear() ; DB('Menu Open Event Test')
OPEN(WINDOW)
display !; message('before subclass')
Prior_WndProc = Window{PROP:WndProc}
Window{PROP:WndProc}=ADDRESS(SubClassMain)
0{PROP:text}=clip(0{PROP:text}) &' - Library ' & system{PROP:LibVersion,2} &'.'& system{PROP:LibVersion,3}
ACCEPT
CASE EVENT()
OF EVENT:OpenWindow
OF EVENT:CloseWindow
OF EVENT:PreAlertKey
OF EVENT:AlertKey
OF EVENT:Timer
END
CASE ACCEPTED()
OF ?PopupBtn ; p#=POPUP('One|Two|Three')
END
CASE FIELD()
END
END
CLOSE(WINDOW)
!==========================================================================
!SubClassMain is in the Local Map so has scope of the Proceduure symbols.
!Local Variables are on the Stack and are not going to work in this Call Back
!Define Thread, Static, Module, Global variables.
!Window properties can also work like new {'User Defined'} added in C10
!Or Windows API Props
!The FEQ ?symbols are simply long number constants so they work
SubClassMain PROCEDURE(UNSIGNED hWnd,UNSIGNED MsgNo,UNSIGNED wParam,LONG lParam)!,LONG,PASCAL
WM_ENTERMENULOOP EQUATE(0211h) !1st message when menus open. Called w/o W/L parms
WM_INITMENU EQUATE(0116h) !next, passes wParam as hMenu to menubar http://msdn.microsoft.com/en-us/library/ms646344(VS.85).aspx
WM_INITMENUPOPUP EQUATE(0117h) !next, passed hSubMenu to menu activated http://msdn.microsoft.com/en-us/library/ms646347(VS.85).aspx
WM_EXITMENULOOP EQUATE(0212h) !last message menus closing.
CODE
CASE MsgNo
!Notifies an application's main window procedure that a menu modal loop has been entered
OF WM_ENTERMENULOOP ; db('SubClassMain WM_ENTERMENULOOP wParam=' & wParam & ' lParam=' & lParam )
!Called when menus are about to open
!wParam=True if TrackPopupMenu i.e. Popup() Menu. Not sure if see
!------------------------------------------------------------------------------
!This message comes once for the first menu click, it passes wParm as the Menu Bar handle
!Sent when a menu is about to become active. It occurs when the user clicks an
!item on the menu bar or presses a menu key. This allows the application to
!modify the menu before it is displayed.
!wParam - A handle to the menu to be initialized.
OF WM_INITMENU ; db('SubClassMain WM_INITMENU wParam=' & wParam & ' lParam=' & lParam )
?Menu1Item1{PROP:Text}='Menu Opened ' & FORMAT(CLOCK(),@t4) |
&' - LT#'& LongThread
LongThread + =1
! LongStack += 1 This will hang or crash
?Menu1PrintSubMenu{PROP:Disable}=?PrintDisabled{PROP:Checked}
DISABLE(?SheeMenuTab1,?SheeMenuTab3)
CASE ?SHEET1{PROP:ChoiceFEQ}
OF ?Tab1 ; Enable(?SheeMenuTab1)
OF ?Tab2 ; Enable(?SheeMenuTab2)
OF ?Tab3 ; Enable(?SheeMenuTab3)
END
!------------------------------------------------------------------------------
!Each menu accessed passed hSubMenu to menu activated
OF WM_INITMENUPOPUP ; db('SubClassMain WM_INITMENUPOPUP wParam=' & wParam & ' lParam=' & lParam )
!------------------------------------------------------------------------------
!Menus Closing - Notifies an application's main window procedure that a menu modal loop has been exited.
OF WM_EXITMENULOOP ; db('SubClassMain WM_EXITMENULOOP wParam=' & wParam & ' lParam=' & lParam )
?Menu1Item4{PROP:Text}='Last Closed ' & FORMAT(CLOCK(),@t4)
END
RETURN(CallWindowProc(Prior_WndProc,hWnd,MsgNo,wParam,lParam))
!===============================
DB PROCEDURE(STRING xMessage)
Prfx EQUATE('MenuOpen: ')
sz CSTRING(SIZE(Prfx)+SIZE(xMessage)+1),AUTO
CODE
sz = Prfx & CLIP(xMessage)
OutputDebugString( sz )
!------------------
DBClear PROCEDURE()
DbgClear CSTRING('DBGVIEWCLEAR') !Message to Clear the buffer. Must UPPER and first i.e. without a Prefix
CODE
OutputDebugString(DbgClear) !Cannot have Prefix, must be first .. so call API directly
!Windows Menu API Functions
MENUITEMINFO GROUP,TYPE !http://msdn.microsoft.com/en-us/library/ms647578(VS.85).aspx
cbSize UNSIGNED !Size of structure, in bytes. Caller must = size(MENUITEMINFO)
fMask UNSIGNED !Mask of Members to retrieve or set. MIIM_XXXX equates MIIM_STATE MIIM_TYPE MIIM_FTYPE
fType UNSIGNED !Menu item type MFT_XXXX some require fMask to be MIIM_FTYPE
fState UNSIGNED !Menu item state MFS_CHECKED MFS_DISABLED+MFS_GRAYED MFS_ENABLED
wID UNSIGNED !Application-defined 16-bit value that identifies the menu item. Set fMask to MIIM_ID to use wID.
hSubMenu UNSIGNED !Handle to the drop-down menu or submenu associated with the menu item. Null if not a SubMenu
hBmpChecked UNSIGNED !Handle to the bitmap to display next to the item if it is selected.
hBmpUnchecked UNSIGNED !Handle to the bitmap to display next to the item if it is not selected.
dwItemData ULONG !Application-defined value associated with the menu item. Set fMask to MIIM_DATA to use dwItemData.
dwTypeData LONG !Content of the menu item. The meaning of this member depends on the value of fType and is used only if the MIIM_TYPE flag is set in the fMask member.
cch UNSIGNED !Length of menu item text in TCHARs, for menu item of the MFT_STRING type, only used if fMask=MIIM_TYPE
hBmpItem UNSIGNED !Handle to the bitmap to be displayed
END
WM_ENTERMENULOOP EQUATE(0211h) !1st message,once, wParm=1 if TrackPopupMenu i.e. POPUP() http://msdn.microsoft.com/en-us/library/ms647595(VS.85).aspx
! The WM_ENTERMENULOOP message informs an application's main window procedure that a menu modal loop has been entered.
WM_INITMENU EQUATE(0116h) !next,once, passes wParam as hMenu to menubar http://msdn.microsoft.com/en-us/library/ms646344(VS.85).aspx
! The WM_INITMENU message is sent when a menu is about to become active. It occurs when the user clicks an item on the menu bar or presses a menu key. This allows the application to modify the menu before it is displayed.
WM_INITMENUPOPUP EQUATE(0117h) !next,each, passed hSubMenu to menu activated http://msdn.microsoft.com/en-us/library/ms646347(VS.85).aspx
WM_EXITMENULOOP EQUATE(0212h) !last message,once
MF_UNCHECKED EQUATE(00000000h) !MF_UNCHECKED 0x00000000L
MF_CHECKED EQUATE(00000008h) !MF_CHECKED 0x00000008L
MF_BYCOMMAND EQUATE(00000000h) !MF_BYCOMMAND 0x00000000L
MF_BYPOSITION EQUATE(00000400h) !MF_BYPOSITION 0x00000400L
MF_SEPARATOR EQUATE(00000800h) !MF_SEPARATOR 0x00000800L
MF_ENABLED EQUATE(00000000h) !MF_ENABLED 0x00000000L
MF_GRAYED EQUATE(00000001h) !MF_GRAYED 0x00000001L
MF_DISABLED EQUATE(00000002h) !MF_DISABLED 0x00000002L
MF_USECHECKBITMAPS EQUATE(00000200h) !MF_USECHECKBITMAPS 0x00000200L
MF_STRING EQUATE(00000000h) !MF_STRING 0x00000000L
MF_BITMAP EQUATE(00000004h) !MF_BITMAP 0x00000004L
MF_OWNERDRAW EQUATE(00000100h) !MF_OWNERDRAW 0x00000100L
MF_POPUP EQUATE(00000010h) !MF_POPUP 0x00000010L
MF_MENUBARBREAK EQUATE(00000020h) !Puts menu item in a new column, or on new line (for a menu bar). A vertical line separates the new column from the old.
MF_MENUBREAK EQUATE(00000040h) !same as MF_MENUBARBREAK without Vert BAR
MF_UNHILITE EQUATE(00000000h) !MF_UNHILITE 0x00000000L
MF_HILITE EQUATE(00000080h) !MF_HILITE 0x00000080L
MF_DEFAULT EQUATE(00001000h) !MF_DEFAULT 0x00001000L
MF_SYSMENU EQUATE(00002000h) !MF_SYSMENU 0x00002000L
MF_HELP EQUATE(00004000h) !MF_HELP 0x00004000L
MF_RIGHTJUSTIFY EQUATE(00004000h) !MF_RIGHTJUSTIFY 0x00004000L
MF_MOUSESELECT EQUATE(00008000h) !MF_MOUSESELECT 0x00008000L
MFT_STRING EQUATE(MF_STRING) !MFT_STRING MF_STRING
MFT_BITMAP EQUATE(MF_BITMAP) !MFT_BITMAP MF_BITMAP
MFT_MENUBARBREAK EQUATE(MF_MENUBARBREAK) !MFT_MENUBARBREAK MF_MENUBARBREAK
MFT_MENUBREAK EQUATE(MF_MENUBREAK) !MFT_MENUBREAK MF_MENUBREAK
MFT_OWNERDRAW EQUATE(MF_OWNERDRAW) !MFT_OWNERDRAW MF_OWNERDRAW
MFT_RADIOCHECK EQUATE(00000200h) !MFT_RADIOCHECK 0x00000200L
MFT_SEPARATOR EQUATE(MF_SEPARATOR) !MFT_SEPARATOR MF_SEPARATOR
MFT_RIGHTORDER EQUATE(00002000h) !MFT_RIGHTORDER 0x00002000L
MFT_RIGHTJUSTIFY EQUATE(MF_RIGHTJUSTIFY) !MFT_RIGHTJUSTIFY MF_RIGHTJUSTIFY
! Menu flags for Add/Check/EnableMenuItem() */
MFS_GRAYED EQUATE(00000003h) !MFS_GRAYED 0x00000003L
MFS_DISABLED EQUATE(MFS_GRAYED) !MFS_DISABLED MFS_GRAYED
MFS_CHECKED EQUATE(MF_CHECKED) !MFS_CHECKED MF_CHECKED
MFS_HILITE EQUATE(MF_HILITE) !MFS_HILITE MF_HILITE
MFS_ENABLED EQUATE(MF_ENABLED) !MFS_ENABLED MF_ENABLED
MFS_UNCHECKED EQUATE(MF_UNCHECKED) !MFS_UNCHECKED MF_UNCHECKED
MFS_UNHILITE EQUATE(MF_UNHILITE) !MFS_UNHILITE MF_UNHILITE
MFS_DEFAULT EQUATE(MF_DEFAULT) !MFS_DEFAULT MF_DEFAULT
MIIM_STATE EQUATE(00000001h) !MIIM_STATE 0x00000001
MIIM_ID EQUATE(00000002h) !MIIM_ID 0x00000002
MIIM_SUBMENU EQUATE(00000004h) !MIIM_SUBMENU 0x00000004
MIIM_CHECKMARKS EQUATE(00000008h) !MIIM_CHECKMARKS 0x00000008
MIIM_TYPE EQUATE(00000010h) !MIIM_TYPE 0x00000010
MIIM_DATA EQUATE(00000020h) !MIIM_DATA 0x00000020 Win9x way to get Menu String :(
MIIM_STRING EQUATE(00000040h) !MIIM_STRING 0x00000040 #if(WINVER >= 0x0500) i.e. Win2K !
MIIM_BITMAP EQUATE(00000080h) !MIIM_BITMAP 0x00000080 #if(WINVER >= 0x0500)
MIIM_FTYPE EQUATE(00000100h) !MIIM_FTYPE 0x00000100 #if(WINVER >= 0x0500)
MAP
module('api')
! GetlastError(),SIGNED,PASCAL,DLL(1)
GetMenu(SIGNED HWND),SIGNED,PASCAL,DLL(1) !returns hMenu
GetSubMenu(SIGNED HMENU, SIGNED nPos),SIGNED,PASCAL,DLL(1) !returns hMenu to Submenu
IsMenu(SIGNED HMenu),BOOL,PASCAL,DLL(1) !The IsMenu function determines whether a handle is a menu handle.
GetMenuItemCount(SIGNED hMenu),SIGNED,PASCAL,DLL(1) !returns no of items, -1 = failed then GetLastError
GetMenuItemID(SIGNED hMenu, SIGNED nPos),UNSIGNED,PASCAL,DLL(1) !ID of menu Item
CheckMenuItem(SIGNED hMenu, UNSIGNED uIDCheckItem, UNSIGNED uCheck),PASCAL,RAW,SIGNED,DLL(1) !,name('CheckMenuItemA')
GetMenuString(SIGNED hMenu, UNSIGNED uIDItem, *CSTRING lpString, UNSIGNED nMaxCount, UNSIGNED uFlag),SIGNED,PROC,PASCAL,DLL(1),RAW,NAME('GetMenuStringA')
GetMenuItemInfo(SIGNED hMenu, UnSIGNED uItem, BOOL fByPosition=0, LONG InOutLPMENUITEMINFO),BOOL,PASCAL,DLL(1),RAW,NAME('GetMenuItemInfoA') !0=failed then getlasterror()
SetMenuItemInfo(SIGNED hMenu, UnSIGNED uItem, BOOL fByPosition=0, LONG InOutLPMENUITEMINFO),BOOL,PASCAL,DLL(1),RAW,NAME('SetMenuItemInfoA') !0=failed then getlasterror()
DrawMenuBar(SIGNED hndWnd2redraw),BOOL,PROC,PASCAL,DLL(1) !If menu BAR changes after Window created this function must be called to draw the changed menu bar.
GetSystemMenu(SIGNED HWND, BOOL bRevert=0),SIGNED,PASCAL,DLL(1) !returns hMenu to System Menu
DestroyMenu(SIGNED hMenu),BOOL,PASCAL,DLL(1) !0=failed
CallWindowProc(LONG lpPrevWndProc,UNSIGNED hWnd,UNSIGNED MsgNo,UNSIGNED wParam,LONG lParam),LONG,RAW,PASCAL,NAME('CallWindowProcA'),DLL(1)
!SubClassMain PROCEDURE(UNSIGNED hWnd,UNSIGNED Msg,UNSIGNED wParam,LONG lParam),LONG,PASCAL
end
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment