Announcement

Collapse
No announcement yet.

Owner draw popup menu with double border - how to?

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

  • Owner draw popup menu with double border - how to?

    Hi All,

    I found this interesting program at the https://forum.powerbasic.com/forum/u...887#post785887

    by Bernard Ertl and Jim Fritts which does Owner draw menu.

    It has a white thick borders as shown below, how did they do this border ?

    Click image for larger version

Name:	White borders.PNG
Views:	178
Size:	53.7 KB
ID:	802029




  • #2
    the program is listed below, any help is much appreciated --- wish that a forum member can help me to
    locate the code portion that draw the white double border as I need this for another program.

    Could be a Menu style that they use?


    Code:
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24067-owner-drawn-menu-bar-completely-customizable?p=785887#post785887
    
    
    '************************************************************************
    '* 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
    
    #COMPILE EXE
    #DIM ALL
    
    '--------------------------------------------------------------------------------
    '   ** Includes **
    '--------------------------------------------------------------------------------
        #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
    
    'These constants enumerate the different possible Windows OS platforms
    %WinUnknown      = 0
    %Win95           = 1
    %Win98           = 2
    %WinME           = 3
    %WinNT           = 4
    %Win2K           = 5  ' this is the latest OS Windows 10
    %WinXP           = 6
    %WinDotNetServer = 7
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** 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 OSVersion          AS LONG
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** Declarations **
    '--------------------------------------------------------------------------------
    DECLARE FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
    DECLARE FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd _
        AS WORD, BYVAL byFVirt AS BYTE) AS LONG
    DECLARE FUNCTION AttachACCELERATOR1(BYVAL hDlg AS DWORD) AS DWORD
    DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
    DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    DECLARE FUNCTION GetWindowsVersion() AS LONG
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** PBMAIN **
    '--------------------------------------------------------------------------------
    FUNCTION PBMAIN()
    
        LOCAL dm AS DEVMODE
        LOCAL OSVO AS OSVersionInfo
        DIM GetColorFor( 1)
    
        'Get Current OS Version
        'Note: You can force a behavior style by explicitly assigning an equate to OSVersion
        OSVersion = GetWindowsVersion()  '%WinXP
    
        '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
        SELECT CASE AS LONG OSVersion
           CASE %WinXP
              GetColorFor(0).BkFocusHighlight  = GetColorFor(0).BkHighlight
              GetColorFor(0).BkFocusSelect     = GetColorFor(0).BkFaceSunken
           CASE ELSE
              GetColorFor(0).BkFocusHighlight  = GetColorFor(0).BkHighlight
              GetColorFor(0).BkFocusSelect     = GetColorFor(0).BkHighlight
        END SELECT
        GetColorFor(0).TxDefault         = GetSysColor( %COLOR_MENUTEXT)
        GetColorFor(0).TxGrayed          = &H00505050  'Dark Gray
        GetColorFor(0).TxHighlighted     = GetSysColor( %COLOR_HIGHLIGHTTEXT) 'To match the sub-menu arrow graphic
    
        'Set colors for 16 bit/High Color or better
        GetColorFor(1).BkFace            = RGB( 200, 200, 152)
        GetColorFor(1).BkFaceSunken      = RGB( 220, 220, 188)
        GetColorFor(1).BkHighlight       = RGB( 173, 173, 101)
        GetColorFor(1).BkHighlightSunken = RGB( 187, 187, 128)
        SELECT CASE AS LONG OSVersion
           CASE %WinXP
              GetColorFor(1).BkFocusHighlight  = RGB(159, 220, 133)
              GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkFaceSunken
           CASE ELSE
              GetColorFor(1).BkFocusHighlight  = GetColorFor(1).BkHighlight
              GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkHighlight
        END SELECT
        GetColorFor(1).TxDefault         = GetSysColor( %COLOR_MENUTEXT)
        GetColorFor(1).TxGrayed          = GetSysColor( %COLOR_GRAYTEXT)
        GetColorFor(1).TxHighlighted     = GetSysColor( %COLOR_HIGHLIGHTTEXT) 'To match the sub-menu arrow graphic
    
        '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
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** 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
            SELECT CASE AS LONG OSVersion
               CASE %WinXP
                  'Calculate a darker shade of the focus color for the frame
                  I = GetColorFor( CurrentDisplayMode).BkFocusHighlight
                  !xor edx, edx  'clear edx
                  !mov eax, I
                  !shr eax, 18   'divide blue value by 4
                  !mov dl, al
                  !shl edx, 16
                  !mov eax, I
                  !shr ah, 2     'divide green value by 4
                  !shr al, 2     'divide blue value by 4
                  !mov dx, ax
                  !mov I, edx
                  hf = SelectObject( hDC, CreatePen( %PS_SOLID, 0, I))
                  'Draw frame using custom colored pen
                  MoveToEx hDC, tRect.nLeft, tRect.nTop, BYVAL 0
                  LineTo hDC, tRect.nRight-1, tRect.nTop
                  LineTo hDC, tRect.nRight-1, tRect.nBottom-1
                  LineTo hDC, tRect.nLeft, tRect.nBottom-1
                  LineTo hDC, tRect.nLeft, tRect.nTop
    
                  DeleteObject SelectObject( hDC, CreatePen( %PS_SOLID, 0, GetColorFor( CurrentDisplayMode).BkFocusHighlight))
                  FOR I = 1 TO ((tRect.nBottom - tRect.nTop) * (tRect.nRight - tRect.nLeft)) \ 2
                     DO
                        pt.x = RND( tRect.nLeft+1, tRect.nRight-1)
                     LOOP UNTIL pt.x MOD 2
                     DO
                        pt.y = RND( tRect.nTop+1, tRect.nBottom-1)
                     LOOP UNTIL pt.y MOD 2
                     MoveToEx hDC, pt.x, pt.y, BYVAL 0
                     LineTo hDC, pt.x+1, pt.y
                  NEXT
                  DeleteObject SelectObject( hDC, hf)
    
                  SetTextColor hDC, GetColorFor( CurrentDisplayMode).TxDefault
                  SetBkMode hDC, %TRANSPARENT
    
                  strMenu = MenuItemData( Offset-1).zTxt
    
                  IF LEN( strMenu) <> 0 THEN
                     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
                     t2Rect = tRect
                     'Adjust for offset
                     DECR t2Rect.nTop
                     DECR t2Rect.nBottom
                     IF MenuItemData( Offset-1).hIco THEN
                        t2Rect.nLeft = t2Rect.nLeft + _
                         %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING\2 - 2  'Leave room for icons
                     ELSE
                        'When no icon in top level, adjust RECT
                        t2Rect.nLeft = t2Rect.nLeft - 2
                     END IF
                     DrawText hDC, BYVAL STRPTR(strMenu), LEN(strMenu),_
                         t2Rect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                     IF hf THEN DeleteObject SelectObject(hDC, hf)
                  END IF
               CASE %Win98
                  DrawEdge hDC, tRect, %BDR_RAISEDOUTER, %BF_RECT
               CASE ELSE
                   'WinME, WinNT, Win2k --- I'm not sure what the
                   ' standard focus highlighting is for these OSes
                  DrawEdge hDC, tRect, %BDR_RAISEDOUTER, %BF_RECT
            END SELECT
            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
            SELECT CASE AS LONG OSVersion
               CASE %WinXP
                  FillRect hDC, tRect, hCustomBrush
    
                  SetTextColor hDC, GetColorFor( CurrentDisplayMode).TxDefault
                  SetBkMode hDC, %TRANSPARENT
    
                  strMenu = MenuItemData( Offset-1).zTxt
    
                  IF LEN( strMenu) <> 0 THEN
                     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
                     t2Rect = tRect
                     'Adjust for offset
                     DECR t2Rect.nTop
                     DECR t2Rect.nBottom
                     IF MenuItemData( Offset-1).hIco THEN
                        t2Rect.nLeft = t2Rect.nLeft + %ODM_ICON_IN_MENU_WIDTH + _
                         %ODM_MARGIN_SPACING\2 - 2  'Leave room for icons
                     ELSE
                        'When no icon in top level, adjust RECT
                        t2Rect.nLeft = t2Rect.nLeft - 2
                     END IF
                     DrawText hDC, BYVAL STRPTR(strMenu), LEN(strMenu), t2Rect,_
                         %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                     IF hf THEN DeleteObject SelectObject(hDC, hf)
                  END IF
               CASE %Win98
                  FrameRect hDC, tRect, hCustomBrush
               CASE ELSE
                   'WinME, WinNT, Win2k --- I'm not sure what
                   'the standard focus highlighting is for these OSes
                  FrameRect hDC, tRect, hCustomBrush
            END SELECT
            '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
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** Menus **
    '--------------------------------------------------------------------------------
    FUNCTION AttachMENU1(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
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** Support Procs **
    '--------------------------------------------------------------------------------
    FUNCTION GetWindowsVersion() AS LONG
       'This function courtesy of Scott Turchin.  I've modified it for this code.
       'Original posting can be found here:
       'http://www.powerbasic.com/support/forums/Forum4/HTML/002310.html
    
       LOCAL osinfo   AS OSVERSIONINFO
    
       osinfo.dwOsVersionInfoSize = SIZEOF(osinfo)
    
       IF ISFALSE GetVersionEx( osinfo) THEN EXIT FUNCTION ' Function = %WinUnknown
    
       IF osinfo.dwPlatformId = %VER_PLATFORM_WIN32_NT THEN
          SELECT CASE AS LONG osinfo.dwMajorVersion
             CASE < 5
                FUNCTION = %WinNT
             CASE 5
                SELECT CASE AS LONG osinfo.dwMinorVersion
                   CASE 0
                      FUNCTION = %Win2K
                   CASE 1
                      FUNCTION = %WinXP
                   CASE 2
                      FUNCTION = %WinDotNetServer
                END SELECT
          END SELECT
       ELSEIF osinfo.dwPlatformId = %VER_PLATFORM_WIN32_WINDOWS THEN
          SELECT CASE AS LONG osinfo.dwMinorVersion
             CASE < 10
                FUNCTION = %Win95
             CASE 10
                FUNCTION = %Win98
             CASE 90
                FUNCTION = %WinME
          END SELECT
       END IF
    
    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
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** 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
              SELECT CASE AS LONG OSVersion
                 CASE %Win95
                    'No need to repaint menubar - it always uses default text color
    
                 CASE %Win98
                    IF DialogIsActive THEN
                        RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR _
                        %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
                     END IF
    
                 CASE ELSE
                     '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
              END SELECT
    
           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 CB.WPARAM = 0 THEN
                   'if identifier is 0, message was sent by a menu
                  lpdis = CB.LPARAM
    
                  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
    
                        SELECT CASE AS LONG OSVersion
                           CASE %Win95
                              Offset = -1  'Do not "click" a "button"
                              IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                                 'Paint custom background...
                                 FillRect @lpdis.hDC, tRect, hCustomBkBrush
                              ELSE
                                 'Paint custom background...
                                 FillRect @lpdis.hDC, tRect, hCustomBrush
                              END IF
    
                           CASE %WinXP
                              IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                                 'Paint custom focus background...
                                 FillRect @lpdis.hDC, tRect, hCustomFocusSelBrush
                                 'Standard Windows XP focus framing
                                 hf = SelectObject( @lpdis.hDC, _
                                     CreatePen( %PS_SOLID, 0, GetColorFor( CurrentDisplayMode).TxDefault))
                                 'Draw frame using custom colored pen
                                 MoveToEx @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nTop, BYVAL 0
                                 LineTo @lpdis.hDC, @lpdis.rcItem.nRight-1, @lpdis.rcItem.nTop
                                 LineTo @lpdis.hDC, @lpdis.rcItem.nRight-1, @lpdis.rcItem.nBottom-1
                                 LineTo @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nBottom-1
                                 LineTo @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nTop
                                 DeleteObject SelectObject( @lpdis.hDC, hf)
                              ELSE
                                 Offset = -1  'Offset for text to move it when "button" is NOT "clicked"
                                 'Paint custom background...
                                 FillRect @lpdis.hDC, tRect, hCustomBrush
                              END IF
    
                           CASE %Win98
                              '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
    
    
                           CASE ELSE
                               ' 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
                        END SELECT
    
                        IF ISTRUE DialogIsActive OR OSVersion = %Win95 THEN
                           'Win95 does not gray text for disabled dialogs....
                           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  'GetSysColorBrush( %COLOR_HIGHLIGHT)
                           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
                        tRect.nRight = tRect.nLeft + 19  'A total width of 20 pixels, 16 for icon, 4 for margins
                        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
                        DECR tRect.nRight
                        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
                              tRect.nLeft = @lpdis.rcItem.nleft + _
                                   %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING\2 + Offset*2  'Leave room for icons
                              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
                           ELSE
                              'When no icon in top level, adjust RECT
                              tRect.nLeft = @lpdis.rcItem.nleft + Offset*2  'Leave room for icons
                              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
                 SELECT CASE AS LONG OSVersion
                    CASE %Win95
                       'No focus highlighting for Win95
                       EXIT FUNCTION
                    CASE %Win98
                       'Maintain focus highlighting whether dialog is active or not
                    CASE ELSE
                        '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
                 END SELECT
                 '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
    '--------------------------------------------------------------------------------
    
    
    '--------------------------------------------------------------------------------
    '   ** 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, 302, 172, %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
    
        AttachMENU1 hDlg
    
        AttachACCELERATOR1 hDlg
    
        DIALOG SET COLOR hDlg, GetColorFor( CurrentDisplayMode).TxDefault, _
              GetColorFor( CurrentDisplayMode).BkFace
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
        FUNCTION = lRslt
    
    END FUNCTION
    Last edited by Tim Lakinir; 15 Nov 2020, 03:19 PM.

    Comment


    • #3
      Analysing the code and working out for yourself how the borders are handled would be an excellent learning experience.(Hint: searching the code for the word "border" is a good place to start)

      Comment


      • #4
        Test question: Do they draw a border or is the only part that is not "fill"ed ?

        Comment


        • #5
          Thank you Stuart, maybe they are using DrawEdge function, as this function can produce raised or sunken edges of the border?

          Comment


          • #6
            I commented out every DrawEdge statements in the program and yet the program still draws those white borders, so it is not DrawEdge

            Comment


            • #7
              Originally posted by Tim Lakinir View Post
              I commented out every DrawEdge statements in the program and yet the program still draws those white borders, so it is not DrawEdge
              I repeat: Do they draw a border or is the only part that is not "fill"ed ?

              Comment


              • #8
                Thank you Stuart found it at

                Code:
                INCR tRect.nTop
                INCR tRect.nLeft
                DECR tRect.nRight
                DECR tRect.nBottom
                IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                FillRect @lpdis.hDC, tRect, hCustomSunkenBkBrush
                ELSE
                FillRect @lpdis.hDC, tRect, hCustomSunkenBrush
                END IF

                Comment


                • #9
                  Below is my rendition of the menu program with better colors and I had removed unneccessary checks on OS

                  Code:
                  ' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24067-owner-drawn-menu-bar-completely-customizable?p=785887#post785887
                  
                  
                  '************************************************************************
                  '* 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
                  
                  
                  '--------------------------------------------------------------------------------
                  '   ** 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_AZURE
                      GetColorFor(1).BkFaceSunken      = RGB( 220, 220, 188)
                      GetColorFor(1).BkHighlight       = %RGB_LIGHTSKYBLUE
                  
                      GetColorFor(1).BkHighlightSunken = RGB( 187, 187, 128)
                  
                  
                      GetColorFor(1).BkFocusHighlight  = GetColorFor(1).BkHighlight
                      GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkHighlight
                  
                      GetColorFor(1).TxDefault         = %RGB_MEDIUMBLUE
                      GetColorFor(1).TxGrayed          = GetSysColor( %COLOR_GRAYTEXT)
                      GetColorFor(1).TxHighlighted     = %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 CB.WPARAM = 0 THEN
                               'if identifier is 0, message was sent by a menu
                                lpdis = CB.LPARAM
                  
                                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

                  Comment


                  • #10
                    Originally posted by Tim Lakinir View Post
                    Thank you Stuart found it at

                    Code:
                    INCR tRect.nTop
                    INCR tRect.nLeft
                    DECR tRect.nRight
                    DECR tRect.nBottom
                    IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                    FillRect @lpdis.hDC, tRect, hCustomSunkenBkBrush
                    ELSE
                    FillRect @lpdis.hDC, tRect, hCustomSunkenBrush
                    END IF
                    Great! You've learnt something.

                    Now wasn't that much better than just being spoonfed an answer?

                    Comment


                    • #11
                      If you are explicitly drawing the borders using something like the Rectangle() or LineTo() functions, you can vary the width of the line by creating a pen (CreatePen()) with a different width.

                      Some of the functions provided by the Windows' API, like DrawEdge() or DrawFrameControl(), use "system settings" for pen width, but by using the drawing primitives (aka the "Real Men" version of "owner-drawn!") you are limited only by your imagination.

                      MCM
                      Michael Mattias
                      Tal Systems Inc. (retired)
                      Racine WI USA
                      [email protected]
                      http://www.talsystems.com

                      Comment


                      • #12
                        Originally posted by Michael Mattias View Post
                        If you are explicitly drawing the borders using something like the Rectangle() or LineTo() functions, you can vary the width of the line by creating a pen (CreatePen()) with a different width.

                        Some of the functions provided by the Windows' API, like DrawEdge() or DrawFrameControl(), use "system settings" for pen width, but by using the drawing primitives (aka the "Real Men" version of "owner-drawn!") you are limited only by your imagination.

                        MCM
                        You mean like this part of Tim's code where he does exactly that?
                        Code:
                        hf = SelectObject( hDC, CreatePen( %PS_SOLID, 0, I))
                        'Draw frame using custom colored pen
                        MoveToEx hDC, tRect.nLeft, tRect.nTop, BYVAL 0
                        LineTo hDC, tRect.nRight-1, tRect.nTop
                        LineTo hDC, tRect.nRight-1, tRect.nBottom-1
                        LineTo hDC, tRect.nLeft, tRect.nBottom-1
                        LineTo hDC, tRect.nLeft, tRect.nTop
                        An expression about grandmothers and eggs come to mind

                        Comment


                        • #13
                          oops... duplicated! Something "glitched:" somewhere!
                          Michael Mattias
                          Tal Systems Inc. (retired)
                          Racine WI USA
                          [email protected]
                          http://www.talsystems.com

                          Comment


                          • #14
                            An expression about grandmothers and eggs come to mind
                            No expressions, sayings, old saws or proverbs coming to mind, I checked with Google(r) and found this...
                            Teaching (your) grandmother to suck eggs is an English language saying that refers to a person giving advice to another person in a subject with which the other person is already familiar (and probably more so than the first person).
                            .. and assume that is the saying to which you refer.

                            However, I wanted to answer the question as asked in post #1 (It has a white thick borders as shown below, how did they do this border ?") without asking members to read every line of code posted in this thread and infer it. (Especially when some of the code uses non-PowerBASIC verbs and statements).

                            FWIW, the InflateRect() function can be used to create a uniform border around - or withing - a rectangle, which if used here would have elimintated the need to DECR the rectangle coordinates in the referenced code.

                            MCM


                            Michael Mattias
                            Tal Systems Inc. (retired)
                            Racine WI USA
                            [email protected]
                            http://www.talsystems.com

                            Comment


                            • #15
                              Code:
                              DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH Or %DFCS_PUSHED OR %DFCS_MONO
                              %dfcs_mono makes a border you can color it

                              Comment


                              • #16
                                Thanks to Borje Hagsten Pierre Bellisle Tim Lakinir for basicroutine

                                iF YOU LOOK THIS UP THERE ARE ALL KINDS OF FLAGS AND STYLES AND YOU CAN ENTER OR USE IT MANY TIMES
                                IN MY DRAWITEM I PLACED IT SEVERAL PLACES SO IT WOULD BE THERE ON MOUSE OVER AND MOUSE CLICK'
                                Code:
                                DrawEdge @lpDis.hDC, @lpDis.rcItem, %BDR_RAISEDINNER OR %BDR_RAISEDOUTER OR %EDGE_RAISED, %BF_RECT
                                DrawEdge @lpDis.hDC, @lpDis.rcItem, %BDR_RAISEDINNER OR %BDR_RAISEDOUTER OR %EDGE_RAISED, %BF_RECT
                                @lpDis.rcItem YOU PROBALY CAN CHANGE THE WIDTH. It uses the rectangle size

                                WINDOWS NT WIN32API SUPERBIBLE by Richard J Simon SAYS.
                                Draw one or more edges of a rectangle. The edges are drawn using 3d effects'
                                use before edge draw
                                B = button
                                M = menu
                                P = popup - aka submenu
                                [/code]


                                IF BMP = "B" THEN
                                DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH Or %DFCS_PUSHED OR %DFCS_MONO ' on click
                                ELSEIF BMP = "M" THEN
                                DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_MENU, %DFCS_MONO ' on click
                                ELSEIF BMP = "P" THEN
                                DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_popupmenu, %DFCS_MONO
                                END IF


                                control handle cb.hndl, %BUT_File to hButton
                                control handle cb.hndl, %BUT_Help to lButton
                                HMENU = colorsubmenu(CBLPARAM)
                                Control Handle CB.Hndl, %BUT_FILE To mButton
                                ' CONTROL HANDLE CB.HNDL, %BUT_HELP TO NBUTTON


                                case %wm_drawitem
                                if cb.wparam = %BUT_File then
                                DrawButton2 "B", hButton, cb.lparam, FC, BC, bg, Txtt, brd
                                end if

                                if cb.wparam = %BUT_Help then
                                DrawButton2 "B", lButton, cb.lparam, FC, BC, bg, Txtt, brd

                                end if
                                ' if cb.wparam = %IDM_FILE_NEW then
                                ' DrawButton lButton, cb.lparam, FC, BC, bg, Txtt, brd
                                ' end if

                                ' DRAWMENU(CBWPARAM, CBLPARAM)
                                if cb.wparam = 0 then
                                DrawButton2 "M", MBUTTON, cb.lparam, FC, BC, bg, Txtt, brd

                                ' DrawButton2 "P", MBUTTON, cb.lparam, FC, BC, bg, Txtt, brd
                                end if
                                if cb.wparam = 0 then
                                ' ' DrawButton2 MBUTTON, cb.lparam, FC, BC, bg, Txtt, brd
                                ' DrawButton2 NBUTTON, cb.lparam, FC, BC, bg, Txtt, brd
                                ' end if


                                [code]
                                it colors the menu bar all submenu items


                                Thanks

                                Comment

                                Working...
                                X