Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Owner Drawn Menu based on Bernard Ertl work. Draws border.

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Owner Drawn Menu based on Bernard Ertl work. Draws border.

    This version draws the border around the window of a menu however it doesn't do this when you click the menu with the mouse.

    I don't know which message is sent then.

    Code:
    '************************************************************************
    '* ODrawMenu.bas                                                           *
    '*     by Bernard Ertl                                                  *
    '*     July 11, 2002                                                    *
    '*     Revamped July 12 - Changed from DrawState to DrawText            *
    '*                      - Changed sizing handlers for min dialog width  *
    '*                        and maximizing                                *
    '*                      - Added STATIC array to track menu item data    *
    '*                      - Streamlined tracking of focus RECTs           *
    '*     Modified July 13 - Changed WM_INITDIALOG to eliminate reliance on*
    '*                        GetMenuItemInfo & SetMenuItemInfo             *
    '*                      - Changed WM_MEASURE handler to calculate tabbed*
    '*                        submenu items correctly                       *
    '*                      - Adjusted height for separators                *
    '*     Modified July 14 - Added WM_NCLBUTTONDOWN handler                *
    '*                      - Eliminated need for STATIC FocusRect & WM_MOVE*
    '*                        repainting                                    *
    '*                      - Corrected spacing of top level menu items     *
    '*     Modified July 15 - Added support for nested sub-menus            *
    '*                      - Overhauled painting & drawing to better       *
    '*                        conform to standard menu behavior             *
    '*                      - Ensured proper key-navigation for separators  *
    '*     Modified July 16 - Included option to maintain focus highlighting*
    '*                        when dialog is inactive                       *
    '*                      - Corrected code for grayed/disabled items      *
    '*     Modified July 17 - Grayed top menu bar when dialog is inactive   *
    '*                      - Added support for %MF_CHECKED                 *
    '*                      - Added support for auto-adjusting to the       *
    '*                        color display mode                            *
    '*     Modified July 18 - Added default checkmark if user does not      *
    '*                        specify an icon                               *
    '*                      - Shows icons for disabled/grayed items as      *
    '*                        monochrome now                                *
    '*                      - Corrected display for top level menu items    *
    '*                        that are disabled/grayed                      *
    '*     Modified July 21 - Added OS versioning support.  Menu conforms to*
    '*                        standard behavior for the current OS.         *
    '*                        ** Win95 tested OK                            *
    '*                        ** Win98 tested OK (default)                  *
    '*                        ** WinXP added, not fully tested              *
    '*                                                                      *
    '* CREDITS:                                                             *
    '* Much of this code has been adapted from Borje Hagsten's & Semen      *
    '* Matusovski's code found here:                                        *
    '* http://www.powerbasic.com/support/forums/Forum4/HTML/004427.html      *
    '*                                                                      *
    '* Also, code has been adapted from Borje Hagsten's excellent DrawMenu  *
    '* code.                                                                *
    '*                                                                      *
    '* Original skeleton code designed with PBForms 1.0.  PB Forms          *
    '* metastatements have been removed since I had to do some editing      *
    '* to the PB Forms blocks and it can not be reloaded correctly.         *
    '*                                                                      *
    '* Thanks to Aleksander Hjalmar for testing and suggesting improvements.*
    '*                                                                      *
    '* Thanks to Scott Turchin for the Windows OS Version Function.  I      *
    '* modified it to suit my tastes...                                     *
    '*                                                                      *
    '* DESCRIPTION:                                                         *
    '* This code shows how to completely customize a menu including the top *
    '* level menu bar.  You can set colors and icons for all menu items.    *
    '*                                                                      *
    '* RESTRICTIONS:                                                        *
    '* - Code requires that top level menubar items have IDs in a range     *
    '*   greater than all sublevel menu items                               *
    '* - Code assumes that all top level menubar items have sub-menus (no   *
    '*   separators). Separators are OK in sub-menus.                       *
    '* - Code assumes that all top level menubar items are UNCHECKED        *
    '* - Code restricts minimum sizing of dialog width to the size of the   *
    '*   menu bar because the background coloring of the menu bar does not  *
    '*   work correctly at all times when the toolbar is multiple lines in  *
    '*   height.                                                            *
    '************************************************************************
    'Modified 2019-OCT-16 by: Jim Fritts to work in PBWIN10.4 and J. Roca headers
    ' Modified by Tim Nov 15 2020 with better color and no OS check as
    ' it is not necessary since everyone is using Windows 10
    
    
    #COMPILE EXE
    #DIM ALL
    
        #INCLUDE "WIN32API.INC"
    
    
    '--------------------------------------------------------------------------------
    '   ** Constants **
    '--------------------------------------------------------------------------------
    %IDD_DIALOG1            = 101
    %IDR_MENU1              = 102
    %IDM_FILE_OPEN          = 1001
    %IDR_ACCELERATOR1       = 103
    %IDM_FILE_SAVE          = 1002
    %IDM_FILE_EXIT          = 1003
    %IDM_EDIT_CUT           = 1004
    %IDM_EDIT_COPY          = 1005
    %IDM_EDIT_PASTE         = 1006
    %IDM_HELP_HELPTOPICS    = 1007
    %IDM_HELP_ABOUT         = 1008
    %IDM_EDIT_SUB_COOL      = 1009
    %IDM_EDIT_SUB_DARE      = 1010
    
    'These constants help define the menu structure
    %ODM_BASE_MENUBAR_ITEM_ID = 9000  'This is the ID threshold for top level menubar items
    %ODM_BASE_SUBMENU_ITEM_ID = 2000  'This is the ID threshold for any (sub-)menu items that contain sub-menus
    %ODM_MAX_STRING           = 40    'Number of bytes for ASCIIZ menu strings
    
    %ODM_ACCEL_KEY_SPACING     = 10   'Seems to work good
    %ODM_ICON_IN_MENU_WIDTH    = 16   '16 for icon
    %ODM_MARGIN_SPACING        = 4
    %ODM_TEXT_OFFSET_FROM_ICON = 2    'Add spacing between sub-menu item's text and icon
    
    
    
    
    
    '--------------------------------------------------------------------------------
    '   ** Types **
    '--------------------------------------------------------------------------------
    'NOTE: hIco is the default icon image to display.  If you want to display checked/unchecked states,
    '  hIco        = unchecked state icon  (could be NULL for no image)
    '  hCheckedIco = checked state icon    (can be the same as hIco too)
    'NOTE: wID **MUST** be the first item in the TYPE.
    TYPE MenuItemType
       wID         AS DWORD  'Menu item's control ID
       zTxt        AS ASCIIZ * %ODM_MAX_STRING
       hIco        AS DWORD  'Default icon image
       hCheckedIco AS DWORD  'Checked icon image
       AccelWidth  AS LONG   'Holds TextExtent of any accelerator key text
    END TYPE
    
    
    
    TYPE ColorSet
       BkFace            AS LONG  'Color for raised button face
       BkFaceSunken      AS LONG  'Color for depressed button face
       BkHighlight       AS LONG  'Color for sub-menu highlighted items
       BkHighlightSunken AS LONG  'Color for depressed face on sub-menu higlighted items
       BkFocusHighlight  AS LONG  'Color for focus highlighting top level menu bar
       BkFocusSelect     AS LONG  'Color for selected top level menu bar item
       TxDefault         AS LONG  'Default color for text
       TxGrayed          AS LONG  'Color for grayed text
       TxHighlighted     AS LONG  'Color for highlighted text
    END TYPE
    
    
    '--------------------------------------------------------------------------------
    '   ** Globals **
    '--------------------------------------------------------------------------------
    GLOBAL GetColorFor()      AS ColorSet
    GLOBAL CurrentDisplayMode AS LONG
    
    Global hHookOldMenuFilter As Long
    
    '--------------------------------------------------------------------------------
    '   ** Macros **
    '--------------------------------------------------------------------------------
    'The following MACROS were added for coding clarity in the ShowDIALOG1Proc function
    MACRO mHighlightMenuItem
    
            GetWindowRect CB.HNDL, tRect
            tRect.nBottom = FocusRect.nBottom - tRect.nTop
            tRect.nTop    = FocusRect.nTop    - tRect.nTop
            tRect.nRight  = FocusRect.nRight  - tRect.nLeft
            tRect.nLeft   = FocusRect.nLeft   - tRect.nLeft
            hDC = GetWindowDC( CB.HNDL)
            'Draw
    
             'WinME, WinNT, Win2k --- I'm not sure what the
             ' standard focus highlighting is for these OSes
               DrawEdge hDC, tRect, %BDR_RAISEDOUTER, %BF_RECT
    
            IF hIcon THEN
                  DrawIconEx hDC, tRect.nLeft + %ODM_MARGIN_SPACING - 2,_
                  tRect.nTop + 1, hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
            END IF
            ReleaseDC CB.HNDL, hDC
    
    END MACRO
    
    
    MACRO mRestoreMenuItem
    
            GetWindowRect CB.HNDL, tRect
            tRect.nBottom = FocusRect.nBottom - tRect.nTop
            tRect.nTop    = FocusRect.nTop    - tRect.nTop
            tRect.nRight  = FocusRect.nRight  - tRect.nLeft
            tRect.nLeft   = FocusRect.nLeft   - tRect.nLeft
            hDC = GetWindowDC( CB.HNDL)
            'Erase
    
             'WinME, WinNT, Win2k --- I'm not sure what
             'the standard focus highlighting is for these OSes
             FrameRect hDC, tRect, hCustomBrush
    
            'Redraw icon in case it overlapped the button frame
            IF hIcon THEN
                DrawIconEx hDC, tRect.nLeft + %ODM_MARGIN_SPACING - 2,_
                tRect.nTop + 1, hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
            END IF
            ReleaseDC CB.HNDL, hDC
    
    END MACRO
    
    
    
    
    
    
    
    '--------------------------------------------------------------------------------
    '   ** PBMAIN **
    '--------------------------------------------------------------------------------
    FUNCTION PBMAIN()
    
         LOCAL dm AS DEVMODE
    
         DIM GetColorFor( 1)
    
        'Set colors for 256 color mode
      '  GetColorFor(0).BkFace            = RGB( 128, 128, 0)
     '   GetColorFor(0).BkFaceSunken      = RGB( 128, 128, 0) '%YELLOW does not make good 3D effect
     '   GetColorFor(0).BkHighlight       = RGB( 128, 0, 0)
      '  GetColorFor(0).BkHighlightSunken = RGB( 128, 0, 0)   '%RED does not make good 3D effect
    
    
       ' GetColorFor(0).BkFocusHighlight  = GetColorFor(0).BkHighlight
       ' GetColorFor(0).BkFocusSelect     = GetColorFor(0).BkHighlight
    
       ' GetColorFor(0).TxDefault         = %rgb_mediumblue
       ' GetColorFor(0).TxGrayed          = &H00505050  'Dark Gray
      '  GetColorFor(0).TxHighlighted     = GetSysColor( %COLOR_HIGHLIGHTTEXT)
    
        'Set colors for 16 bit/High Color or better
        GetColorFor(1).BkFace            = RGB( 64, 64, 64) '%RGB_AZURE
        GetColorFor(1).BkFaceSunken      = RGB( 64, 64, 64) 'RGB( 220, 220, 188)
        GetColorFor(1).BkHighlight       = %RGB_LIGHTSKYBLUE
    
        GetColorFor(1).BkHighlightSunken = RGB( 64, 64, 64) 'RGB( 187, 187, 128)
    
    
        GetColorFor(1).BkFocusHighlight  = GetColorFor(1).BkHighlight
        GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkHighlight
    
        GetColorFor(1).TxDefault         = %WHITE '%RGB_MEDIUMBLUE
        GetColorFor(1).TxGrayed          = GetSysColor( %COLOR_GRAYTEXT)
        GetColorFor(1).TxHighlighted     = %BLACK '%RGB_MAGENTA
    
        'Get Current Display Mode
        dm.dmSize = LEN( DEVMODE)
        EnumDisplaySettings BYVAL 0, %ENUM_CURRENT_SETTINGS, dm
        CurrentDisplayMode = IIF&( dm.dmBitsPerPel > 8, 1, 0)
    
    
        ShowDIALOG1 %HWND_DESKTOP
    
    END FUNCTION
     '--------------------------------------------------------------------------------
    '   ** Dialogs **
    '--------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
    
        LOCAL hDlg AS DWORD
    
        DIALOG NEW hParent, "OwnerDrawMenu Example Including Top Level Menu", 92, _
            98, 402, 272, %WS_OVERLAPPED OR %WS_THICKFRAME OR %WS_CAPTION OR _
            %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR _
            %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE OR _
            %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    
        'It's necessary to add a dummy button to force the menu command
        'accelerators ( '&F'ile ) to work.
        CONTROL ADD BUTTON, hDlg, 100, "Dummy Button", 0, 0, 0, 0
    
        CreateMenu1 hDlg
    
        AttachACCELERATOR1 hDlg
    
    
        DIALOG SET COLOR hDlg, -1, %RGB_PAPAYAWHIP
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
        FUNCTION = lRslt
    
    END FUNCTION
    
    
    
    '--------------------------------------------------------------------------------
    '   ** CallBacks **
    '--------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
    
       REGISTER I AS LONG, K AS LONG
    
       STATIC hCustomBrush         AS LONG  ' Custom background color
       STATIC hCustomSunkenBrush   AS LONG  ' Custom sunken background color (button depression)
       STATIC hCustomBkBrush       AS LONG  ' Custom background highlight color
       STATIC hCustomSunkenBkBrush AS LONG  ' Custom sunken background highlight color (button depression)
       STATIC hCustomFocusHLBrush  AS LONG  ' Custom highlight color for top level menu item
       STATIC hCustomFocusSelBrush AS LONG  ' Custom highlight color for selected top level menu item
       STATIC RightEdge            AS LONG  ' 'Coordinate' of the dialog's right edge
       STATIC BORDER               AS LONG  ' 'Coordinate' of the right edge of the last top level menubar item
       STATIC FocusItem            AS LONG  ' Control ID of the top level menubar item that has focus
       STATIC hTimer               AS DWORD ' Handle to Timer
       STATIC DialogIsActive       AS LONG  ' Track if dialog is active
    
       STATIC MenuItemData()  AS MenuItemType  'Maintain info for each ownerdrawn menu item
       'Note:  This is necessary because menu items with fType = %MFT_OWNERDRAW do not
       '       return the dwTypeData correctly.
       'Note:  If you want to have multiple dialogs active concurrently with ownerdrawn menus,
       '       they should have unique dialog callback functions.  Otherwise there will be problems
       '       with the STATIC variables.
    
       LOCAL Offset                AS LONG 'General purpose local variable
       LOCAL SubMenuID             AS LONG
       LOCAL MaxAccelTxtWidth      AS LONG
       LOCAL StartingSubMenuOffset AS LONG
       LOCAL FocusRect             AS RECT ' Coordinates of the top level menubar item with focus
       LOCAL NewColorMode          AS LONG
    
       LOCAL hDC      AS LONG  'Handles
       LOCAL hMenu    AS LONG
       LOCAL hSubMenu AS LONG
       LOCAL hIcon    AS LONG
       LOCAL hf       AS LONG
    
       LOCAL strMenu  AS STRING 'Strings
       LOCAL strMenu2 AS STRING
       LOCAL zTxt     AS ASCIIZ * %ODM_MAX_STRING
    
       LOCAL tRect    AS RECT   'For processing messages
       LOCAL t2Rect   AS RECT
       LOCAL ptrRECT  AS RECT PTR
       LOCAL SizeA    AS SizeL
       LOCAL ncm      AS NONCLIENTMETRICS
       LOCAL mminfo   AS MINMAXINFO PTR
       LOCAL pt       AS POINTAPI
       LOCAL lpmis    AS MEASUREITEMSTRUCT PTR
       LOCAL lpdis    AS DRAWITEMSTRUCT PTR
    
    
       SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
               'Initialize var
               DialogIsActive = %True
    
               'Get starting dimensions for dialog
               GetClientRect CB.HNDL, tRect
               'Save total width
               RightEdge = tRect.nRight + 4
               hCustomBrush         = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFace)
               hCustomSunkenBrush   = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFaceSunken)
               hCustomBkBrush       = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlight)
               hCustomSunkenBkBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlightSunken)
               hCustomFocusHLBrush  = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusHighlight)
               hCustomFocusSelBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusSelect)
    
               hMenu = GetMenu( CB.HNDL)
    
               'Count Max# total menu & sub-menu items
               I = CountItems( hMenu)
               'Dimension array for strings and icons
               DIM MenuItemData( I)
               SubMenuID = %ODM_BASE_SUBMENU_ITEM_ID
    
               'Now we modify our menu to
               '  1) add control ID's to the top level menubar items
               '  2) change all items to ownerdraw
    
               FOR K = 0 TO GetMenuItemCount( hMenu) - 1
                  '--- SUB-MENUS ----------------------
                  hSubMenu = GetSubMenu( hMenu, K)
                  ModifySubMenu CB.HNDL, hSubMenu, VARPTR( MenuItemData( 0)), Offset, SubMenuID
                  '--- TOP-LEVEL MENUS ----------------------
                  GetMenuString hMenu, K, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
                  INCR Offset
                  'Set an ID for top level menubar items
                  MenuItemData( Offset).wID  = %ODM_BASE_MENUBAR_ITEM_ID + K
                  MenuItemData( Offset).zTxt = zTxt
    
                  'Modify the following SELECT CASE as desired to add icons
                  'where you want them.  You can also load icons from a resource file
                  SELECT CASE AS LONG K
                     CASE 0  'First menu bar item
                    'Check spacing on menu item with no icon....
    '                MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_APPLICATION)
                     CASE 1  'Second menu bar item
                        MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_ASTERISK)
                     CASE 2  'Third menu bar item
                        MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_WINLOGO)
                     CASE ELSE
                        'No icons to display
                  END SELECT
                  ModifyMenu hMenu, K, %MF_BYPOSITION OR _
                     %MF_OWNERDRAW, MenuItemData( Offset).wID, BYVAL 0
               NEXT
    
           CASE %WM_GETMINMAXINFO
               mminfo = CB.LPARAM
               'Set the minimum dialog width to avoid incorrect
               'painting of multi-line top level menubar
               @mminfo.ptMinTrackSize.x = BORDER + 16
    
           CASE %WM_NCACTIVATE
                DialogIsActive = CB.WPARAM
               'WinME, WinNT, Win2k, WinXP --- I assume these OSes
               ' gray text for dialogs without focus
                 IF DialogIsActive THEN
                  RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0,_
                  %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
                 END IF
    
    
           CASE %WM_DISPLAYCHANGE
               NewColorMode = IIF&( CB.WPARAM > 8, 1, 0)
               IF NewColorMode <> CurrentDisplayMode THEN
                  CurrentDisplayMode = NewColorMode
                  'Release old brushes
                  DeleteObject hCustomBrush
                  DeleteObject hCustomSunkenBrush
                  DeleteObject hCustomBkBrush
                  DeleteObject hCustomSunkenBkBrush
                  DeleteObject hCustomFocusHLBrush
                  DeleteObject hCustomFocusSelBrush
                  'Get new brushes
                  hCustomBrush         = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFace)
                  hCustomSunkenBrush   = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFaceSunken)
                  hCustomBkBrush       = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlight)
                  hCustomSunkenBkBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlightSunken)
                  hCustomFocusHLBrush  = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusHighlight)
                  hCustomFocusSelBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusSelect)
                  'Force redraw of menu bar
                  DIALOG SET COLOR  CB.HNDL, _
                      GetColorFor( CurrentDisplayMode).TxDefault, GetColorFor( CurrentDisplayMode).BkFace
                  RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, %RDW_ERASE OR _
                    %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
               END IF
    
           CASE %WM_MEASUREITEM
               IF CB.WPARAM = 0 THEN  'a menu is calling
                  lpmis = CB.LPARAM
    
                  ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( @lpmis.itemID), TO Offset
                  DECR Offset  'Adjust for zero base
                  zTxt = PARSE$( MenuItemData( Offset).zTxt, $TAB, 1)
    
                  hDC = GetDC( CB.HNDL)
                    ncm.cbSize = LEN( NONCLIENTMETRICS)
                    SystemParametersInfo %SPI_GETNONCLIENTMETRICS, SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                    IF LEN(ncm.lfMenuFont) THEN
                       hf = CreateFontIndirect(ncm.lfMenuFont)
                       IF hf THEN hf = SelectObject(hDC, hf)
                    END IF
                    GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                    @lpmis.itemHeight = ncm.iMenuHeight + 2
                    SELECT CASE AS LONG @lpmis.itemId
                       CASE 0
                          'Separator
                          @lpmis.itemHeight = ncm.iMenuHeight \ 2
                       CASE < %ODM_BASE_MENUBAR_ITEM_ID
                          'Submenu item
                          @lpmis.itemWidth  = sizeA.cx + _
                              MenuItemData( Offset).AccelWidth + _
                               %ODM_ACCEL_KEY_SPACING + %ODM_TEXT_OFFSET_FROM_ICON
                       CASE ELSE
                          'Top level menu item
                          IF MenuItemData( Offset).hIco THEN
                             'Add margins for both right & left sides
                             @lpmis.itemWidth  = sizeA.cx + %ODM_MARGIN_SPACING + %ODM_MARGIN_SPACING
                          ELSE
                             'Add margins for both right & left sides
                             'Remove space for icon
                             @lpmis.itemWidth  = sizeA.cx - %ODM_ICON_IN_MENU_WIDTH + _
                                %ODM_MARGIN_SPACING + %ODM_MARGIN_SPACING
                          END IF
                    END SELECT
                    IF hf THEN
                        DeleteObject SelectObject(hDC, hf)
                    END IF
                  ReleaseDC CB.HNDL, hDC
                  FUNCTION = 1
               END IF
    
           CASE %WM_DRAWITEM
                 'if identifier is 0, message was sent by a menu
                  lpdis = CB.LPARAM
    
               DrawMenuBorder(@lpDis.hDC)
    
               IF CB.WPARAM = 0 THEN
                  IF @lpdis.itemId THEN
                     'Not a separator (they have .itemID=0)
    
                     ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( @lpdis.itemID), TO Offset
                     DECR Offset  'Adjust for zero base
                     zTxt  = MenuItemData( Offset).zTxt
                     IF (@lpdis.itemState AND %ODS_CHECKED) THEN
                        hIcon = MenuItemData( Offset).hCheckedIco
                     ELSE
                        hIcon = MenuItemData( Offset).hIco
                     END IF
    
                     MaxAccelTxtWidth = MenuItemData( Offset).AccelWidth
                     Offset = 0  'We will reuse the Offset variable for positioning
    
                     IF @lpdis.itemId >= %ODM_BASE_MENUBAR_ITEM_ID THEN
                        'Top Level Menu
                        'Erase bottom border...
                        tRect = @lpdis.rcItem
                        INCR tRect.nBottom
                        ' Win2k
                        ' Paint custom background...
                          FillRect @lpdis.hDC, tRect, hCustomBrush
                          IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                                 'Standard Windows 98 focus edging
                                 DrawEdge @lpdis.hDC, @lpdis.rcItem, %BDR_SUNKENOUTER, %BF_RECT
                                 'Needed for our custom color to show top & left edges....
                                 ' (If you change the custom color the following may not be necessary)
                                 DrawEdge @lpdis.hDC, @lpdis.rcItem, %EDGE_SUNKEN, %BF_TOPLEFT
                           ELSE
                                 Offset = -1  'Offset for text to move it when "button" is NOT "clicked"
                           END IF
    
                        IF ISTRUE DialogIsActive  THEN
                           IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                           ELSE
                              SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxDefault
                           END IF
                        ELSE
                           SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                        END IF
    
                        'Set Border when at last top level menu item
                        IF @lpdis.itemId = %ODM_BASE_MENUBAR_ITEM_ID + _
                                   GetMenuItemCount( GetMenu( CB.HNDL)) - 1 THEN
                           BORDER = @lpdis.rcItem.nRight
                           IF RightEdge > 0 THEN
                               tRect = @lpdis.rcItem
                               tRect.nLeft = BORDER
                               tRect.nRight = RightEdge
                               INCR tRect.nBottom
                               FillRect @lpdis.hDC, tRect, hCustomBrush
                           END IF
                        END IF
                     ELSE
                        'Sub-level Menu
                        IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                           'COLOR NOTE:
                           '   Windows automatically draws the sub-menu arrow icon even with ownerdrawn
                           '   status.  Windows uses the default colors for the arrow icon:
                           '        %COLOR_MENUTEXT? for unhighlighted items and
                           '        %COLOR_HIGHLIGHTTEXT for highlighted items
                           '   Setting the background highlight &/or text to different colors
                           '   may yield unsatisfactory results.
                           FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBkBrush
                           IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                           ELSE
                              SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxHighlighted
                           END IF
                        ELSEIF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                           FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                           SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                        ELSE
                           FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                           SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxDefault
                        END IF
                     END IF
    
                     IF (@lpdis.itemState AND %ODS_CHECKED) THEN
                        'Need to show depressed button effect
                        tRect = @lpdis.rcItem
                       'A total width of 20 pixels, 16 for icon, 4 for margins
                        tRect.nRight = tRect.nLeft + 19
                        DrawEdge @lpdis.hDC, tRect, %BDR_SUNKENOUTER, %BF_RECT
                        IF CurrentDisplayMode = 0 THEN
                           '256 color mode
                           'Needed for our custom color to show top & left edges....
                           ' (If you change the custom color the following may not be necessary)
                           DrawEdge @lpdis.hDC, tRect, %EDGE_SUNKEN, %BF_TOPLEFT
                        END IF
                        INCR tRect.nTop
                       ' INCR tRect.nLeft
                        tRect.nLeft = tRect.nLeft + 2
                       ' DECR tRect.nRight
                        tRect.nRight = tRect.nRight -2
                        DECR tRect.nBottom
                        IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                          FillRect @lpdis.hDC, tRect, hCustomSunkenBkBrush
                        ELSE
                          FillRect @lpdis.hDC, tRect, hCustomSunkenBrush
                        END IF
                        IF hIcon = 0 THEN
                           'No user defined icon, so draw standard windows checkmark
                           'Get bitmap
                           hIcon = LoadBitMap( BYVAL 0, BYVAL %OBM_CHECK)
                           IF hIcon <> 0 THEN
                              'Make a brush colored same as text in temporary variable
                              hf = CreateSolidBrush( GetColorFor( CurrentDisplayMode).TxDefault)
                              'Draw checkmark in mono mode so it doesn't draw a background
                              CALL DrawState(@lpdis.hDC, hf, 0&, hIcon, 0&, @lpdis.rcItem.nleft + 3, _
                                      @lpdis.rcItem.nTop + 4, 16, 16, %DST_BITMAP OR %DSS_MONO)
                              'Delete the bitmap when done, to avoid memory leaks!
                              DeleteObject hIcon
                              hIcon = 0
                              DeleteObject hf
                           END IF
                        END IF
                     END IF
    
                     SetBkMode @lpdis.hDC, %TRANSPARENT
    
                     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                     ' Get menu item string and split up into
                     ' ev. text and shortcut part
                     strMenu2 = zTxt
                     IF INSTR(strMenu2, $TAB) THEN
                        'if it has shortcut (Ctrl+X, etc.)
                        strMenu  = TRIM$(PARSE$(strMenu2, $TAB, 1))
                        strMenu2 = TRIM$(PARSE$(strMenu2, $TAB, 2))
                     ELSE
                        strMenu = TRIM$(strMenu2)
                        strMenu2 = ""
                     END IF
    
                     IF LEN( strMenu) <> 0 THEN
                        tRect = @lpdis.rcItem
                        IF Offset THEN
                           tRect.nTop    = tRect.nTop    + Offset
                           tRect.nBottom = tRect.nBottom + Offset
                        END IF
                        IF @lpdis.itemId >= %ODM_BASE_MENUBAR_ITEM_ID THEN
                           IF hIcon THEN
                               'Leave room for icons
                              tRect.nLeft = @lpdis.rcItem.nleft + _
                                   %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING\2 + Offset*2
                              DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                                     LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR _
                                      %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                              IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                                  hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                              END IF
                              DrawIconEx @lpdis.hDC, @lpdis.rcItem.nleft + _
                                      %ODM_MARGIN_SPACING + Offset - 1, @lpdis.rcItem.nTop + 2 + Offset, _
                                         hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
                              IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                                  DeleteObject hIcon
                              END IF
                           ELSE
                              'When no icon in top level, adjust RECT
                              tRect.nLeft = @lpdis.rcItem.nleft + Offset*2
                              DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                               LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR _
                                %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                           END IF
                        ELSE
                           tRect.nLeft = @lpdis.rcItem.nleft + _
                             %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING + _
                              %ODM_TEXT_OFFSET_FROM_ICON 'Leave room for icons
                           DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                                 LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR _
                                    %DT_SINGLELINE OR %DT_VCENTER
                           IF LEN(strMenu2) THEN
                              tRect.nLeft = @lpdis.rcItem.nRight - MaxAccelTxtWidth
                              DrawText @lpdis.hDC, BYVAL STRPTR(strMenu2), _
                               LEN(strMenu2), tRect, %DT_LEFT OR %DT_NOCLIP _
                                   OR %DT_SINGLELINE OR %DT_VCENTER
                           END IF
                           'Draw icon if any...
                           IF hIcon THEN
                              IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                                  hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                              END IF
                              DrawIconEx @lpdis.hDC, @lpdis.rcItem.nleft + 1, _
                                         @lpdis.rcItem.nTop + 2, _
                                         hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
                              IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                                  DeleteObject hIcon
                              END IF
                           END IF
                        END IF
                     END IF
                  ELSE
                     'Draw a separator
                     'Sub-level Menu
                     FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                     tRect = @lpdis.rcItem
                     tRect.nTop  = tRect.nTop + (tRect.nBottom - tRect.nTop)\2
                     DrawEdge @lpdis.hDC, tRect, %EDGE_ETCHED, %BF_TOP
                  END IF
                  FUNCTION = 1
               END IF
    
           CASE %WM_SIZING
              SELECT CASE AS LONG CB.WPARAM
                 CASE %WMSZ_BOTTOMRIGHT, %WMSZ_TOPRIGHT, %WMSZ_RIGHT
                    'Get dimensions for dialog
                    GetClientRect CB.HNDL, tRect
                    'Save total width
                    RightEdge = tRect.nRight + 4
    
                    'Get new proposed size
                    ptrRECT = CB.LPARAM
    
                    GetWindowRect CB.HNDL, tRect
                    RightEdge = RightEdge + @ptrRECT.nRight - tRect.nRight
                 CASE %WMSZ_BOTTOMLEFT, %WMSZ_TOPLEFT, %WMSZ_LEFT
                    'Get dimensions for dialog
                    GetClientRect CB.HNDL, tRect
                    'Save total width
                    RightEdge = tRect.nRight + 4
    
                    'Get new proposed size
                    ptrRECT = CB.LPARAM
    
                    GetWindowRect CB.HNDL, tRect
                    RightEdge = RightEdge + tRect.nLeft - @ptrRECT.nLeft
                 CASE ELSE
                    'No action required for adjusting height only
              END SELECT
    
           CASE %WM_SIZE
              IF CB.WPARAM = %SIZE_MAXIMIZED THEN
                 'Get dimensions for dialog
                 GetClientRect CB.HNDL, tRect
                 'Save total width
                 RightEdge = tRect.nRight + 4
    
                 RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                     %RDW_INVALIDATE OR %RDW_FRAME OR _
                     %RDW_UPDATENOW OR %RDW_ALLCHILDREN
              END IF
    
           CASE %WM_NCLBUTTONDOWN
              'Mouse cursor is in non-client area
              IF CB.WPARAM = %HTMENU THEN
                 'If last item with focus has not been cleared, clear it
                 IF hTimer THEN
                    KillTimer CB.HNDL, hTimer
                    hTimer = 0
                    FocusItem = 0
                 END IF
              END IF
    
           CASE %WM_NCMOUSEMOVE
               LOCAL MyPoint AS POINT
    
              'Mouse cursor is in non-client area
              IF CB.WPARAM = %HTMENU THEN
                 'WinME, WinNT, Win2k, WinXP
                 'Not sure what the standard focus highlighting behavior is
                 'when the dialog is not active.
                 'Add focus highlighting only if dialog is active...
                 IF ISFALSE DialogIsActive THEN
                    EXIT FUNCTION
                 END IF
    
    
                 'If mouse cursor is over the menubar, check which
                 ' menubar item is under the cursor
                 hMenu = GetMenu( CB.HNDL)
                 FOR I = 0 TO GetMenuItemCount( hMenu) - 1
                    GetMenuItemRect CB.HNDL, hMenu, I, tRect
                    'IF PtInRect( tRect, LO(WORD, CB.LPARAM), HIWRD( CB.LPARAM)) THEN
                    MyPoint.x = LO(WORD, CB.LPARAM)
                    MyPoint.y = HI(WORD, CB.LPARAM)
                    IF PtInRect( tRect, MyPoint) THEN
    
                       'Check if mouse is still over item with focus
                       IF %ODM_BASE_MENUBAR_ITEM_ID +I = FocusItem THEN
                            EXIT FOR
                       END IF
                       K = GetMenuState( hMenu, I, %MF_BYPOSITION)
    
                       'If last item with focus has not been cleared, clear it
                       IF hTimer THEN
                          KillTimer CB.HNDL, hTimer
                          hTimer = 0
                          ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                          hIcon = MenuItemData( Offset-1).hIco
                          'Get RECT of menu item that had focus
                          GetMenuItemRect CB.HNDL, hMenu, FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
                          IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                               hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                           END IF
                          mRestoreMenuItem
                          IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                              DeleteObject hIcon
                          END IF
                       END IF
    
                       'Set focus and remember bounding RECT
                       FocusItem = %ODM_BASE_MENUBAR_ITEM_ID + I
                       GetMenuItemRect CB.HNDL, hMenu, I, FocusRect
    
                       ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                       hIcon = MenuItemData( Offset-1).hIco
                       IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                           hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                       END IF
                       mHighlightMenuItem
                       IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                           DeleteObject hIcon
                       END IF
                       hTimer = SetTimer (CB.HNDL, 1, 100, BYVAL %Null)
                       EXIT FOR
                    END IF
                 NEXT
              END IF
    
           CASE %WM_TIMER
              GetCursorPos pt
              GetMenuItemRect CB.HNDL, _
                GetMenu( CB.HNDL), FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
              IF PtInRect( FocusRect, pt) THEN
                 'Still has focus
              ELSE
                 KillTimer CB.HNDL, hTimer
                 hTimer = 0
                 ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                 hIcon = MenuItemData( Offset-1).hIco
                 K = GetMenuState( GetMenu( CB.HNDL), _
                    FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, %MF_BYPOSITION)
                 IF (LOBYT( LO(WORD, K)) AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                      hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                 END IF
                 mRestoreMenuItem
                 IF (LOBYT( LO(WORD, K)) AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                     DeleteObject hIcon
                 END IF
                 FocusItem = 0
              END IF
    
           CASE %WM_COMMAND
               SELECT CASE CBCTL
                   CASE %IDM_FILE_OPEN
                       hMenu = GetMenu( CB.HNDL)
                       hSubMenu = GetSubMenu( hMenu, 0)  'File sub-menu
                       MENU GET STATE hSubMenu, BYCMD %IDM_FILE_OPEN TO Offset 'Dummy variable
                       Offset = Offset XOR %MF_CHECKED
                       MENU SET STATE hSubMenu, BYCMD %IDM_FILE_OPEN, Offset
                   CASE %IDM_FILE_SAVE
                       MSGBOX "%IDM_FILE_SAVE=" + FORMAT$(%IDM_FILE_SAVE)
                   CASE %IDM_FILE_EXIT
                       MSGBOX "%IDM_FILE_EXIT=" + FORMAT$(%IDM_FILE_EXIT)
                   CASE %IDM_EDIT_CUT
                       MSGBOX "%IDM_EDIT_CUT=" + FORMAT$(%IDM_EDIT_CUT) + $CRLF + _
                              "Disabled Copy & Grayed Paste!"
                       hMenu = GetMenu( CB.HNDL)
                       hSubMenu = GetSubMenu( hMenu, 1)  'Edit sub-menu
                       MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_COPY, %MF_DISABLED
                       MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_PASTE, %MF_GRAYED
                   CASE %IDM_EDIT_COPY
                       MSGBOX "%IDM_EDIT_COPY=" + FORMAT$(%IDM_EDIT_COPY) + $CRLF + _
                              "Disabled Double Nested Test Sub-Menu!"
                       hMenu = GetMenu( CB.HNDL)
                       hSubMenu = GetSubMenu( hMenu, 1)    'Edit sub-menu
                       hSubMenu = GetSubMenu( hSubMenu, 4) 'Sub-Menu Test sub-menu
                       MENU SET STATE hSubMenu, 3, %MF_DISABLED
    
                       'If you modify the top level menu, you must call
                       ' RedrawWindow to force a repaint
                       MENU SET STATE hMenu, 1, %MF_GRAYED
                       MENU SET STATE hMenu, 3, %MF_GRAYED
                       RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                           %RDW_INVALIDATE OR %RDW_FRAME OR  _
                           %RDW_UPDATENOW OR %RDW_ALLCHILDREN
    
                   CASE %IDM_EDIT_PASTE
                       MSGBOX "%IDM_EDIT_PASTE=" + FORMAT$(%IDM_EDIT_PASTE) + $CRLF + _
                              "Enabled Double Nested Test Sub-Menu!"
                       hMenu = GetMenu( CB.HNDL)
                       hSubMenu = GetSubMenu( hMenu, 1)    'Edit sub-menu
                       hSubMenu = GetSubMenu( hSubMenu, 4) 'Sub-Menu Test sub-menu
                       MENU SET STATE hSubMenu, 3, %MF_ENABLED
    
                   CASE %IDM_HELP_HELPTOPICS
                       MSGBOX "%IDM_HELP_HELPTOPICS=" + FORMAT$(%IDM_HELP_HELPTOPICS)
    
                   CASE %IDM_HELP_ABOUT
                       MSGBOX "%IDM_HELP_ABOUT=" + FORMAT$(%IDM_HELP_ABOUT)
    
                   CASE %IDM_EDIT_SUB_COOL
                       MSGBOX "%IDM_EDIT_SUB_COOL=" + FORMAT$(%IDM_EDIT_SUB_COOL) + $CRLF + _
                              "Enabled Copy & Paste!"
                       hMenu = GetMenu( CB.HNDL)
                       hSubMenu = GetSubMenu( hMenu, 1)  'Edit sub-menu
                       MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_COPY, %MF_ENABLED
                       MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_PASTE, %MF_ENABLED
    
                       'If you modify the top level menu, you must call
                       ' RedrawWindow to force a repaint
                       MENU SET STATE hMenu, 1, %MF_ENABLED
                       MENU SET STATE hMenu, 3, %MF_ENABLED
                       RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                        %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
    
                   CASE %IDM_EDIT_SUB_DARE
                       MSGBOX "%IDM_EDIT_SUB_DARE=" + FORMAT$(%IDM_EDIT_SUB_DARE)
               END SELECT
    
           CASE %WM_DESTROY
               IF hTimer THEN
                   KillTimer CB.HNDL, hTimer
               END IF
               DeleteObject hCustomBrush
               DeleteObject hCustomSunkenBrush
               DeleteObject hCustomBkBrush
               DeleteObject hCustomSunkenBkBrush
               DeleteObject hCustomFocusHLBrush
               DeleteObject hCustomFocusSelBrush
       END SELECT
    
    END FUNCTION
    
    
    '--------------------------------------------------------------------------------
    '   ** Menus ** this creates the menu
    '--------------------------------------------------------------------------------
    FUNCTION CreateMenu1(BYVAL hDlg AS DWORD) AS DWORD
    
        LOCAL hMenu AS LONG
        LOCAL hPopUp1 AS LONG
        LOCAL hPopUp2 AS LONG
        LOCAL hPopUp3 AS LONG
    
        MENU NEW BAR TO hMenu
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "Super Fabulous &File Menu", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Open" + $TAB + "Ctrl+O", %IDM_FILE_OPEN, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Save" + $TAB + "Ctrl+S", %IDM_FILE_SAVE, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "-", 0, 0
            MENU ADD STRING, hPopUp1, "&Exit" + $TAB + "Ctrl+E", %IDM_FILE_EXIT, _
                %MF_ENABLED
    
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "&Edit", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "C&ut" + $TAB + "Ctrl+X", %IDM_EDIT_CUT, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Copy" + $TAB + "Ctrl+C", %IDM_EDIT_COPY, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Paste" + $TAB + "Ctrl+V", %IDM_EDIT_PASTE, _
                %MF_GRAYED
            MENU ADD STRING, hPopUp1, "-", 0, 0
    
            MENU NEW POPUP TO hPopUp2
            MENU ADD POPUP, hPopUp1, "&Sub-Menu Test", hPopUp2, %MF_ENABLED
               MENU ADD STRING, hPopUp2, "&Cool", %IDM_EDIT_SUB_COOL, _
                   %MF_ENABLED
               MENU ADD STRING, hPopUp2, "-", 0, 0
               MENU NEW POPUP TO hPopUp3
               MENU ADD POPUP, hPopUp2, "Double &Nested Test", hPopUp3, %MF_ENABLED
                  MENU ADD STRING, hPopUp3, "&Dare to Dream" + _
                    $TAB + "Ctrl+D", %IDM_EDIT_SUB_DARE, _
                      %MF_ENABLED
    
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "&Help", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Help Topics" + $TAB + "F1", _
                %IDM_HELP_HELPTOPICS, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&About" + $TAB + "Ctrl+A", %IDM_HELP_ABOUT, _
                %MF_ENABLED
    
        MENU ATTACH hMenu, hDlg
    
        FUNCTION = hMenu
    
    END FUNCTION
    
    
    
    
    
    
     '--------------------------------------------------------------------------------
    '   ** Accelerators **
    '
    ' No code was modified for accelerators.  This is straight out of PBForms
    '--------------------------------------------------------------------------------
    FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd AS WORD, _
        BYVAL byFVirt AS BYTE) AS LONG
        tAccel.fVirt = byFVirt
        tAccel.key = wKey
        tAccel.cmd = wCmd
    END FUNCTION
    
    
    
    
    FUNCTION AttachACCELERATOR1(BYVAL hDlg AS DWORD) AS DWORD
    
        LOCAL hAccel AS DWORD
        LOCAL tAccel() AS ACCELAPI
        DIM tAccel(1 TO 9)
    
        ASSIGNACCEL tAccel(1), ASC("O"), %IDM_FILE_OPEN, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(2), ASC("S"), %IDM_FILE_SAVE, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(3), ASC("E"), %IDM_FILE_EXIT, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(4), ASC("X"), %IDM_EDIT_CUT, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(5), ASC("C"), %IDM_EDIT_COPY, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(6), ASC("V"), %IDM_EDIT_PASTE, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(7), %VK_F1, %IDM_HELP_HELPTOPICS, %FVIRTKEY OR %FNOINVERT
        ASSIGNACCEL tAccel(8), ASC("A"), %IDM_HELP_ABOUT, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
        ASSIGNACCEL tAccel(9), ASC("D"), %IDM_EDIT_SUB_DARE, %FVIRTKEY OR %FCONTROL OR _
            %FNOINVERT
    
        ACCEL ATTACH hDlg, tAccel() TO hAccel
    
        FUNCTION = hAccel
    
    END FUNCTION
    
    
    
    
    
    
    
    FUNCTION CountItems( BYVAL hMenu AS LONG) AS LONG
    
       REGISTER I AS LONG, K AS LONG
    
       LOCAL hSubMenu AS LONG
    
       FOR K = 0 TO GetMenuItemCount( hMenu) - 1
          INCR I  'Count hMenu item...
          hSubMenu = GetSubMenu( hMenu, K)
          IF hSubMenu THEN I = I + CountItems( hSubMenu) 'Add all nested items for hSubMenu item
       NEXT
    
       FUNCTION = I
    
    END FUNCTION
    
    
    
    SUB ModifySubMenu( BYVAL hDlg AS LONG, _                'Handle of dialog
                       BYVAL hSubMenu AS LONG, _            'Handle to sub-menu
                       BYVAL ptrMID AS MenuItemType PTR, _  'Pointer to MenuItemData array
                       Offset AS LONG, _                    'Current subscript for MenuItemData array
                       SubMenuID AS LONG)                   'Tracks ID# to assign to a sub-menu
    
       REGISTER I AS LONG, K AS LONG
    
       LOCAL MaxAccelTxtWidth AS LONG
       LOCAL Result AS LONG
       LOCAL hf     AS LONG
       LOCAL hDC    AS LONG
       LOCAL SizeA  AS SizeL
       LOCAL ncm    AS NONCLIENTMETRICS
       LOCAL StartingSubMenuOffset AS LONG
       LOCAL zTxt   AS ASCIIZ * %ODM_MAX_STRING
       LOCAL hNestedMenu AS LONG
    
       'Remember where we started...
       StartingSubMenuOffset = Offset + 1
    
       'Loop through all sub-menu items...
       FOR I = 0 TO GetMenuItemCount( hSubMenu) - 1
          'Determine what the sub-menu item is...
          Result = GetMenuState( hSubMenu, I, %MF_BYPOSITION)
          hNestedMenu = GetSubMenu( hSubMenu, I)
    
          IF hNestedMenu THEN
             'Nested sub-menu
             GetMenuString hSubMenu, I, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
             INCR Offset
             @ptrMID[ Offset].wID = SubMenuID
             INCR SubMenuID
             @ptrMID[ Offset].zTxt = zTxt
             SELECT CASE AS CONST$ zTxt
                CASE "&Sub-Menu Test"
                   @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_QUESTION)
                CASE "Double &Nested Test"
                   @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_HAND)
                CASE ELSE
                   'No icons to display
             END SELECT
    
             'Change to %MFT_OWNERDRAW
             ModifyMenu hSubMenu, I, (LOBYT( LO(WORD, Result)) XOR %MF_POPUP) OR _
                 %MF_BYPOSITION OR %MF_OWNERDRAW, @ptrMID[ Offset].wID, BYVAL 0
    
             'Set max accelerator ket text width for all sub-menu items up to now...
             FOR K = StartingSubMenuOffset TO Offset
                @ptrMID[ K].AccelWidth = MaxAccelTxtWidth + _
                 %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING
             NEXT
             'Modify the nested sub-menu...
             ModifySubMenu hDlg, hNestedMenu, ptrMID, Offset, SubMenuID
    
             'Start new block...
             StartingSubMenuOffset = Offset + 1
          ELSE
             IF (Result AND %MF_SEPARATOR) THEN
                'Change %MFT_SEPARATOR to %MFT_OWNERDRAW, maintain ID = 0
                ModifyMenu hSubMenu, I, Result OR %MF_BYPOSITION OR %MF_OWNERDRAW, 0, BYVAL 0
             ELSE
                'Change %MFT_STRING to %MFT_OWNERDRAW,
                ' add icons, calculate width of accelerator key text
                GetMenuString hSubMenu, I, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
                INCR Offset
                @ptrMID[ Offset].wID = GetMenuItemID( hSubMenu, I)
                @ptrMID[ Offset].zTxt = zTxt
    
                'Modify the following SELECT CASE as desired to add icons
                'where you want them.  You can also load icons from a resource file
                SELECT CASE AS LONG @ptrMID[ Offset].wID
                   CASE %IDM_FILE_OPEN
                      @ptrMID[ Offset].hIco  = LoadIcon(0, BYVAL %IDI_EXCLAMATION)
    'Leave out checked icon to test default icon
    'Uncomment to see custom checked icon
    '              @ptrMID[ Offset].hCheckedIco = LoadIcon(0, BYVAL %IDI_HAND)
                   CASE %IDM_EDIT_CUT
                      @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_EXCLAMATION)
                   CASE %IDM_HELP_ABOUT
                      @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_APPLICATION)
                   CASE %IDM_HELP_HELPTOPICS
                      @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_QUESTION)
                   CASE ELSE
                      'No icons to display
                END SELECT
    
                'Change %MFT_STRING to %MFT_OWNERDRAW
                ModifyMenu hSubMenu, I, Result OR %MF_BYPOSITION OR _
                  %MF_OWNERDRAW, @ptrMID[ Offset].wID, BYVAL 0
    
                'Determine width of accelerator key text
                IF INSTR( zTxt, $TAB) THEN
                   zTxt = PARSE$( zTxt, $TAB, 2)   'Get accelerator key text
                   hDC = GetDC( hDlg)
                      ncm.cbSize = LEN( NONCLIENTMETRICS)
                      SystemParametersInfo %SPI_GETNONCLIENTMETRICS, _
                          SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                      IF LEN(ncm.lfMenuFont) THEN
                         hf = CreateFontIndirect(ncm.lfMenuFont)
                         IF hf THEN
                             hf = SelectObject(hDC, hf)
                         END IF
                      END IF
                      GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                      IF sizeA.cx > MaxAccelTxtWidth THEN
                          MaxAccelTxtWidth = sizeA.cx
                      END IF
                      IF hf THEN
                          DeleteObject SelectObject(hDC, hf)
                      END IF
                   ReleaseDC hDlg, hDC
                END IF
             END IF
          END IF
       NEXT
       'Set max accelerator ket text width for all sub-menu items...
       FOR I = StartingSubMenuOffset TO Offset
          @ptrMID[ I].AccelWidth = MaxAccelTxtWidth + _
           %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING
       NEXT
    
    END SUB
    
    function DrawMenuBorder(ByVal hDC as long) as long
    
       LOCAL hWndPopup AS DWORD
       LOCAL trc       AS RECT
       LOCAL hRgn      AS DWORD
       local hBrush    AS long
       LOCAL cxBorder  AS LONG
       LOCAL cyBorder  AS LONG
    
      ' Draw border around popup
      ' ------------------------
      ' We will just draw our border on top of the one drawn by Windows
      hWndPopup   = WindowFromDC(hDC)
      hDC         = GetWindowDC(hWndPopup)
    
      GetWindowRect hWndPopup, trc
      trc.nRight  = trc.nRight - trc.nLeft
      trc.nBottom = trc.nBottom - trc.nTop
      trc.nLeft   = 0
      trc.nTop    = 0
    
      hRgn = CreateRectRgnIndirect(trc)
      SelectClipRgn hDC, hRgn
      hBrush = GetSysColorBrush(%COLOR_3DDKSHADOW)
      cxBorder = GetSystemMetrics(%SM_CXFIXEDFRAME)
      cyBorder = GetSystemMetrics(%SM_CYFIXEDFRAME)
      FrameRgn hDC, hRgn, hBrush, cxBorder, cyBorder
    
      SelectClipRgn hDC, %NULL
      DeleteObject hRgn
      ReleaseDC hWndPopup, hDC
    end function
    
    ​
    So here we are, this is the end.
    But all that dies, is born again.
    - From The Ashes (In This Moment)

  • #2
    Reply and further discussions here - https://forum.powerbasic.com/forum/u...rce-code-forum

    Comment

    Working...
    X