DLG Menus

[Walt Decker]

The following code and .zip file demonstrates the use of WMLBCB.DLL to create menus after the fact on both dialog forms and window forms.

WMLBCB.DLL contains more functions than the doc contained in MENUS.ZIP; however, I do not have all the demos created for the additional functions.  When I get the demos finished I will update the .zip contained herein.

MENUS.ZIP contains:

WMLBCB_DOC.TXT

WMLBCB.DLL

MENU_000._BAS

'
'#########################################################
'  MENU_000._BAS
'  WALT DECKER, 28 JUNE 2022
'  RELEASED AS PUBLIC DOMAIN

'  DEPENDANCIES: WMLBCB.DLL
'  WALT DECKER, JUNE 2022
'  RELEASED AS SHARE-WARE 28 JUNE 2022
'
'  DEMONSTRATES: Menu functions contained in WMLBCB.DLL
'
'#########################################################

'NOMAINWIN

[DECLARE.GLOBALS]
GLOBAL MNU.Bar, _     '<--- menu id #s
      MNU.Click, _
      MNU.OpenDB, _
      MNU.OpenIMG, _
      MNU.NewDB, _
      MNU.NewIMG, _
      MNU.SaveDTA, _
      MNU.ModeLess, _
      MNU.Window

GLOBAL WinCount  '<--- used to determine if additional windows are active

[INIT.GLOBALS]
MNU.Bar     = 1000
MNU.Click   = 1050
MNU.OpenDB  = 2000
MNU.OpenIMG = 2001
MNU.NewDB   = 2002
MNU.NewIMG  = 2003
MNU.SaveDTA = 2004
MNU.ModeLess= 2005
MNU.Window  = 2006

DlgHndl = 0
RetVal  = 0

OPEN "kernel32.dll" FOR DLL AS #KERN
OPEN "WMLBCB" FOR DLL AS #LBCB

CALLBACK CODEPTR, FN.MenuCB(ULONG, ULONG, LONG, LONG), LONG

TEXTEDITOR #MNUTST.EDIT, 0, 0, 200, 200
BUTTON #MNUTST.BTNOK, "SUBMIT", BTN.SUBMIT, UL, 100, 220, 60, 25

OPEN "MENU TEST" FOR DIALOG_MODAL AS #MNUTST

PRINT #MNUTST, "TRAPCLOSE DMO.DONE"

RetVal = FN.CreateMenu()
DlgHndl = FN.GetHandle("#MNUTST")

CALLDLL #LBCB, "FN_InitMenu", _
           DlgHndl AS ULONG, _  '<--- handle of window with menu
         MNU.OpenDB AS LONG, _  '<--- lowest menu id number
         MNU.Window AS LONG, _  '<--- highest menu id number
           CODEPTR AS ULONG, _  '<--- code address of LB callback function
             RetVal AS LONG     '<--- RETURN: Non-zero on success

CALL SPINNER
WAIT

'---------------------------------------------
'---------------------------------------------

SUB SPINNER  '<--- this takes the place of LB's TIMER function
            'DO NOT substitute TIMER here
 [DO.AGAIN]
 SCAN
 CALLDLL #KERN, "Sleep", 50 AS LONG, RetVal AS VOID
 GOTO [DO.AGAIN]
END SUB

'---------------------------------------------
'---------------------------------------------

SUB DMO.DONE WinHndl$

IF WinCount THEN  '<--- check for additional forms
 IF (WinCount AND 2) THEN
   CALL DLG.CLOSE "#MDL"
 END IF
 IF (WinCount AND 5) THEN
   CALL CLOSE.WIN "#NWIN"
 END IF
END IF

'<-------- release this instance of WMLBCB.DLL ---------->
WinHndl = FN.GetHandle(WinHndl$)
CALLDLL #LBCB, "ReleaseMenu", WinHndl AS ULONG, RetVal AS VOID
CLOSE #KERN
CLOSE #LBCB  '<--- release WMLBCB.DLL
CLOSE #WinHndl$
END
END SUB

'---------------------------------------------
'---------------------------------------------

SUB DLG.CLOSE DlgHndl$

'<-------- release this instance of WMLBCB.DLL ---------->
WinHndl = FN.GetHandle(DlgHndl$)
CALLDLL #LBCB, "ReleaseMenu", WinHndl AS ULONG, RetVal AS VOID
CLOSE #DlgHndl$

WinCount = WinCount XOR 2 '<--- remove dialog form flag
END SUB

'---------------------------------------------
'---------------------------------------------

SUB CLOSE.WIN WinHndl$

'<-------- release this instance of WMLBCB.DLL ---------->
WinHndl = FN.GetHandle(WinHndl$)
CALLDLL #LBCB, "ReleaseMenu", WinHndl AS ULONG, RetVal AS VOID

CLOSE #WinHndl$
WinCount = WinCount XOR 5 '<--- remove window form flag
END SUB

'---------------------------------------------
'---------------------------------------------

SUB BTN.SUBMIT BtnHndl$
'<---------- do whatever here -------->
PRINT "SUBMIT"
END SUB

'---------------------------------------------
'---------------------------------------------

FUNCTION FN.CheckTag$(Tag$)

IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$

FN.CheckTag$ = Tag$
END FUNCTION

'---------------------------------------------
'---------------------------------------------

FUNCTION FN.GetHandle(WinTag$)

Hndl = 0

WinTag$ = FN.CheckTag$(WinTag$)

Hndl = HWND(#WinTag$)

FN.GetHandle = Hndl
END FUNCTION

'---------------------------------------------
'---------------------------------------------

FUNCTION FN.CreateMenu()

MF.ENABLED     = HEXDEC("&H00000000") '<--- Make item selectable
MF.GRAYED      = HEXDEC("&H00000001") '<--- disable item and display it gray
MF.DISABLED    = HEXDEC("&H00000002") '<--- disable item

MF.UNCHECKED   = HEXDEC("&H00000000") '<--- uncheck item if it is checked
MF.CHECKED     = HEXDEC("&H00000008") '<--- check item if it is not checked

MF.ENCHECKED = MF.ENABLED OR MF.CHECKED

'NOTE:  MF.ENABLED and MF.CHECKED/MF.UNCHECKED must be combined to make a
'       menu item both enabled and checked or unchecked.

MnuHndl = 0  '<--- handle of menu bar
PopUp1  = 0  '<--- sub-menu item handles.  THESE ARE NOT ITEM ID NUMBERS
PopUp2  = 0
PopUp3  = 0

CALLDLL #LBCB, "FN_NewMenu", MnuHndl AS ULONG  '<--- Create a handle for the
                                              'menu bar of the form

CALLDLL #LBCB, "FN_NewPopUp", PopUp1 AS ULONG  '<--- Create a handle for the
                                              'drop-down menu

'<----------- attach the popup item to the menu bar --------------->
CALLDLL #LBCB, "AddPopUp", MnuHndl AS ULONG, PopUp1 AS ULONG, _
               "&FILES" AS PTR, MF.ENABLED AS ULONG, RetVal AS VOID

CALLDLL #LBCB, "FN_NewPopUp", PopUp2 AS ULONG  '<--- Create a handle for a
                                              'popup menu in the drop-down
                                              'menu

'<----------- attach the popup item to the drop-down menu --------------->
CALLDLL #LBCB, "AddPopUp", PopUp1 AS ULONG, PopUp2 AS ULONG, _
              "Open" AS PTR, MF.ENABLED AS ULONG, RetVal AS VOID

'<----------- add items to the popup menu ----------------------->
CALLDLL #LBCB, "AddPopUpItem", PopUp2 AS ULONG, MNU.OpenDB AS LONG, _
              MF.ENCHECKED AS ULONG, "&Open DB" AS PTR, _
              RetVal AS VOID
CALLDLL #LBCB, "AddPopUpItem", PopUp2 AS ULONG, MNU.OpenIMG AS LONG, _
              MF.ENABLED AS ULONG, "Open &Image" AS PTR, _
              RetVal AS VOID

CALLDLL #LBCB, "FN_NewPopUp", PopUp2 AS ULONG  '<--- Create a handle for a
                                              'popup menu in the drop-down
                                              'menu

'<----------- attach the popup item to the drop-down menu --------------->
CALLDLL #LBCB, "AddPopUp", PopUp1 AS ULONG, PopUp2 AS ULONG, _
              "New" AS PTR, MF.ENABLED AS ULONG, RetVal AS VOID

'<----------- add items to the popup menu ----------------------->
CALLDLL #LBCB, "AddPopUpItem", PopUp2 AS ULONG, MNU.NewDB AS LONG, _
              MF.ENCHECKED AS ULONG, "&New DB" AS PTR, _
              RetVal AS VOID
CALLDLL #LBCB, "AddPopUpItem", PopUp2 AS ULONG, MNU.NewIMG AS LONG, _
              MF.ENABLED AS ULONG, "N&ew Image" AS PTR, _
              RetVal AS VOID

'<----------- add a seperator to the drop-down menu ----------------------->
CALLDLL #LBCB, "AddPopUpItem", PopUp1 AS ULONG, 0 AS LONG, _
              0 AS ULONG, "-" AS PTR, RetVal AS VOID

'<----------- add a disabled item to the drop-down menu -------------->
CALLDLL #LBCB, "AddPopUpItem", PopUp1 AS ULONG, MNU.SaveDTA AS LONG, _
              MF.GRAYED AS ULONG, "&Save Data" AS PTR, RetVal AS VOID

CALLDLL #LBCB, "FN_NewPopUp", PopUp1 AS ULONG  '<--- Create a handle for a
                                              'new drop-down menu

'<----------- add the item to the menu bar ------------------------>
CALLDLL #LBCB, "AddPopUp", MnuHndl AS ULONG, PopUp1 AS ULONG, _
              "&CREATE" AS PTR, MF.ENABLED AS ULONG, RetVal AS VOID

'<----------- add items to the new drop-down menu -------------------->
CALLDLL #LBCB, "AddPopUpItem", PopUp1 AS ULONG, MNU.ModeLess AS LONG, _
              MF.ENABLED AS ULONG, "Modeless Dlg" AS PTR, RetVal AS VOID
CALLDLL #LBCB, "AddPopUpItem", PopUp1 AS ULONG, MNU.Window AS LONG, _
              MF.ENABLED AS ULONG, "Form Window" AS PTR, RetVal AS VOID

'<--------------------- make the menu active ------------------>
WINHNDL = FN.GetHandle("#MNUTST")
CALLDLL #LBCB, "AttachMenu", WINHNDL AS ULONG, MnuHndl AS ULONG, RetVal AS VOID

END FUNCTION

'---------------------------------------------
'---------------------------------------------

FUNCTION FN.MenuCB(Hndl, Msg, CtlMsg, MnuId)
'##################################################
'  In an API application this function is equivalant
'to the application's CALLBACK function.  The sequence
'and number of arguments(parameters) are exactly the
'same.  For a more comprehensive study of API CALLBACKs,
'see "Things You Don't Want to Know ..." in the General
'Discussion thread.
'  FN_InitMenu() of WMLBCB.DLL changes meaning of lParam
'and wParam so you do not have to break down wParam into
'its component parts.
'
'Function FN.MenuCB ARGUMENTS:
'     Hndl:  The numeric identifier of the window receiving
'            the message
'      Msg:  The message received.  In the case of menus Msg
'            is WM.COMMAND
'   CtlMsg:  The high word of wParam.  In this case it is
'            BN.CLICKED
'    MnuId:  The low word of wParam.  In this case it is
'            the numeric identifier of the menu item.
'##############################################################

WM.COMMAND  = HEXDEC("&H0111")
BN.CLICKED  = 0

MF.ENABLED     = HEXDEC("&H00000000")
MF.GRAYED      = HEXDEC("&H00000001")
MF.DISABLED    = HEXDEC("&H00000002")

MF.UNCHECKED   = HEXDEC("&H00000000")
MF.CHECKED     = HEXDEC("&H00000008")

WinHndl = 0  '<--- Numeric identifier of window owning the menu
MnuHndl = 0  '<--- Numeric identifier of menu bar
RetVal  = 0  '<--- Return value

State = 0    '<--- Display state of menu item

SELECT CASE Msg
 CASE WM.COMMAND
 SELECT CASE CtlMsg
   CASE BN.CLICKED
     SELECT CASE MnuId  '<--- Determine which menu item was selected
       CASE MNU.Bar
         PRINT "MODELESS DIALOG MENU BAR CLICKED"

       CASE MNU.Click
         PRINT "WINDOW MENU ITEM MNU.Click WAS CLICKED"

       CASE MNU.OpenDB
         WinHndl = FN.GetHandle("#MNUTST")
         CALLDLL #LBCB, "FN_MenuHandle", WinHndl AS ULONG, MnuHndl AS ULONG
         CALLDLL #LBCB, "FN_GetMenuState", MnuHndl AS ULONG, _
                         1 AS LONG, MnuId AS LONG, State AS ULONG

         IF (State AND MF.CHECKED) = MF.CHECKED THEN EXIT FUNCTION

         '<--- change the check state of menu items --------->
         State = MF.ENABLED OR MF.CHECKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                        MnuId AS LONG, State AS ULONG, RetVal AS VOID

         State = MF.ENABLED OR MF.UNCHEKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                         MNU.OpenIMG AS LONG, State AS ULONG, RetVal AS VOID
         CALLDLL #LBCB, "ReDrawMenu", WinHndl AS ULONG, RetVal AS VOID

         '<---- do something else here if appropriate --------->
       CASE MNU.OpenIMG

         WinHndl = FN.GetHandle("#MNUTST")
         CALLDLL #LBCB, "FN_MenuHandle", WinHndl AS ULONG, MnuHndl AS ULONG
         CALLDLL #LBCB, "FN_GetMenuState", MnuHndl AS ULONG, _
                         1 AS LONG, MnuId AS LONG, State AS ULONG

         IF (State AND MF.CHECKED) = MF.CHECKED THEN EXIT FUNCTION

         '<--- change the check state of menu items --------->
         State = MF.ENABLED OR MF.CHECKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                        MnuId AS LONG, State AS ULONG, RetVal AS VOID

         State = MF.ENABLED OR MF.UNCHEKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                         MNU.OpenDB AS LONG, State AS ULONG, RetVal AS VOID
         CALLDLL #LBCB, "ReDrawMenu", WinHndl AS ULONG, RetVal AS VOID

       CASE MNU.NewDB
         WinHndl = FN.GetHandle("#MNUTST")
         CALLDLL #LBCB, "FN_MenuHandle", WinHndl AS ULONG, MnuHndl AS ULONG
         CALLDLL #LBCB, "FN_GetMenuState", MnuHndl AS ULONG, _
                         1 AS LONG, MnuId AS LONG, State AS ULONG

         IF (State AND MF.CHECKED) = MF.CHECKED THEN EXIT FUNCTION

         State = MF.ENABLED OR MF.CHECKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                        MnuId AS LONG, State AS ULONG, RetVal AS VOID
         State = MF.ENABLED OR MF.UNCHEKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                         MNU.NewIMG AS LONG, State AS ULONG, RetVal AS VOID
         CALLDLL #LBCB, "ReDrawMenu", WinHndl AS ULONG, RetVal AS VOID

         '<---- do something else here if appropriate --------->

       CASE MNU.NewIMG
         WinHndl = FN.GetHandle("#MNUTST")
         CALLDLL #LBCB, "FN_MenuHandle", WinHndl AS ULONG, MnuHndl AS ULONG
         CALLDLL #LBCB, "FN_GetMenuState", MnuHndl AS ULONG, _
                         1 AS LONG, MnuId AS LONG, State AS ULONG

         IF (State AND MF.CHECKED) = MF.CHECKED THEN EXIT FUNCTION

         State = MF.ENABLED OR MF.CHECKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                        MnuId AS LONG, State AS ULONG, RetVal AS VOID

         State = MF.ENABLED OR MF.UNCHEKED
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                         MNU.NewDB AS LONG, State AS ULONG, RetVal AS VOID
         CALLDLL #LBCB, "ReDrawMenu", WinHndl AS ULONG, RetVal AS VOID

       CASE MNU.ModeLess
         '<---------- disable the item and display it gray ---------------->
         WinHndl = FN.GetHandle("#MNUTST")
         CALLDLL #LBCB, "FN_MenuHandle", WinHndl AS ULONG, MnuHndl AS ULONG
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                        MnuId AS LONG, MF.GRAYED AS ULONG, RetVal AS VOID
         RetVal = FN.ModelessDlg()
         WinCount = WinCount OR 2  '<--- set to show that a modeless
                                   'dialog form is active

       CASE MNU.Window
         '<---------- disable the item and display it gray ---------------->
         WinHndl = FN.GetHandle("#MNUTST")
         CALLDLL #LBCB, "FN_MenuHandle", WinHndl AS ULONG, MnuHndl AS ULONG
         CALLDLL #LBCB, "SetMenuState", MnuHndl AS ULONG, 1 AS LONG, _
                        MnuId AS LONG, MF.GRAYED AS ULONG, RetVal AS VOID

         RetVal = FN.NewWin()
         WinCount = WinCount OR 5  '<--- set to show that a window
                                   'form is active

   END SELECT
 END SELECT
END SELECT

END FUNCTION

'--------------------------------------------------------------------
'--------------------------------------------------------------------

FUNCTION FN.ModelessDlg()
'#######################################################
'  Create a modeless dialog form with a menu
'#######################################################

RetVal = 0

CODEPTR = 0
CALLBACK CODEPTR, FN.MenuCB(ULONG, ULONG, LONG, LONG), LONG '<--- code address
                                                           'of LB callback
                                                           'function

OPEN "MODELESS DLG" FOR DIALOG AS #MDL
PRINT #MDL, "TRAPCLOSE DLG.CLOSE"

RetVal = FN.ModelessMenu()  '<--- create the menu
WINHNDL = FN.GetHandle("#MDL")
CALLDLL #LBCB, "FN_InitMenu", _
              WINHNDL AS ULONG, _ '<--- handle of window
              MNU.Bar AS LONG,  _ '<--- lowest menu identifier
               MNU.Bar AS LONG, _ '<--- highest menu identifier
               CODEPTR AS ULONG,_ '<--- code address of callback function
                RetVal AS LONG    '<--- RETURN: Non-zero on success

END FUNCTION

'--------------------------------------------------------------------
'--------------------------------------------------------------------

FUNCTION FN.ModelessMenu()

MF.ENABLED     = HEXDEC("&H00000000")

MnuHndl = 0
CALLDLL #LBCB, "FN_NewMenu", MnuHndl AS ULONG  '<--- handle of menu bar

'======================================================================
'  by using a id number this item is made to activate when it is clicked
'======================================================================
CALLDLL #LBCB, "AddPopUpItem", MnuHndl AS ULONG, MNU.Bar AS LONG, _
              MF.ENABLEED AS ULONG, "Click Me" AS PTR, _
              RetVal AS VOID

'<------------ make menu active ------------------------------------>
WINHNDL = FN.GetHandle("#MDL")
CALLDLL #LBCB, "AttachMenu", WINHNDL AS ULONG, MnuHndl AS ULONG, RetVal AS VOID

END FUNCTION

'--------------------------------------------------------------
'--------------------------------------------------------------

FUNCTION FN.NewWin()
'##################################################
'  create a window form with a menu
'##################################################

RetVal = 0
CODEPTR = 0
CALLBACK CODEPTR, FN.MenuCB(ULONG, ULONG, LONG, LONG), LONG

OPEN "NEW WIN" FOR WINDOW AS #NWIN

RetVal = FN.WinMenu()

PRINT #NWIN, "TRAPCLOSE CLOSE.WIN"

WINHNDL = FN.GetHandle("#NWIN")
CALLDLL #LBCB, "FN_InitMenu", WINHNDL AS ULONG, MNU.Click AS LONG, _
               MNU.Click AS LONG, CODEPTR AS ULONG, RetVal AS LONG
END FUNCTION

'-------------------------------------------------------
'-------------------------------------------------------

FUNCTION FN.WinMenu()

MF.ENABLED     = HEXDEC("&H00000000")

MnuHndl = 0
CALLDLL #LBCB, "FN_NewMenu", MnuHndl AS ULONG
CALLDLL #LBCB, "FN_NewPopUp", PopUp1 AS ULONG
CALLDLL #LBCB, "AddPopUp", MnuHndl AS ULONG, PopUp1 AS ULONG, _
               "&DUMMY" AS PTR, MF.ENABLED AS ULONG, RetVal AS VOID
CALLDLL #LBCB, "AddPopUpItem", PopUp1 AS ULONG, MNU.Click AS LONG, _
              MF.ENABLED AS ULONG, "&Opps" AS PTR, _
              RetVal AS VOID
WINHNDL = FN.GetHandle("#NWIN")
CALLDLL #LBCB, "AttachMenu", WINHNDL AS ULONG, MnuHndl AS ULONG, RetVal AS VOID
END FUNCTION
'

MENUS.ZIP (61.58 KB)

[Walt Decker]

I have updated MENUS.ZIP.

It now contains
MENUS.ZIP contains:
WMLBCB_DOC.TXT - Updated
WMLBCB.DLL - Updated
MENU_000._BAS
NOTEPAD_CLONE._BAS

I am working on a method to trap the system scroll bars for scrolling a form window and/or form dialog.

[Walt Decker]

I have updated MENUS.ZIP.

It now contains

WMLBCB_DOC.TXT - Updated
WMLBCB.DLL - Updated
MENU_000._BAS
NOTEPAD_CLONE._BAS
SCRL_DMO_001._BAS

[pablosl]

Can Hotkeys or shortcut keys be embedded?

Like in menu Help next Keyboard F1.

-Pablo

[Walt Decker]

Do you mean like


MenuString$ = "&Edit" '<--- short cut key

CALLDLL #MNU, "AddPopUp", MnuHndl AS ULONG, PopUpHndl AS ULONG, MenuString$ AS PTR, _
           MnuState AS ULONG, RetVal AS VOID


If you mean accelerator, keys there is no provision for those, but I can add it.

[pablosl]

Yes I think I was talking about accelerators.

Thank you!

[Walt Decker]

I will add that; however, I will not have the time until Tues, 13 Sept. I will post a revision when it is complete.

[Walt Decker]

So far I have been defeated in an effort to include accelerator keys. After two days of scratching my bald head (not scratching my head bald) and trying different approaches I have found no way to get around a protection violation. I will try from time to time, but have not much confidence in finding a solution.

[Walt Decker]

Although I do not care for this solution to accelerator keys, a work-around is to query function GetAsyncKeyState() for the key combinations specified in the menu setup. It is not eligant but it will work.

[Brandon Parker]

Walt,
Is this a protection violation that is caused when LB is calling your DLL? Would you want to share what is causing the issue? Maybe someone has seen something similar before and can offer some assistance.


{:0)

Brandon Parker

[Walt Decker]

Thank you for asking Mr. Parker. Yes, the protection violation was a problem with LB calling the dll; however, I finally found the problem. I was using the wrong callback address in the dll when the user pressed an ansi character. That is now fixed.

Now I am addressing function TranslateAccelerator(). That has to be called from a message pump loop.

[Walt Decker]

So far I have found no way to make LB recognize accelerator keys other than querying GetAsyncKeyState(). If that is the only way WMLBCB.DLL will not have accelerator key capability. I will keep playing with it, but my hopes are not high.

[pablosl]

Can I right align the word "F1" inside the HELP string?
As in:
Help F1
Files F2
Quit Alt+F4

-Pablo

[Walt Decker]

Yes. The DLL does not monitor text length. To do it properly you should use a combination of User32.DLL FUNCTION GetDC(), Gdi32.DLL FUNCTIONs SelectObject(), GetTextExtentPoint32(), DeleteObject(), and User32.DLL FUNCTION ReleaseDC(). Or you can just use trial and error.