Announcement

**Eros Olmi** · 5 Feb 2008, 11:31 AM

This post is incomplete. Maybe due to passing to new forum.
Any chance to have it complete?

Thanks a lot
Eros

**Mark Smit** · 5 Feb 2008, 07:36 PM

Copied from POFFS

Code:

'************************************************************************
'* ODrawMenu                                                            *
'*     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.                                                            *
'************************************************************************

#COMPILE EXE
#DIM ALL

'--------------------------------------------------------------------------------
'   ** Includes **
'--------------------------------------------------------------------------------
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** 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
%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 CBHNDL, 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( CBHNDL)
        '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
                 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
        ReleaseDC CBHNDL, hDC

END MACRO

MACRO mRestoreMenuItem

        GetWindowRect CBHNDL, 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( CBHNDL)
        '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
        ReleaseDC CBHNDL, 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( LOWRD( 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
                  GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                  IF sizeA.cx > MaxAccelTxtWidth THEN MaxAccelTxtWidth = sizeA.cx
                  IF hf THEN DeleteObject SelectObject(hDC, hf)
               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 CBMSG
       CASE %WM_INITDIALOG
           'Initialize var
           DialogIsActive = %True

           'Get starting dimensions for dialog
           GetClientRect CBHNDL, 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( CBHNDL)

           '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 CBHNDL, 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 = CBLPARAM
           'Set the minimum dialog width to avoid incorrect painting of multi-line top level menubar
           @mminfo.ptMinTrackSize.x = Border + 16

       CASE %WM_NCACTIVATE
          DialogIsActive = CBWPARAM
          SELECT CASE AS LONG OSVersion
             CASE %Win95
                'No need to repaint menubar - it always uses default text color
             CASE %Win98
                IF DialogIsActive THEN RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
             CASE ELSE  'WinME, WinNT, Win2k, WinXP --- I assume these OSes gray text for dialogs without focus
                IF DialogIsActive THEN RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
          END SELECT

       CASE %WM_DISPLAYCHANGE
           NewColorMode = IIF&( CBWPARAM > 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  CBHNDL, GetColorFor( CurrentDisplayMode).TxDefault, GetColorFor( CurrentDisplayMode).BkFace
              RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
           END IF

       CASE %WM_MEASUREITEM
           IF CBWPARAM = 0 THEN  'a menu is calling
              lpmis = CBLPARAM

              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( CBHNDL)
                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)
              ReleaseDC CBHNDL, hDC
              FUNCTION = 1
           END IF

       CASE %WM_DRAWITEM
           IF CBWPARAM = 0 THEN           'if identifier is 0, message was sent by a menu
              lpdis = CBLPARAM

              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  'WinME, WinNT, Win2k --- Look like 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
                    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( CBHNDL)) - 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    'GetSysColorBrush( %COLOR_MENU)
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                    ELSE
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush    'GetSysColorBrush( %COLOR_MENU)
                       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)
                          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)
                          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
              ELSE
                 'Draw a separator
                 'Sub-level Menu
                 FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush 'GetSysColorBrush(%COLOR_MENU)
                 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 CBWPARAM
             CASE %WMSZ_BOTTOMRIGHT, %WMSZ_TOPRIGHT, %WMSZ_RIGHT
                'Get dimensions for dialog
                GetClientRect CBHNDL, tRect
                'Save total width
                RightEdge = tRect.nRight + 4

                'Get new proposed size
                ptrRECT = CBLPARAM

                GetWindowRect CBHNDL, tRect
                RightEdge = RightEdge + @ptrRECT.nRight - tRect.nRight
             CASE %WMSZ_BOTTOMLEFT, %WMSZ_TOPLEFT, %WMSZ_LEFT
                'Get dimensions for dialog
                GetClientRect CBHNDL, tRect
                'Save total width
                RightEdge = tRect.nRight + 4

                'Get new proposed size
                ptrRECT = CBLPARAM

                GetWindowRect CBHNDL, tRect
                RightEdge = RightEdge + tRect.nLeft - @ptrRECT.nLeft
             CASE ELSE
                'No action required for adjusting height only
          END SELECT

       CASE %WM_SIZE
          IF CBWPARAM = %SIZE_MAXIMIZED THEN
             'Get dimensions for dialog
             GetClientRect CBHNDL, tRect
             'Save total width
             RightEdge = tRect.nRight + 4

             RedrawWindow CBHNDL, 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 CBWPARAM = %HTMENU THEN
             'If last item with focus has not been cleared, clear it
             IF hTimer THEN
                KillTimer CBHNDL, hTimer
                hTimer = 0
                FocusItem = 0
             END IF
          END IF

       CASE %WM_NCMOUSEMOVE
          'Mouse cursor is in non-client area
          IF CBWPARAM = %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 SELECT
             'If mouse cursor is over the menubar, check which menubar item is under the cursor
             hMenu = GetMenu( CBHNDL)
             FOR I = 0 TO GetMenuItemCount( hMenu) - 1
                GetMenuItemRect CBHNDL, hMenu, I, tRect
                IF PtInRect( tRect, LOWRD( CBLPARAM), HIWRD( CBLPARAM)) THEN

                   'Check if mouse is still over item with focus
                   IF %ODM_BASE_MENUBAR_ITEM_ID +I = FocusItem THEN EXIT FOR

                   K = GetMenuState( hMenu, I, %MF_BYPOSITION)

                   'If last item with focus has not been cleared, clear it
                   IF hTimer THEN
                      KillTimer CBHNDL, 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 CBHNDL, hMenu, FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
                      IF (LOBYT( LOWRD( K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                      mRestoreMenuItem
                      IF (LOBYT( LOWRD( K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN DeleteObject hIcon
                   END IF

                   'Set focus and remember bounding RECT
                   FocusItem = %ODM_BASE_MENUBAR_ITEM_ID + I
                   GetMenuItemRect CBHNDL, hMenu, I, FocusRect

                   ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                   hIcon = MenuItemData( Offset-1).hIco
                   IF (LOBYT( LOWRD( K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                   mHighlightMenuItem
                   IF (LOBYT( LOWRD( K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN DeleteObject hIcon

                   hTimer = SetTimer (CBHNDL, 1, 100, BYVAL %Null)
                   EXIT FOR
                END IF
             NEXT
          END IF

       CASE %WM_TIMER
          GetCursorPos pt
          GetMenuItemRect CBHNDL, GetMenu( CBHNDL), FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
          IF PtInRect( FocusRect, pt.x, pt.y) THEN
             'Still has focus
          ELSE
             KillTimer CBHNDL, hTimer
             hTimer = 0
             ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
             hIcon = MenuItemData( Offset-1).hIco
             K = GetMenuState( GetMenu( CBHNDL), FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, %MF_BYPOSITION)
             IF (LOBYT( LOWRD( K)) AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
             mRestoreMenuItem
             IF (LOBYT( LOWRD( K)) AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN DeleteObject hIcon
             FocusItem = 0
          END IF

       CASE %WM_COMMAND
           SELECT CASE CBCTL
               CASE %IDM_FILE_OPEN
                   hMenu = GetMenu( CBHNDL)
                   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( CBHNDL)
                   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( CBHNDL)
                   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 CBHNDL, 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( CBHNDL)
                   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( CBHNDL)
                   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 CBHNDL, 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 CBHNDL, hTimer
           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
'--------------------------------------------------------------------------------

**Eros Olmi** · 6 Feb 2008, 07:05 AM

Thanks a lot!

**Gustavo Asplanatti** · 7 Sep 2011, 09:07 AM

PB10 & WinXP problem

I have tried to use the code with the following combination: PB10 and Win XP and after solving some problems with an API declaration (PtInRect), the program does not work correctly, but specifically in the size of the characters of the menu.
The following combinations work correctly:
PB9 & WinXP = OK
PB9 & Win Seven = OK
PB10 & Win Seven = OK

It possible to solve this problem? Somebody can help me? :confused2:

**Ford Peterson** · 17 Sep 2011, 09:25 PM

Originally posted by Gustavo Asplanatti View Post

I have tried to use the code with the following combination: PB10 and Win XP and after solving some problems with an API declaration (PtInRect), the program does not work correctly, but specifically in the size of the characters of the menu.
The following combinations work correctly:
PB9 & WinXP = OK
PB9 & Win Seven = OK
PB10 & Win Seven = OK

It possible to solve this problem? Somebody can help me? :confused2:

No solutions. Only that I have 100% replicated the issue on my machine. E.g. Win7 running PB 10. Move it to XP and it's broken text.

**José Roca** · 18 Sep 2011, 02:44 PM

If the OS is XP, instead of

Code:

ncm.cbSize = LEN( NONCLIENTMETRICS)

use

Code:

ncm.cbSize = 340.

The NONCLIENTMETRICS structure has a size of 340 bytes in XP and below and of 344 bytes in Vista and Windows 7.

**José Roca** · 18 Sep 2011, 02:49 PM

When using PB9 and its includes, you're using this definition:

Code:

TYPE NONCLIENTMETRICS
  cbSize AS DWORD
  iBorderWidth AS LONG
  iScrollWidth AS LONG
  iScrollHeight AS LONG
  iCaptionWidth AS LONG
  iCaptionHeight AS LONG
  lfCaptionFont AS LOGFONT
  iSMCaptionWidth AS LONG
  iSMCaptionHeight AS LONG
  lfSMCaptionFont AS LOGFONT
  iMenuWidth AS LONG
  iMenuHeight AS LONG
  lfMenuFont AS LOGFONT
  lfStatusFont AS LOGFONT
  lfMessageFont AS LOGFONT
END TYPE

When using PB10 and it's includes, you're using:

Code:

TYPE NONCLIENTMETRICSA
    cbSize             AS DWORD
    iBorderWidth       AS LONG
    iScrollWidth       AS LONG
    iScrollHeight      AS LONG
    iCaptionWidth      AS LONG
    iCaptionHeight     AS LONG
    lfCaptionFont      AS LOGFONTA
    iSmCaptionWidth    AS LONG
    iSmCaptionHeight   AS LONG
    lfSmCaptionFont    AS LOGFONTA
    iMenuWidth         AS LONG
    iMenuHeight        AS LONG
    lfMenuFont         AS LOGFONTA
    lfStatusFont       AS LOGFONTA
    lfMessageFont      AS LOGFONTA
#IF (%WINVER >= &H0600)
    iPaddedBorderWidth AS LONG
#ENDIF ' %WINVER >= &H0600
END TYPE

TYPE NONCLIENTMETRICSW
    cbSize             AS DWORD
    iBorderWidth       AS LONG
    iScrollWidth       AS LONG
    iScrollHeight      AS LONG
    iCaptionWidth      AS LONG
    iCaptionHeight     AS LONG
    lfCaptionFont      AS LOGFONTW
    iSmCaptionWidth    AS LONG
    iSmCaptionHeight   AS LONG
    lfSmCaptionFont    AS LOGFONTW
    iMenuWidth         AS LONG
    iMenuHeight        AS LONG
    lfMenuFont         AS LOGFONTW
    lfStatusFont       AS LOGFONTW
    lfMessageFont      AS LOGFONTW
#IF (%WINVER >= &H0600)
    iPaddedBorderWidth AS LONG
#ENDIF ' %WINVER >= &H0600
END TYPE

#IF %DEF(%UNICODE)
TYPE NONCLIENTMETRICS
    NONCLIENTMETRICSW
END TYPE
#ELSE
TYPE NONCLIENTMETRICS
    NONCLIENTMETRICSA
END TYPE
#ENDIF ' UNICODE

**Jim Fritts** · 16 Oct 2019, 11:18 PM

Modified 2019-OCT-16 by: Jim Fritts to work in PBWIN10.4 and J. Roca headers

Code:

'************************************************************************
'* ODrawMenu                                                            *
'*     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 **
'--------------------------------------------------------------------------------
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** 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
%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 CBHNDL, 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( CBHNDL)
        '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
                 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
        ReleaseDC CBHNDL, hDC

END MACRO

MACRO mRestoreMenuItem

        GetWindowRect CBHNDL, 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( CBHNDL)
        '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
        ReleaseDC CBHNDL, 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
                  GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                  IF sizeA.cx > MaxAccelTxtWidth THEN MaxAccelTxtWidth = sizeA.cx
                  IF hf THEN DeleteObject SelectObject(hDC, hf)
               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 CBMSG
       CASE %WM_INITDIALOG
           'Initialize var
           DialogIsActive = %True

           'Get starting dimensions for dialog
           GetClientRect CBHNDL, 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( CBHNDL)

           '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 CBHNDL, 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 = CBLPARAM
           'Set the minimum dialog width to avoid incorrect painting of multi-line top level menubar
           @mminfo.ptMinTrackSize.x = BORDER + 16

       CASE %WM_NCACTIVATE
          DialogIsActive = CBWPARAM
          SELECT CASE AS LONG OSVersion
             CASE %Win95
                'No need to repaint menubar - it always uses default text color
             CASE %Win98
                IF DialogIsActive THEN RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
             CASE ELSE  'WinME, WinNT, Win2k, WinXP --- I assume these OSes gray text for dialogs without focus
                IF DialogIsActive THEN RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
          END SELECT

       CASE %WM_DISPLAYCHANGE
           NewColorMode = IIF&( CBWPARAM > 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  CBHNDL, GetColorFor( CurrentDisplayMode).TxDefault, GetColorFor( CurrentDisplayMode).BkFace
              RedrawWindow CBHNDL, BYVAL 0, BYVAL 0, %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
           END IF

       CASE %WM_MEASUREITEM
           IF CBWPARAM = 0 THEN  'a menu is calling
              lpmis = CBLPARAM

              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( CBHNDL)
                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)
              ReleaseDC CBHNDL, hDC
              FUNCTION = 1
           END IF

       CASE %WM_DRAWITEM
           IF CBWPARAM = 0 THEN           'if identifier is 0, message was sent by a menu
              lpdis = CBLPARAM

              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  'WinME, WinNT, Win2k --- Look like 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
                    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( CBHNDL)) - 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    'GetSysColorBrush( %COLOR_MENU)
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                    ELSE
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush    'GetSysColorBrush( %COLOR_MENU)
                       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)
                          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)
                          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
              ELSE
                 'Draw a separator
                 'Sub-level Menu
                 FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush 'GetSysColorBrush(%COLOR_MENU)
                 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 CBWPARAM
             CASE %WMSZ_BOTTOMRIGHT, %WMSZ_TOPRIGHT, %WMSZ_RIGHT
                'Get dimensions for dialog
                GetClientRect CBHNDL, tRect
                'Save total width
                RightEdge = tRect.nRight + 4

                'Get new proposed size
                ptrRECT = CBLPARAM

                GetWindowRect CBHNDL, tRect
                RightEdge = RightEdge + @ptrRECT.nRight - tRect.nRight
             CASE %WMSZ_BOTTOMLEFT, %WMSZ_TOPLEFT, %WMSZ_LEFT
                'Get dimensions for dialog
                GetClientRect CBHNDL, tRect
                'Save total width
                RightEdge = tRect.nRight + 4

                'Get new proposed size
                ptrRECT = CBLPARAM

                GetWindowRect CBHNDL, tRect
                RightEdge = RightEdge + tRect.nLeft - @ptrRECT.nLeft
             CASE ELSE
                'No action required for adjusting height only
          END SELECT

       CASE %WM_SIZE
          IF CBWPARAM = %SIZE_MAXIMIZED THEN
             'Get dimensions for dialog
             GetClientRect CBHNDL, tRect
             'Save total width
             RightEdge = tRect.nRight + 4

             RedrawWindow CBHNDL, 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 CBWPARAM = %HTMENU THEN
             'If last item with focus has not been cleared, clear it
             IF hTimer THEN
                KillTimer CBHNDL, hTimer
                hTimer = 0
                FocusItem = 0
             END IF
          END IF

       CASE %WM_NCMOUSEMOVE
           LOCAL MyPoint AS POINT

          'Mouse cursor is in non-client area
          IF CBWPARAM = %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 SELECT
             'If mouse cursor is over the menubar, check which menubar item is under the cursor
             hMenu = GetMenu( CBHNDL)
             FOR I = 0 TO GetMenuItemCount( hMenu) - 1
                GetMenuItemRect CBHNDL, hMenu, I, tRect
                'IF PtInRect( tRect, LO(WORD, CBLPARAM), HIWRD( CBLPARAM)) THEN
                MyPoint.x = LO(WORD, CBLPARAM)
                MyPoint.y = HI(WORD, CBLPARAM)
                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

                   K = GetMenuState( hMenu, I, %MF_BYPOSITION)

                   'If last item with focus has not been cleared, clear it
                   IF hTimer THEN
                      KillTimer CBHNDL, 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 CBHNDL, 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)
                      mRestoreMenuItem
                      IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN DeleteObject hIcon
                   END IF

                   'Set focus and remember bounding RECT
                   FocusItem = %ODM_BASE_MENUBAR_ITEM_ID + I
                   GetMenuItemRect CBHNDL, 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)
                   mHighlightMenuItem
                   IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN DeleteObject hIcon

                   hTimer = SetTimer (CBHNDL, 1, 100, BYVAL %Null)
                   EXIT FOR
                END IF
             NEXT
          END IF

       CASE %WM_TIMER
          GetCursorPos pt
          GetMenuItemRect CBHNDL, GetMenu( CBHNDL), FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
          IF PtInRect( FocusRect, pt) THEN
             'Still has focus
          ELSE
             KillTimer CBHNDL, hTimer
             hTimer = 0
             ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
             hIcon = MenuItemData( Offset-1).hIco
             K = GetMenuState( GetMenu( CBHNDL), 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)
             mRestoreMenuItem
             IF (LOBYT( LO(WORD, K)) AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN DeleteObject hIcon
             FocusItem = 0
          END IF

       CASE %WM_COMMAND
           SELECT CASE CBCTL
               CASE %IDM_FILE_OPEN
                   hMenu = GetMenu( CBHNDL)
                   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( CBHNDL)
                   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( CBHNDL)
                   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 CBHNDL, 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( CBHNDL)
                   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( CBHNDL)
                   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 CBHNDL, 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 CBHNDL, hTimer
           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
'--------------------------------------------------------------------------------

Announcement

Forum Guidelines

Owner Drawn Menu Bar - completely customizable

Owner Drawn Menu Bar - completely customizable

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment