Announcement

**Tim Lakinir** · 15 Nov 2020, 01:46 PM

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

Could be a Menu style that they use?

Code:

' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24067-owner-drawn-menu-bar-completely-customizable?p=785887#post785887


'************************************************************************
'* ODrawMenu.bas                                                           *
'*     by Bernard Ertl                                                  *
'*     July 11, 2002                                                    *
'*     Revamped July 12 - Changed from DrawState to DrawText            *
'*                      - Changed sizing handlers for min dialog width  *
'*                        and maximizing                                *
'*                      - Added STATIC array to track menu item data    *
'*                      - Streamlined tracking of focus RECTs           *
'*     Modified July 13 - Changed WM_INITDIALOG to eliminate reliance on*
'*                        GetMenuItemInfo & SetMenuItemInfo             *
'*                      - Changed WM_MEASURE handler to calculate tabbed*
'*                        submenu items correctly                       *
'*                      - Adjusted height for separators                *
'*     Modified July 14 - Added WM_NCLBUTTONDOWN handler                *
'*                      - Eliminated need for STATIC FocusRect & WM_MOVE*
'*                        repainting                                    *
'*                      - Corrected spacing of top level menu items     *
'*     Modified July 15 - Added support for nested sub-menus            *
'*                      - Overhauled painting & drawing to better       *
'*                        conform to standard menu behavior             *
'*                      - Ensured proper key-navigation for separators  *
'*     Modified July 16 - Included option to maintain focus highlighting*
'*                        when dialog is inactive                       *
'*                      - Corrected code for grayed/disabled items      *
'*     Modified July 17 - Grayed top menu bar when dialog is inactive   *
'*                      - Added support for %MF_CHECKED                 *
'*                      - Added support for auto-adjusting to the       *
'*                        color display mode                            *
'*     Modified July 18 - Added default checkmark if user does not      *
'*                        specify an icon                               *
'*                      - Shows icons for disabled/grayed items as      *
'*                        monochrome now                                *
'*                      - Corrected display for top level menu items    *
'*                        that are disabled/grayed                      *
'*     Modified July 21 - Added OS versioning support.  Menu conforms to*
'*                        standard behavior for the current OS.         *
'*                        ** Win95 tested OK                            *
'*                        ** Win98 tested OK (default)                  *
'*                        ** WinXP added, not fully tested              *
'*                                                                      *
'* CREDITS:                                                             *
'* Much of this code has been adapted from Borje Hagsten's & Semen      *
'* Matusovski's code found here:                                        *
'* http://www.powerbasic.com/support/forums/Forum4/HTML/004427.html      *
'*                                                                      *
'* Also, code has been adapted from Borje Hagsten's excellent DrawMenu  *
'* code.                                                                *
'*                                                                      *
'* Original skeleton code designed with PBForms 1.0.  PB Forms          *
'* metastatements have been removed since I had to do some editing      *
'* to the PB Forms blocks and it can not be reloaded correctly.         *
'*                                                                      *
'* Thanks to Aleksander Hjalmar for testing and suggesting improvements.*
'*                                                                      *
'* Thanks to Scott Turchin for the Windows OS Version Function.  I      *
'* modified it to suit my tastes...                                     *
'*                                                                      *
'* DESCRIPTION:                                                         *
'* This code shows how to completely customize a menu including the top *
'* level menu bar.  You can set colors and icons for all menu items.    *
'*                                                                      *
'* RESTRICTIONS:                                                        *
'* - Code requires that top level menubar items have IDs in a range     *
'*   greater than all sublevel menu items                               *
'* - Code assumes that all top level menubar items have sub-menus (no   *
'*   separators). Separators are OK in sub-menus.                       *
'* - Code assumes that all top level menubar items are UNCHECKED        *
'* - Code restricts minimum sizing of dialog width to the size of the   *
'*   menu bar because the background coloring of the menu bar does not  *
'*   work correctly at all times when the toolbar is multiple lines in  *
'*   height.                                                            *
'************************************************************************
'Modified 2019-OCT-16 by: Jim Fritts to work in PBWIN10.4 and J. Roca headers

#COMPILE EXE
#DIM ALL

'--------------------------------------------------------------------------------
'   ** Includes **
'--------------------------------------------------------------------------------
    #INCLUDE "WIN32API.INC"


'--------------------------------------------------------------------------------
'   ** Constants **
'--------------------------------------------------------------------------------
%IDD_DIALOG1            = 101
%IDR_MENU1              = 102
%IDM_FILE_OPEN          = 1001
%IDR_ACCELERATOR1       = 103
%IDM_FILE_SAVE          = 1002
%IDM_FILE_EXIT          = 1003
%IDM_EDIT_CUT           = 1004
%IDM_EDIT_COPY          = 1005
%IDM_EDIT_PASTE         = 1006
%IDM_HELP_HELPTOPICS    = 1007
%IDM_HELP_ABOUT         = 1008
%IDM_EDIT_SUB_COOL      = 1009
%IDM_EDIT_SUB_DARE      = 1010

'These constants help define the menu structure
%ODM_BASE_MENUBAR_ITEM_ID = 9000  'This is the ID threshold for top level menubar items
%ODM_BASE_SUBMENU_ITEM_ID = 2000  'This is the ID threshold for any (sub-)menu items that contain sub-menus
%ODM_MAX_STRING           = 40    'Number of bytes for ASCIIZ menu strings

%ODM_ACCEL_KEY_SPACING     = 10   'Seems to work good
%ODM_ICON_IN_MENU_WIDTH    = 16   '16 for icon
%ODM_MARGIN_SPACING        = 4
%ODM_TEXT_OFFSET_FROM_ICON = 2    'Add spacing between sub-menu item's text and icon

'These constants enumerate the different possible Windows OS platforms
%WinUnknown      = 0
%Win95           = 1
%Win98           = 2
%WinME           = 3
%WinNT           = 4
%Win2K           = 5  ' this is the latest OS Windows 10
%WinXP           = 6
%WinDotNetServer = 7
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Types **
'--------------------------------------------------------------------------------
'NOTE: hIco is the default icon image to display.  If you want to display checked/unchecked states,
'  hIco        = unchecked state icon  (could be NULL for no image)
'  hCheckedIco = checked state icon    (can be the same as hIco too)
'NOTE: wID **MUST** be the first item in the TYPE.
TYPE MenuItemType
   wID         AS DWORD  'Menu item's control ID
   zTxt        AS ASCIIZ * %ODM_MAX_STRING
   hIco        AS DWORD  'Default icon image
   hCheckedIco AS DWORD  'Checked icon image
   AccelWidth  AS LONG   'Holds TextExtent of any accelerator key text
END TYPE

TYPE ColorSet
   BkFace            AS LONG  'Color for raised button face
   BkFaceSunken      AS LONG  'Color for depressed button face
   BkHighlight       AS LONG  'Color for sub-menu highlighted items
   BkHighlightSunken AS LONG  'Color for depressed face on sub-menu higlighted items
   BkFocusHighlight  AS LONG  'Color for focus highlighting top level menu bar
   BkFocusSelect     AS LONG  'Color for selected top level menu bar item
   TxDefault         AS LONG  'Default color for text
   TxGrayed          AS LONG  'Color for grayed text
   TxHighlighted     AS LONG  'Color for highlighted text
END TYPE
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Globals **
'--------------------------------------------------------------------------------
GLOBAL GetColorFor()      AS ColorSet
GLOBAL CurrentDisplayMode AS LONG
GLOBAL OSVersion          AS LONG
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Declarations **
'--------------------------------------------------------------------------------
DECLARE FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
DECLARE FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd _
    AS WORD, BYVAL byFVirt AS BYTE) AS LONG
DECLARE FUNCTION AttachACCELERATOR1(BYVAL hDlg AS DWORD) AS DWORD
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
DECLARE FUNCTION GetWindowsVersion() AS LONG
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** PBMAIN **
'--------------------------------------------------------------------------------
FUNCTION PBMAIN()

    LOCAL dm AS DEVMODE
    LOCAL OSVO AS OSVersionInfo
    DIM GetColorFor( 1)

    'Get Current OS Version
    'Note: You can force a behavior style by explicitly assigning an equate to OSVersion
    OSVersion = GetWindowsVersion()  '%WinXP

    'Set colors for 256 color mode
    GetColorFor(0).BkFace            = RGB( 128, 128, 0)
    GetColorFor(0).BkFaceSunken      = RGB( 128, 128, 0) '%YELLOW does not make good 3D effect
    GetColorFor(0).BkHighlight       = RGB( 128, 0, 0)
    GetColorFor(0).BkHighlightSunken = RGB( 128, 0, 0)   '%RED does not make good 3D effect
    SELECT CASE AS LONG OSVersion
       CASE %WinXP
          GetColorFor(0).BkFocusHighlight  = GetColorFor(0).BkHighlight
          GetColorFor(0).BkFocusSelect     = GetColorFor(0).BkFaceSunken
       CASE ELSE
          GetColorFor(0).BkFocusHighlight  = GetColorFor(0).BkHighlight
          GetColorFor(0).BkFocusSelect     = GetColorFor(0).BkHighlight
    END SELECT
    GetColorFor(0).TxDefault         = GetSysColor( %COLOR_MENUTEXT)
    GetColorFor(0).TxGrayed          = &H00505050  'Dark Gray
    GetColorFor(0).TxHighlighted     = GetSysColor( %COLOR_HIGHLIGHTTEXT) 'To match the sub-menu arrow graphic

    'Set colors for 16 bit/High Color or better
    GetColorFor(1).BkFace            = RGB( 200, 200, 152)
    GetColorFor(1).BkFaceSunken      = RGB( 220, 220, 188)
    GetColorFor(1).BkHighlight       = RGB( 173, 173, 101)
    GetColorFor(1).BkHighlightSunken = RGB( 187, 187, 128)
    SELECT CASE AS LONG OSVersion
       CASE %WinXP
          GetColorFor(1).BkFocusHighlight  = RGB(159, 220, 133)
          GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkFaceSunken
       CASE ELSE
          GetColorFor(1).BkFocusHighlight  = GetColorFor(1).BkHighlight
          GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkHighlight
    END SELECT
    GetColorFor(1).TxDefault         = GetSysColor( %COLOR_MENUTEXT)
    GetColorFor(1).TxGrayed          = GetSysColor( %COLOR_GRAYTEXT)
    GetColorFor(1).TxHighlighted     = GetSysColor( %COLOR_HIGHLIGHTTEXT) 'To match the sub-menu arrow graphic

    'Get Current Display Mode
    dm.dmSize = LEN( DEVMODE)
    EnumDisplaySettings BYVAL 0, %ENUM_CURRENT_SETTINGS, dm
    CurrentDisplayMode = IIF&( dm.dmBitsPerPel > 8, 1, 0)

    ShowDIALOG1 %HWND_DESKTOP

END FUNCTION
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Macros **
'--------------------------------------------------------------------------------
'The following MACROS were added for coding clarity in the ShowDIALOG1Proc function
MACRO mHighlightMenuItem

        GetWindowRect CB.HNDL, tRect
        tRect.nBottom = FocusRect.nBottom - tRect.nTop
        tRect.nTop    = FocusRect.nTop    - tRect.nTop
        tRect.nRight  = FocusRect.nRight  - tRect.nLeft
        tRect.nLeft   = FocusRect.nLeft   - tRect.nLeft
        hDC = GetWindowDC( CB.HNDL)
        'Draw
        SELECT CASE AS LONG OSVersion
           CASE %WinXP
              'Calculate a darker shade of the focus color for the frame
              I = GetColorFor( CurrentDisplayMode).BkFocusHighlight
              !xor edx, edx  'clear edx
              !mov eax, I
              !shr eax, 18   'divide blue value by 4
              !mov dl, al
              !shl edx, 16
              !mov eax, I
              !shr ah, 2     'divide green value by 4
              !shr al, 2     'divide blue value by 4
              !mov dx, ax
              !mov I, edx
              hf = SelectObject( hDC, CreatePen( %PS_SOLID, 0, I))
              'Draw frame using custom colored pen
              MoveToEx hDC, tRect.nLeft, tRect.nTop, BYVAL 0
              LineTo hDC, tRect.nRight-1, tRect.nTop
              LineTo hDC, tRect.nRight-1, tRect.nBottom-1
              LineTo hDC, tRect.nLeft, tRect.nBottom-1
              LineTo hDC, tRect.nLeft, tRect.nTop

              DeleteObject SelectObject( hDC, CreatePen( %PS_SOLID, 0, GetColorFor( CurrentDisplayMode).BkFocusHighlight))
              FOR I = 1 TO ((tRect.nBottom - tRect.nTop) * (tRect.nRight - tRect.nLeft)) \ 2
                 DO
                    pt.x = RND( tRect.nLeft+1, tRect.nRight-1)
                 LOOP UNTIL pt.x MOD 2
                 DO
                    pt.y = RND( tRect.nTop+1, tRect.nBottom-1)
                 LOOP UNTIL pt.y MOD 2
                 MoveToEx hDC, pt.x, pt.y, BYVAL 0
                 LineTo hDC, pt.x+1, pt.y
              NEXT
              DeleteObject SelectObject( hDC, hf)

              SetTextColor hDC, GetColorFor( CurrentDisplayMode).TxDefault
              SetBkMode hDC, %TRANSPARENT

              strMenu = MenuItemData( Offset-1).zTxt

              IF LEN( strMenu) <> 0 THEN
                 ncm.cbSize = LEN( NONCLIENTMETRICS)
                 SystemParametersInfo %SPI_GETNONCLIENTMETRICS, SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                 IF LEN(ncm.lfMenuFont) THEN
                    hf = CreateFontIndirect(ncm.lfMenuFont)
                    IF hf THEN
                        hf = SelectObject(hDC, hf)
                    END IF
                 END IF
                 t2Rect = tRect
                 'Adjust for offset
                 DECR t2Rect.nTop
                 DECR t2Rect.nBottom
                 IF MenuItemData( Offset-1).hIco THEN
                    t2Rect.nLeft = t2Rect.nLeft + _
                     %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING\2 - 2  'Leave room for icons
                 ELSE
                    'When no icon in top level, adjust RECT
                    t2Rect.nLeft = t2Rect.nLeft - 2
                 END IF
                 DrawText hDC, BYVAL STRPTR(strMenu), LEN(strMenu),_
                     t2Rect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                 IF hf THEN DeleteObject SelectObject(hDC, hf)
              END IF
           CASE %Win98
              DrawEdge hDC, tRect, %BDR_RAISEDOUTER, %BF_RECT
           CASE ELSE
               'WinME, WinNT, Win2k --- I'm not sure what the
               ' standard focus highlighting is for these OSes
              DrawEdge hDC, tRect, %BDR_RAISEDOUTER, %BF_RECT
        END SELECT
        IF hIcon THEN
              DrawIconEx hDC, tRect.nLeft + %ODM_MARGIN_SPACING - 2,_
              tRect.nTop + 1, hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
        END IF
        ReleaseDC CB.HNDL, hDC

END MACRO

MACRO mRestoreMenuItem

        GetWindowRect CB.HNDL, tRect
        tRect.nBottom = FocusRect.nBottom - tRect.nTop
        tRect.nTop    = FocusRect.nTop    - tRect.nTop
        tRect.nRight  = FocusRect.nRight  - tRect.nLeft
        tRect.nLeft   = FocusRect.nLeft   - tRect.nLeft
        hDC = GetWindowDC( CB.HNDL)
        'Erase
        SELECT CASE AS LONG OSVersion
           CASE %WinXP
              FillRect hDC, tRect, hCustomBrush

              SetTextColor hDC, GetColorFor( CurrentDisplayMode).TxDefault
              SetBkMode hDC, %TRANSPARENT

              strMenu = MenuItemData( Offset-1).zTxt

              IF LEN( strMenu) <> 0 THEN
                 ncm.cbSize = LEN( NONCLIENTMETRICS)
                 SystemParametersInfo %SPI_GETNONCLIENTMETRICS, SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                 IF LEN(ncm.lfMenuFont) THEN
                    hf = CreateFontIndirect(ncm.lfMenuFont)
                    IF hf THEN hf = SelectObject(hDC, hf)
                 END IF
                 t2Rect = tRect
                 'Adjust for offset
                 DECR t2Rect.nTop
                 DECR t2Rect.nBottom
                 IF MenuItemData( Offset-1).hIco THEN
                    t2Rect.nLeft = t2Rect.nLeft + %ODM_ICON_IN_MENU_WIDTH + _
                     %ODM_MARGIN_SPACING\2 - 2  'Leave room for icons
                 ELSE
                    'When no icon in top level, adjust RECT
                    t2Rect.nLeft = t2Rect.nLeft - 2
                 END IF
                 DrawText hDC, BYVAL STRPTR(strMenu), LEN(strMenu), t2Rect,_
                     %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                 IF hf THEN DeleteObject SelectObject(hDC, hf)
              END IF
           CASE %Win98
              FrameRect hDC, tRect, hCustomBrush
           CASE ELSE
               'WinME, WinNT, Win2k --- I'm not sure what
               'the standard focus highlighting is for these OSes
              FrameRect hDC, tRect, hCustomBrush
        END SELECT
        'Redraw icon in case it overlapped the button frame
        IF hIcon THEN
            DrawIconEx hDC, tRect.nLeft + %ODM_MARGIN_SPACING - 2,_
            tRect.nTop + 1, hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
        END IF
        ReleaseDC CB.HNDL, hDC

END MACRO
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Menus **
'--------------------------------------------------------------------------------
FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD

    LOCAL hMenu AS LONG
    LOCAL hPopUp1 AS LONG
    LOCAL hPopUp2 AS LONG
    LOCAL hPopUp3 AS LONG

    MENU NEW BAR TO hMenu
    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "Super Fabulous &File Menu", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Open" + $TAB + "Ctrl+O", %IDM_FILE_OPEN, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Save" + $TAB + "Ctrl+S", %IDM_FILE_SAVE, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "-", 0, 0
        MENU ADD STRING, hPopUp1, "&Exit" + $TAB + "Ctrl+E", %IDM_FILE_EXIT, _
            %MF_ENABLED

    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "&Edit", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "C&ut" + $TAB + "Ctrl+X", %IDM_EDIT_CUT, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Copy" + $TAB + "Ctrl+C", %IDM_EDIT_COPY, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Paste" + $TAB + "Ctrl+V", %IDM_EDIT_PASTE, _
            %MF_GRAYED
        MENU ADD STRING, hPopUp1, "-", 0, 0

        MENU NEW POPUP TO hPopUp2
        MENU ADD POPUP, hPopUp1, "&Sub-Menu Test", hPopUp2, %MF_ENABLED
           MENU ADD STRING, hPopUp2, "&Cool", %IDM_EDIT_SUB_COOL, _
               %MF_ENABLED
           MENU ADD STRING, hPopUp2, "-", 0, 0
           MENU NEW POPUP TO hPopUp3
           MENU ADD POPUP, hPopUp2, "Double &Nested Test", hPopUp3, %MF_ENABLED
              MENU ADD STRING, hPopUp3, "&Dare to Dream" + $TAB + "Ctrl+D", %IDM_EDIT_SUB_DARE, _
                  %MF_ENABLED

    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "&Help", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Help Topics" + $TAB + "F1", _
            %IDM_HELP_HELPTOPICS, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&About" + $TAB + "Ctrl+A", %IDM_HELP_ABOUT, _
            %MF_ENABLED

    MENU ATTACH hMenu, hDlg

    FUNCTION = hMenu

END FUNCTION
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Accelerators **
'
' No code was modified for accelerators.  This is straight out of PBForms
'--------------------------------------------------------------------------------
FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd AS WORD, _
    BYVAL byFVirt AS BYTE) AS LONG
    tAccel.fVirt = byFVirt
    tAccel.key = wKey
    tAccel.cmd = wCmd
END FUNCTION




FUNCTION AttachACCELERATOR1(BYVAL hDlg AS DWORD) AS DWORD

    LOCAL hAccel AS DWORD
    LOCAL tAccel() AS ACCELAPI
    DIM tAccel(1 TO 9)

    ASSIGNACCEL tAccel(1), ASC("O"), %IDM_FILE_OPEN, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(2), ASC("S"), %IDM_FILE_SAVE, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(3), ASC("E"), %IDM_FILE_EXIT, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(4), ASC("X"), %IDM_EDIT_CUT, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(5), ASC("C"), %IDM_EDIT_COPY, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(6), ASC("V"), %IDM_EDIT_PASTE, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(7), %VK_F1, %IDM_HELP_HELPTOPICS, %FVIRTKEY OR %FNOINVERT
    ASSIGNACCEL tAccel(8), ASC("A"), %IDM_HELP_ABOUT, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(9), ASC("D"), %IDM_EDIT_SUB_DARE, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT

    ACCEL ATTACH hDlg, tAccel() TO hAccel

    FUNCTION = hAccel

END FUNCTION
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Support Procs **
'--------------------------------------------------------------------------------
FUNCTION GetWindowsVersion() AS LONG
   'This function courtesy of Scott Turchin.  I've modified it for this code.
   'Original posting can be found here:
   'http://www.powerbasic.com/support/forums/Forum4/HTML/002310.html

   LOCAL osinfo   AS OSVERSIONINFO

   osinfo.dwOsVersionInfoSize = SIZEOF(osinfo)

   IF ISFALSE GetVersionEx( osinfo) THEN EXIT FUNCTION ' Function = %WinUnknown

   IF osinfo.dwPlatformId = %VER_PLATFORM_WIN32_NT THEN
      SELECT CASE AS LONG osinfo.dwMajorVersion
         CASE < 5
            FUNCTION = %WinNT
         CASE 5
            SELECT CASE AS LONG osinfo.dwMinorVersion
               CASE 0
                  FUNCTION = %Win2K
               CASE 1
                  FUNCTION = %WinXP
               CASE 2
                  FUNCTION = %WinDotNetServer
            END SELECT
      END SELECT
   ELSEIF osinfo.dwPlatformId = %VER_PLATFORM_WIN32_WINDOWS THEN
      SELECT CASE AS LONG osinfo.dwMinorVersion
         CASE < 10
            FUNCTION = %Win95
         CASE 10
            FUNCTION = %Win98
         CASE 90
            FUNCTION = %WinME
      END SELECT
   END IF

END FUNCTION




FUNCTION CountItems( BYVAL hMenu AS LONG) AS LONG

   REGISTER I AS LONG, K AS LONG

   LOCAL hSubMenu AS LONG

   FOR K = 0 TO GetMenuItemCount( hMenu) - 1
      INCR I  'Count hMenu item...
      hSubMenu = GetSubMenu( hMenu, K)
      IF hSubMenu THEN I = I + CountItems( hSubMenu) 'Add all nested items for hSubMenu item
   NEXT

   FUNCTION = I

END FUNCTION



SUB ModifySubMenu( BYVAL hDlg AS LONG, _                'Handle of dialog
                   BYVAL hSubMenu AS LONG, _            'Handle to sub-menu
                   BYVAL ptrMID AS MenuItemType PTR, _  'Pointer to MenuItemData array
                   Offset AS LONG, _                    'Current subscript for MenuItemData array
                   SubMenuID AS LONG)                   'Tracks ID# to assign to a sub-menu

   REGISTER I AS LONG, K AS LONG

   LOCAL MaxAccelTxtWidth AS LONG
   LOCAL Result AS LONG
   LOCAL hf     AS LONG
   LOCAL hDC    AS LONG
   LOCAL SizeA  AS SizeL
   LOCAL ncm    AS NONCLIENTMETRICS
   LOCAL StartingSubMenuOffset AS LONG
   LOCAL zTxt   AS ASCIIZ * %ODM_MAX_STRING
   LOCAL hNestedMenu AS LONG

   'Remember where we started...
   StartingSubMenuOffset = Offset + 1

   'Loop through all sub-menu items...
   FOR I = 0 TO GetMenuItemCount( hSubMenu) - 1
      'Determine what the sub-menu item is...
      Result = GetMenuState( hSubMenu, I, %MF_BYPOSITION)
      hNestedMenu = GetSubMenu( hSubMenu, I)

      IF hNestedMenu THEN
         'Nested sub-menu
         GetMenuString hSubMenu, I, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
         INCR Offset
         @ptrMID[ Offset].wID = SubMenuID
         INCR SubMenuID
         @ptrMID[ Offset].zTxt = zTxt
         SELECT CASE AS CONST$ zTxt
            CASE "&Sub-Menu Test"
               @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_QUESTION)
            CASE "Double &Nested Test"
               @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_HAND)
            CASE ELSE
               'No icons to display
         END SELECT

         'Change to %MFT_OWNERDRAW
         ModifyMenu hSubMenu, I, (LOBYT( LO(WORD, Result)) XOR %MF_POPUP) OR _
             %MF_BYPOSITION OR %MF_OWNERDRAW, @ptrMID[ Offset].wID, BYVAL 0

         'Set max accelerator ket text width for all sub-menu items up to now...
         FOR K = StartingSubMenuOffset TO Offset
            @ptrMID[ K].AccelWidth = MaxAccelTxtWidth + _
             %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING
         NEXT
         'Modify the nested sub-menu...
         ModifySubMenu hDlg, hNestedMenu, ptrMID, Offset, SubMenuID

         'Start new block...
         StartingSubMenuOffset = Offset + 1
      ELSE
         IF (Result AND %MF_SEPARATOR) THEN
            'Change %MFT_SEPARATOR to %MFT_OWNERDRAW, maintain ID = 0
            ModifyMenu hSubMenu, I, Result OR %MF_BYPOSITION OR %MF_OWNERDRAW, 0, BYVAL 0
         ELSE
            'Change %MFT_STRING to %MFT_OWNERDRAW,
            ' add icons, calculate width of accelerator key text
            GetMenuString hSubMenu, I, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
            INCR Offset
            @ptrMID[ Offset].wID = GetMenuItemID( hSubMenu, I)
            @ptrMID[ Offset].zTxt = zTxt
            'Modify the following SELECT CASE as desired to add icons
            'where you want them.  You can also load icons from a resource file
            SELECT CASE AS LONG @ptrMID[ Offset].wID
               CASE %IDM_FILE_OPEN
                  @ptrMID[ Offset].hIco  = LoadIcon(0, BYVAL %IDI_EXCLAMATION)
'Leave out checked icon to test default icon
'Uncomment to see custom checked icon
'                  @ptrMID[ Offset].hCheckedIco = LoadIcon(0, BYVAL %IDI_HAND)
               CASE %IDM_EDIT_CUT
                  @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_EXCLAMATION)
               CASE %IDM_HELP_ABOUT
                  @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_APPLICATION)
               CASE %IDM_HELP_HELPTOPICS
                  @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_QUESTION)
               CASE ELSE
                  'No icons to display
            END SELECT

            'Change %MFT_STRING to %MFT_OWNERDRAW
            ModifyMenu hSubMenu, I, Result OR %MF_BYPOSITION OR _
              %MF_OWNERDRAW, @ptrMID[ Offset].wID, BYVAL 0

            'Determine width of accelerator key text
            IF INSTR( zTxt, $TAB) THEN
               zTxt = PARSE$( zTxt, $TAB, 2)   'Get accelerator key text
               hDC = GetDC( hDlg)
                  ncm.cbSize = LEN( NONCLIENTMETRICS)
                  SystemParametersInfo %SPI_GETNONCLIENTMETRICS, _
                      SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                  IF LEN(ncm.lfMenuFont) THEN
                     hf = CreateFontIndirect(ncm.lfMenuFont)
                     IF hf THEN
                         hf = SelectObject(hDC, hf)
                     END IF
                  END IF
                  GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                  IF sizeA.cx > MaxAccelTxtWidth THEN
                      MaxAccelTxtWidth = sizeA.cx
                  END IF
                  IF hf THEN
                      DeleteObject SelectObject(hDC, hf)
                  END IF
               ReleaseDC hDlg, hDC
            END IF
         END IF
      END IF
   NEXT
   'Set max accelerator ket text width for all sub-menu items...
   FOR I = StartingSubMenuOffset TO Offset
      @ptrMID[ I].AccelWidth = MaxAccelTxtWidth + _
       %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING
   NEXT

END SUB
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()

   REGISTER I AS LONG, K AS LONG

   STATIC hCustomBrush         AS LONG  ' Custom background color
   STATIC hCustomSunkenBrush   AS LONG  ' Custom sunken background color (button depression)
   STATIC hCustomBkBrush       AS LONG  ' Custom background highlight color
   STATIC hCustomSunkenBkBrush AS LONG  ' Custom sunken background highlight color (button depression)
   STATIC hCustomFocusHLBrush  AS LONG  ' Custom highlight color for top level menu item
   STATIC hCustomFocusSelBrush AS LONG  ' Custom highlight color for selected top level menu item
   STATIC RightEdge            AS LONG  ' 'Coordinate' of the dialog's right edge
   STATIC BORDER               AS LONG  ' 'Coordinate' of the right edge of the last top level menubar item
   STATIC FocusItem            AS LONG  ' Control ID of the top level menubar item that has focus
   STATIC hTimer               AS DWORD ' Handle to Timer
   STATIC DialogIsActive       AS LONG  ' Track if dialog is active

   STATIC MenuItemData()  AS MenuItemType  'Maintain info for each ownerdrawn menu item
   'Note:  This is necessary because menu items with fType = %MFT_OWNERDRAW do not
   '       return the dwTypeData correctly.
   'Note:  If you want to have multiple dialogs active concurrently with ownerdrawn menus,
   '       they should have unique dialog callback functions.  Otherwise there will be problems
   '       with the STATIC variables.

   LOCAL Offset                AS LONG 'General purpose local variable
   LOCAL SubMenuID             AS LONG
   LOCAL MaxAccelTxtWidth      AS LONG
   LOCAL StartingSubMenuOffset AS LONG
   LOCAL FocusRect             AS RECT ' Coordinates of the top level menubar item with focus
   LOCAL NewColorMode          AS LONG

   LOCAL hDC      AS LONG  'Handles
   LOCAL hMenu    AS LONG
   LOCAL hSubMenu AS LONG
   LOCAL hIcon    AS LONG
   LOCAL hf       AS LONG

   LOCAL strMenu  AS STRING 'Strings
   LOCAL strMenu2 AS STRING
   LOCAL zTxt     AS ASCIIZ * %ODM_MAX_STRING

   LOCAL tRect    AS RECT   'For processing messages
   LOCAL t2Rect   AS RECT
   LOCAL ptrRECT  AS RECT PTR
   LOCAL SizeA    AS SizeL
   LOCAL ncm      AS NONCLIENTMETRICS
   LOCAL mminfo   AS MINMAXINFO PTR
   LOCAL pt       AS POINTAPI
   LOCAL lpmis    AS MEASUREITEMSTRUCT PTR
   LOCAL lpdis    AS DRAWITEMSTRUCT PTR

   SELECT CASE CB.MSG
       CASE %WM_INITDIALOG
           'Initialize var
           DialogIsActive = %True

           'Get starting dimensions for dialog
           GetClientRect CB.HNDL, tRect
           'Save total width
           RightEdge = tRect.nRight + 4
           hCustomBrush         = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFace)
           hCustomSunkenBrush   = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFaceSunken)
           hCustomBkBrush       = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlight)
           hCustomSunkenBkBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlightSunken)
           hCustomFocusHLBrush  = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusHighlight)
           hCustomFocusSelBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusSelect)

           hMenu = GetMenu( CB.HNDL)

           'Count Max# total menu & sub-menu items
           I = CountItems( hMenu)
           'Dimension array for strings and icons
           DIM MenuItemData( I)
           SubMenuID = %ODM_BASE_SUBMENU_ITEM_ID

           'Now we modify our menu to
           '  1) add control ID's to the top level menubar items
           '  2) change all items to ownerdraw

           FOR K = 0 TO GetMenuItemCount( hMenu) - 1
              '--- SUB-MENUS ----------------------
              hSubMenu = GetSubMenu( hMenu, K)
              ModifySubMenu CB.HNDL, hSubMenu, VARPTR( MenuItemData( 0)), Offset, SubMenuID
              '--- TOP-LEVEL MENUS ----------------------
              GetMenuString hMenu, K, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
              INCR Offset
              'Set an ID for top level menubar items
              MenuItemData( Offset).wID  = %ODM_BASE_MENUBAR_ITEM_ID + K
              MenuItemData( Offset).zTxt = zTxt
              
              'Modify the following SELECT CASE as desired to add icons
              'where you want them.  You can also load icons from a resource file
              SELECT CASE AS LONG K
                 CASE 0  'First menu bar item
'Check spacing on menu item with no icon....
'                    MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_APPLICATION)
                 CASE 1  'Second menu bar item
                    MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_ASTERISK)
                 CASE 2  'Third menu bar item
                    MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_WINLOGO)
                 CASE ELSE
                    'No icons to display
              END SELECT
              ModifyMenu hMenu, K, %MF_BYPOSITION OR _
                 %MF_OWNERDRAW, MenuItemData( Offset).wID, BYVAL 0
           NEXT

       CASE %WM_GETMINMAXINFO
           mminfo = CB.LPARAM
           'Set the minimum dialog width to avoid incorrect painting of multi-line top level menubar
           @mminfo.ptMinTrackSize.x = BORDER + 16

       CASE %WM_NCACTIVATE
          DialogIsActive = CB.WPARAM
          SELECT CASE AS LONG OSVersion
             CASE %Win95
                'No need to repaint menubar - it always uses default text color

             CASE %Win98
                IF DialogIsActive THEN
                    RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, %RDW_INVALIDATE OR _
                    %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
                 END IF

             CASE ELSE
                 'WinME, WinNT, Win2k, WinXP --- I assume these OSes
                 ' gray text for dialogs without focus
                IF DialogIsActive THEN
                    RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0,_
                    %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
                END IF
          END SELECT

       CASE %WM_DISPLAYCHANGE
           NewColorMode = IIF&( CB.WPARAM > 8, 1, 0)
           IF NewColorMode <> CurrentDisplayMode THEN
              CurrentDisplayMode = NewColorMode
              'Release old brushes
              DeleteObject hCustomBrush
              DeleteObject hCustomSunkenBrush
              DeleteObject hCustomBkBrush
              DeleteObject hCustomSunkenBkBrush
              DeleteObject hCustomFocusHLBrush
              DeleteObject hCustomFocusSelBrush
              'Get new brushes
              hCustomBrush         = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFace)
              hCustomSunkenBrush   = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFaceSunken)
              hCustomBkBrush       = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlight)
              hCustomSunkenBkBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlightSunken)
              hCustomFocusHLBrush  = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusHighlight)
              hCustomFocusSelBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusSelect)
              'Force redraw of menu bar
              DIALOG SET COLOR  CB.HNDL, _
                  GetColorFor( CurrentDisplayMode).TxDefault, GetColorFor( CurrentDisplayMode).BkFace
              RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, %RDW_ERASE OR _
                %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
           END IF

       CASE %WM_MEASUREITEM
           IF CB.WPARAM = 0 THEN  'a menu is calling
              lpmis = CB.LPARAM

              ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( @lpmis.itemID), TO Offset
              DECR Offset  'Adjust for zero base
              zTxt = PARSE$( MenuItemData( Offset).zTxt, $TAB, 1)

              hDC = GetDC( CB.HNDL)
                ncm.cbSize = LEN( NONCLIENTMETRICS)
                SystemParametersInfo %SPI_GETNONCLIENTMETRICS, SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                IF LEN(ncm.lfMenuFont) THEN
                   hf = CreateFontIndirect(ncm.lfMenuFont)
                   IF hf THEN hf = SelectObject(hDC, hf)
                END IF
                GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                @lpmis.itemHeight = ncm.iMenuHeight + 2
                SELECT CASE AS LONG @lpmis.itemId
                   CASE 0
                      'Separator
                      @lpmis.itemHeight = ncm.iMenuHeight \ 2
                   CASE < %ODM_BASE_MENUBAR_ITEM_ID
                      'Submenu item
                      @lpmis.itemWidth  = sizeA.cx + _
                          MenuItemData( Offset).AccelWidth + _
                           %ODM_ACCEL_KEY_SPACING + %ODM_TEXT_OFFSET_FROM_ICON
                   CASE ELSE
                      'Top level menu item
                      IF MenuItemData( Offset).hIco THEN
                         'Add margins for both right & left sides
                         @lpmis.itemWidth  = sizeA.cx + %ODM_MARGIN_SPACING + %ODM_MARGIN_SPACING
                      ELSE
                         'Add margins for both right & left sides
                         'Remove space for icon
                         @lpmis.itemWidth  = sizeA.cx - %ODM_ICON_IN_MENU_WIDTH + _
                            %ODM_MARGIN_SPACING + %ODM_MARGIN_SPACING
                      END IF
                END SELECT
                IF hf THEN
                    DeleteObject SelectObject(hDC, hf)
                END IF
              ReleaseDC CB.HNDL, hDC
              FUNCTION = 1
           END IF

       CASE %WM_DRAWITEM
           IF CB.WPARAM = 0 THEN
               'if identifier is 0, message was sent by a menu
              lpdis = CB.LPARAM

              IF @lpdis.itemId THEN
                 'Not a separator (they have .itemID=0)

                 ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( @lpdis.itemID), TO Offset
                 DECR Offset  'Adjust for zero base
                 zTxt  = MenuItemData( Offset).zTxt
                 IF (@lpdis.itemState AND %ODS_CHECKED) THEN
                    hIcon = MenuItemData( Offset).hCheckedIco
                 ELSE
                    hIcon = MenuItemData( Offset).hIco
                 END IF

                 MaxAccelTxtWidth = MenuItemData( Offset).AccelWidth
                 Offset = 0  'We will reuse the Offset variable for positioning

                 IF @lpdis.itemId >= %ODM_BASE_MENUBAR_ITEM_ID THEN
                    'Top Level Menu
                    'Erase bottom border...
                    tRect = @lpdis.rcItem
                    INCR tRect.nBottom

                    SELECT CASE AS LONG OSVersion
                       CASE %Win95
                          Offset = -1  'Do not "click" a "button"
                          IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                             'Paint custom background...
                             FillRect @lpdis.hDC, tRect, hCustomBkBrush
                          ELSE
                             'Paint custom background...
                             FillRect @lpdis.hDC, tRect, hCustomBrush
                          END IF

                       CASE %WinXP
                          IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                             'Paint custom focus background...
                             FillRect @lpdis.hDC, tRect, hCustomFocusSelBrush
                             'Standard Windows XP focus framing
                             hf = SelectObject( @lpdis.hDC, _
                                 CreatePen( %PS_SOLID, 0, GetColorFor( CurrentDisplayMode).TxDefault))
                             'Draw frame using custom colored pen
                             MoveToEx @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nTop, BYVAL 0
                             LineTo @lpdis.hDC, @lpdis.rcItem.nRight-1, @lpdis.rcItem.nTop
                             LineTo @lpdis.hDC, @lpdis.rcItem.nRight-1, @lpdis.rcItem.nBottom-1
                             LineTo @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nBottom-1
                             LineTo @lpdis.hDC, @lpdis.rcItem.nLeft, @lpdis.rcItem.nTop
                             DeleteObject SelectObject( @lpdis.hDC, hf)
                          ELSE
                             Offset = -1  'Offset for text to move it when "button" is NOT "clicked"
                             'Paint custom background...
                             FillRect @lpdis.hDC, tRect, hCustomBrush
                          END IF

                       CASE %Win98
                          'Paint custom background...
                          FillRect @lpdis.hDC, tRect, hCustomBrush
                          IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                             'Standard Windows 98 focus edging
                             DrawEdge @lpdis.hDC, @lpdis.rcItem, %BDR_SUNKENOUTER, %BF_RECT
                             'Needed for our custom color to show top & left edges....
                             ' (If you change the custom color the following may not be necessary)
                             DrawEdge @lpdis.hDC, @lpdis.rcItem, %EDGE_SUNKEN, %BF_TOPLEFT
                          ELSE
                             Offset = -1  'Offset for text to move it when "button" is NOT "clicked"
                          END IF


                       CASE ELSE
                           ' Win2k

                          'Paint custom background...
                          FillRect @lpdis.hDC, tRect, hCustomBrush
                          IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                             'Standard Windows 98 focus edging
                             DrawEdge @lpdis.hDC, @lpdis.rcItem, %BDR_SUNKENOUTER, %BF_RECT
                             'Needed for our custom color to show top & left edges....
                             ' (If you change the custom color the following may not be necessary)
                             DrawEdge @lpdis.hDC, @lpdis.rcItem, %EDGE_SUNKEN, %BF_TOPLEFT
                          ELSE
                             Offset = -1  'Offset for text to move it when "button" is NOT "clicked"
                          END IF
                    END SELECT

                    IF ISTRUE DialogIsActive OR OSVersion = %Win95 THEN
                       'Win95 does not gray text for disabled dialogs....
                       IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                       ELSE
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxDefault
                       END IF
                    ELSE
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                    END IF

                    'Set Border when at last top level menu item
                    IF @lpdis.itemId = %ODM_BASE_MENUBAR_ITEM_ID + GetMenuItemCount( GetMenu( CB.HNDL)) - 1 THEN
                       BORDER = @lpdis.rcItem.nRight
                       IF RightEdge > 0 THEN
                           tRect = @lpdis.rcItem
                           tRect.nLeft = BORDER
                           tRect.nRight = RightEdge
                           INCR tRect.nBottom
                           FillRect @lpdis.hDC, tRect, hCustomBrush
                       END IF
                    END IF
                 ELSE
                    'Sub-level Menu
                    IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                       'COLOR NOTE:
                       '   Windows automatically draws the sub-menu arrow icon even with ownerdrawn
                       '   status.  Windows uses the default colors for the arrow icon:
                       '        %COLOR_MENUTEXT? for unhighlighted items and
                       '        %COLOR_HIGHLIGHTTEXT for highlighted items
                       '   Setting the background highlight &/or text to different colors
                       '   may yield unsatisfactory results.
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBkBrush  'GetSysColorBrush( %COLOR_HIGHLIGHT)
                       IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                       ELSE
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxHighlighted
                       END IF
                    ELSEIF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                    ELSE
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxDefault
                    END IF
                 END IF

                 IF (@lpdis.itemState AND %ODS_CHECKED) THEN
                    'Need to show depressed button effect
                    tRect = @lpdis.rcItem
                    tRect.nRight = tRect.nLeft + 19  'A total width of 20 pixels, 16 for icon, 4 for margins
                    DrawEdge @lpdis.hDC, tRect, %BDR_SUNKENOUTER, %BF_RECT
                    IF CurrentDisplayMode = 0 THEN
                       '256 color mode
                       'Needed for our custom color to show top & left edges....
                       ' (If you change the custom color the following may not be necessary)
                       DrawEdge @lpdis.hDC, tRect, %EDGE_SUNKEN, %BF_TOPLEFT
                    END IF
                    INCR tRect.nTop
                    INCR tRect.nLeft
                    DECR tRect.nRight
                    DECR tRect.nBottom
                    IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                          FillRect @lpdis.hDC, tRect, hCustomSunkenBkBrush
                    ELSE
                          FillRect @lpdis.hDC, tRect, hCustomSunkenBrush
                    END IF
                    IF hIcon = 0 THEN
                       'No user defined icon, so draw standard windows checkmark
                       'Get bitmap
                       hIcon = LoadBitMap( BYVAL 0, BYVAL %OBM_CHECK)
                       IF hIcon <> 0 THEN
                          'Make a brush colored same as text in temporary variable
                          hf = CreateSolidBrush( GetColorFor( CurrentDisplayMode).TxDefault)
                          'Draw checkmark in mono mode so it doesn't draw a background
                          CALL DrawState(@lpdis.hDC, hf, 0&, hIcon, 0&, @lpdis.rcItem.nleft + 3, _
                                  @lpdis.rcItem.nTop + 4, 16, 16, %DST_BITMAP OR %DSS_MONO)
                          'Delete the bitmap when done, to avoid memory leaks!
                          DeleteObject hIcon
                          hIcon = 0
                          DeleteObject hf
                       END IF
                    END IF
                 END IF

                 SetBkMode @lpdis.hDC, %TRANSPARENT

                 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                 ' Get menu item string and split up into ev. text and shortcut part
                 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                 strMenu2 = zTxt
                 IF INSTR(strMenu2, $TAB) THEN       'if it has shortcut (Ctrl+X, etc.)
                    strMenu  = TRIM$(PARSE$(strMenu2, $TAB, 1))
                    strMenu2 = TRIM$(PARSE$(strMenu2, $TAB, 2))
                 ELSE
                    strMenu = TRIM$(strMenu2)
                    strMenu2 = ""
                 END IF

                 IF LEN( strMenu) <> 0 THEN
                    tRect = @lpdis.rcItem
                    IF Offset THEN
                       tRect.nTop    = tRect.nTop    + Offset
                       tRect.nBottom = tRect.nBottom + Offset
                    END IF
                    IF @lpdis.itemId >= %ODM_BASE_MENUBAR_ITEM_ID THEN
                       IF hIcon THEN
                          tRect.nLeft = @lpdis.rcItem.nleft + _
                               %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING\2 + Offset*2  'Leave room for icons
                          DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                                 LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                          END IF
                          DrawIconEx @lpdis.hDC, @lpdis.rcItem.nleft + _
                                  %ODM_MARGIN_SPACING + Offset - 1, @lpdis.rcItem.nTop + 2 + Offset, _
                                     hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN DeleteObject hIcon
                       ELSE
                          'When no icon in top level, adjust RECT
                          tRect.nLeft = @lpdis.rcItem.nleft + Offset*2  'Leave room for icons
                          DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                           LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                       END IF
                    ELSE
                       tRect.nLeft = @lpdis.rcItem.nleft + _
                         %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING + _
                          %ODM_TEXT_OFFSET_FROM_ICON 'Leave room for icons
                       DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                             LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER
                       IF LEN(strMenu2) THEN
                          tRect.nLeft = @lpdis.rcItem.nRight - MaxAccelTxtWidth
                          DrawText @lpdis.hDC, BYVAL STRPTR(strMenu2), _
                           LEN(strMenu2), tRect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER
                       END IF
                       'Draw icon if any...
                       IF hIcon THEN
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                          END IF
                          DrawIconEx @lpdis.hDC, @lpdis.rcItem.nleft + 1, @lpdis.rcItem.nTop + 2, _
                                     hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              DeleteObject hIcon
                          END IF
                       END IF
                    END IF
                 END IF
              ELSE
                 'Draw a separator
                 'Sub-level Menu
                 FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                 tRect = @lpdis.rcItem
                 tRect.nTop  = tRect.nTop + (tRect.nBottom - tRect.nTop)\2
                 DrawEdge @lpdis.hDC, tRect, %EDGE_ETCHED, %BF_TOP
              END IF
              FUNCTION = 1
           END IF

       CASE %WM_SIZING
          SELECT CASE AS LONG CB.WPARAM
             CASE %WMSZ_BOTTOMRIGHT, %WMSZ_TOPRIGHT, %WMSZ_RIGHT
                'Get dimensions for dialog
                GetClientRect CB.HNDL, tRect
                'Save total width
                RightEdge = tRect.nRight + 4

                'Get new proposed size
                ptrRECT = CB.LPARAM

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

                'Get new proposed size
                ptrRECT = CB.LPARAM

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

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

             RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
              %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
          END IF

       CASE %WM_NCLBUTTONDOWN
          'Mouse cursor is in non-client area
          IF CB.WPARAM = %HTMENU THEN
             'If last item with focus has not been cleared, clear it
             IF hTimer THEN
                KillTimer CB.HNDL, hTimer
                hTimer = 0
                FocusItem = 0
             END IF
          END IF

       CASE %WM_NCMOUSEMOVE
           LOCAL MyPoint AS POINT

          'Mouse cursor is in non-client area
          IF CB.WPARAM = %HTMENU THEN
             SELECT CASE AS LONG OSVersion
                CASE %Win95
                   'No focus highlighting for Win95
                   EXIT FUNCTION
                CASE %Win98
                   'Maintain focus highlighting whether dialog is active or not
                CASE ELSE
                    'WinME, WinNT, Win2k, WinXP
                   'Not sure what the standard focus highlighting behavior is
                   'when the dialog is not active.

                   'Add focus highlighting only if dialog is active...
                   IF ISFALSE DialogIsActive THEN
                       EXIT FUNCTION
                   END IF
             END SELECT
             'If mouse cursor is over the menubar, check which menubar item is under the cursor
             hMenu = GetMenu( CB.HNDL)
             FOR I = 0 TO GetMenuItemCount( hMenu) - 1
                GetMenuItemRect CB.HNDL, hMenu, I, tRect
                'IF PtInRect( tRect, LO(WORD, CB.LPARAM), HIWRD( CB.LPARAM)) THEN
                MyPoint.x = LO(WORD, CB.LPARAM)
                MyPoint.y = HI(WORD, CB.LPARAM)
                IF PtInRect( tRect, MyPoint) THEN

                   'Check if mouse is still over item with focus
                   IF %ODM_BASE_MENUBAR_ITEM_ID +I = FocusItem THEN
                        EXIT FOR
                   END IF
                   K = GetMenuState( hMenu, I, %MF_BYPOSITION)

                   'If last item with focus has not been cleared, clear it
                   IF hTimer THEN
                      KillTimer CB.HNDL, hTimer
                      hTimer = 0
                      ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                      hIcon = MenuItemData( Offset-1).hIco
                      'Get RECT of menu item that had focus
                      GetMenuItemRect CB.HNDL, hMenu, FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
                      IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                           hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                       END IF
                      mRestoreMenuItem
                      IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                          DeleteObject hIcon
                      END IF
                   END IF

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

                   ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                   hIcon = MenuItemData( Offset-1).hIco
                   IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                       hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                   END IF
                   mHighlightMenuItem
                   IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                       DeleteObject hIcon
                   END IF
                   hTimer = SetTimer (CB.HNDL, 1, 100, BYVAL %Null)
                   EXIT FOR
                END IF
             NEXT
          END IF

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

       CASE %WM_COMMAND
           SELECT CASE CBCTL
               CASE %IDM_FILE_OPEN
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 0)  'File sub-menu
                   MENU GET STATE hSubMenu, BYCMD %IDM_FILE_OPEN TO Offset 'Dummy variable
                   Offset = Offset XOR %MF_CHECKED
                   MENU SET STATE hSubMenu, BYCMD %IDM_FILE_OPEN, Offset
               CASE %IDM_FILE_SAVE
                   MSGBOX "%IDM_FILE_SAVE=" + FORMAT$(%IDM_FILE_SAVE)
               CASE %IDM_FILE_EXIT
                   MSGBOX "%IDM_FILE_EXIT=" + FORMAT$(%IDM_FILE_EXIT)
               CASE %IDM_EDIT_CUT
                   MSGBOX "%IDM_EDIT_CUT=" + FORMAT$(%IDM_EDIT_CUT) + $CRLF + _
                          "Disabled Copy & Grayed Paste!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)  'Edit sub-menu
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_COPY, %MF_DISABLED
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_PASTE, %MF_GRAYED
               CASE %IDM_EDIT_COPY
                   MSGBOX "%IDM_EDIT_COPY=" + FORMAT$(%IDM_EDIT_COPY) + $CRLF + _
                          "Disabled Double Nested Test Sub-Menu!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)    'Edit sub-menu
                   hSubMenu = GetSubMenu( hSubMenu, 4) 'Sub-Menu Test sub-menu
                   MENU SET STATE hSubMenu, 3, %MF_DISABLED

                   'If you modify the top level menu, you must call RedrawWindow to force a repaint
                   MENU SET STATE hMenu, 1, %MF_GRAYED
                   MENU SET STATE hMenu, 3, %MF_GRAYED
                   RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                       %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
               CASE %IDM_EDIT_PASTE
                   MSGBOX "%IDM_EDIT_PASTE=" + FORMAT$(%IDM_EDIT_PASTE) + $CRLF + _
                          "Enabled Double Nested Test Sub-Menu!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)    'Edit sub-menu
                   hSubMenu = GetSubMenu( hSubMenu, 4) 'Sub-Menu Test sub-menu
                   MENU SET STATE hSubMenu, 3, %MF_ENABLED
               CASE %IDM_HELP_HELPTOPICS
                   MSGBOX "%IDM_HELP_HELPTOPICS=" + FORMAT$(%IDM_HELP_HELPTOPICS)
               CASE %IDM_HELP_ABOUT
                   MSGBOX "%IDM_HELP_ABOUT=" + FORMAT$(%IDM_HELP_ABOUT)
               CASE %IDM_EDIT_SUB_COOL
                   MSGBOX "%IDM_EDIT_SUB_COOL=" + FORMAT$(%IDM_EDIT_SUB_COOL) + $CRLF + _
                          "Enabled Copy & Paste!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)  'Edit sub-menu
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_COPY, %MF_ENABLED
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_PASTE, %MF_ENABLED

                   'If you modify the top level menu, you must call RedrawWindow to force a repaint
                   MENU SET STATE hMenu, 1, %MF_ENABLED
                   MENU SET STATE hMenu, 3, %MF_ENABLED
                   RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                    %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
               CASE %IDM_EDIT_SUB_DARE
                   MSGBOX "%IDM_EDIT_SUB_DARE=" + FORMAT$(%IDM_EDIT_SUB_DARE)
           END SELECT

       CASE %WM_DESTROY
           IF hTimer THEN
               KillTimer CB.HNDL, hTimer
           END IF
           DeleteObject hCustomBrush
           DeleteObject hCustomSunkenBrush
           DeleteObject hCustomBkBrush
           DeleteObject hCustomSunkenBkBrush
           DeleteObject hCustomFocusHLBrush
           DeleteObject hCustomFocusSelBrush
   END SELECT

END FUNCTION
'--------------------------------------------------------------------------------


'--------------------------------------------------------------------------------
'   ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

    LOCAL hDlg AS DWORD

    DIALOG NEW hParent, "OwnerDrawMenu Example Including Top Level Menu", 92, _
        98, 302, 172, %WS_OVERLAPPED OR %WS_THICKFRAME OR %WS_CAPTION OR _
        %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR _
        %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE OR _
        %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg

    'It's necessary to add a dummy button to force the menu command
    'accelerators ( '&F'ile ) to work.
    CONTROL ADD BUTTON, hDlg, 100, "Dummy Button", 0, 0, 0, 0

    AttachMENU1 hDlg

    AttachACCELERATOR1 hDlg

    DIALOG SET COLOR hDlg, GetColorFor( CurrentDisplayMode).TxDefault, _
          GetColorFor( CurrentDisplayMode).BkFace

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    FUNCTION = lRslt

END FUNCTION

**Stuart McLachlan** · 15 Nov 2020, 03:23 PM

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

**Stuart McLachlan** · 15 Nov 2020, 03:44 PM

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

**Tim Lakinir** · 15 Nov 2020, 04:05 PM

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

**Tim Lakinir** · 15 Nov 2020, 04:32 PM

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

**Stuart McLachlan** · 15 Nov 2020, 04:48 PM

Originally posted by Tim Lakinir View Post

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

I repeat: Do they draw a border or is the only part that is not "fill"ed ?

**Tim Lakinir** · 15 Nov 2020, 06:13 PM

Thank you Stuart found it at

Code:

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

**Tim Lakinir** · 15 Nov 2020, 08:07 PM

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

Code:

' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24067-owner-drawn-menu-bar-completely-customizable?p=785887#post785887


'************************************************************************
'* ODrawMenu.bas                                                           *
'*     by Bernard Ertl                                                  *
'*     July 11, 2002                                                    *
'*     Revamped July 12 - Changed from DrawState to DrawText            *
'*                      - Changed sizing handlers for min dialog width  *
'*                        and maximizing                                *
'*                      - Added STATIC array to track menu item data    *
'*                      - Streamlined tracking of focus RECTs           *
'*     Modified July 13 - Changed WM_INITDIALOG to eliminate reliance on*
'*                        GetMenuItemInfo & SetMenuItemInfo             *
'*                      - Changed WM_MEASURE handler to calculate tabbed*
'*                        submenu items correctly                       *
'*                      - Adjusted height for separators                *
'*     Modified July 14 - Added WM_NCLBUTTONDOWN handler                *
'*                      - Eliminated need for STATIC FocusRect & WM_MOVE*
'*                        repainting                                    *
'*                      - Corrected spacing of top level menu items     *
'*     Modified July 15 - Added support for nested sub-menus            *
'*                      - Overhauled painting & drawing to better       *
'*                        conform to standard menu behavior             *
'*                      - Ensured proper key-navigation for separators  *
'*     Modified July 16 - Included option to maintain focus highlighting*
'*                        when dialog is inactive                       *
'*                      - Corrected code for grayed/disabled items      *
'*     Modified July 17 - Grayed top menu bar when dialog is inactive   *
'*                      - Added support for %MF_CHECKED                 *
'*                      - Added support for auto-adjusting to the       *
'*                        color display mode                            *
'*     Modified July 18 - Added default checkmark if user does not      *
'*                        specify an icon                               *
'*                      - Shows icons for disabled/grayed items as      *
'*                        monochrome now                                *
'*                      - Corrected display for top level menu items    *
'*                        that are disabled/grayed                      *
'*     Modified July 21 - Added OS versioning support.  Menu conforms to*
'*                        standard behavior for the current OS.         *
'*                        ** Win95 tested OK                            *
'*                        ** Win98 tested OK (default)                  *
'*                        ** WinXP added, not fully tested              *
'*                                                                      *
'* CREDITS:                                                             *
'* Much of this code has been adapted from Borje Hagsten's & Semen      *
'* Matusovski's code found here:                                        *
'* http://www.powerbasic.com/support/forums/Forum4/HTML/004427.html      *
'*                                                                      *
'* Also, code has been adapted from Borje Hagsten's excellent DrawMenu  *
'* code.                                                                *
'*                                                                      *
'* Original skeleton code designed with PBForms 1.0.  PB Forms          *
'* metastatements have been removed since I had to do some editing      *
'* to the PB Forms blocks and it can not be reloaded correctly.         *
'*                                                                      *
'* Thanks to Aleksander Hjalmar for testing and suggesting improvements.*
'*                                                                      *
'* Thanks to Scott Turchin for the Windows OS Version Function.  I      *
'* modified it to suit my tastes...                                     *
'*                                                                      *
'* DESCRIPTION:                                                         *
'* This code shows how to completely customize a menu including the top *
'* level menu bar.  You can set colors and icons for all menu items.    *
'*                                                                      *
'* RESTRICTIONS:                                                        *
'* - Code requires that top level menubar items have IDs in a range     *
'*   greater than all sublevel menu items                               *
'* - Code assumes that all top level menubar items have sub-menus (no   *
'*   separators). Separators are OK in sub-menus.                       *
'* - Code assumes that all top level menubar items are UNCHECKED        *
'* - Code restricts minimum sizing of dialog width to the size of the   *
'*   menu bar because the background coloring of the menu bar does not  *
'*   work correctly at all times when the toolbar is multiple lines in  *
'*   height.                                                            *
'************************************************************************
'Modified 2019-OCT-16 by: Jim Fritts to work in PBWIN10.4 and J. Roca headers
' Modified by Tim Nov 15 2020 with better color and no OS check as
' it is not necessary since everyone is using Windows 10


#COMPILE EXE
#DIM ALL

    #INCLUDE "WIN32API.INC"


'--------------------------------------------------------------------------------
'   ** Constants **
'--------------------------------------------------------------------------------
%IDD_DIALOG1            = 101
%IDR_MENU1              = 102
%IDM_FILE_OPEN          = 1001
%IDR_ACCELERATOR1       = 103
%IDM_FILE_SAVE          = 1002
%IDM_FILE_EXIT          = 1003
%IDM_EDIT_CUT           = 1004
%IDM_EDIT_COPY          = 1005
%IDM_EDIT_PASTE         = 1006
%IDM_HELP_HELPTOPICS    = 1007
%IDM_HELP_ABOUT         = 1008
%IDM_EDIT_SUB_COOL      = 1009
%IDM_EDIT_SUB_DARE      = 1010

'These constants help define the menu structure
%ODM_BASE_MENUBAR_ITEM_ID = 9000  'This is the ID threshold for top level menubar items
%ODM_BASE_SUBMENU_ITEM_ID = 2000  'This is the ID threshold for any (sub-)menu items that contain sub-menus
%ODM_MAX_STRING           = 40    'Number of bytes for ASCIIZ menu strings

%ODM_ACCEL_KEY_SPACING     = 10   'Seems to work good
%ODM_ICON_IN_MENU_WIDTH    = 16   '16 for icon
%ODM_MARGIN_SPACING        = 4
%ODM_TEXT_OFFSET_FROM_ICON = 2    'Add spacing between sub-menu item's text and icon





'--------------------------------------------------------------------------------
'   ** Types **
'--------------------------------------------------------------------------------
'NOTE: hIco is the default icon image to display.  If you want to display checked/unchecked states,
'  hIco        = unchecked state icon  (could be NULL for no image)
'  hCheckedIco = checked state icon    (can be the same as hIco too)
'NOTE: wID **MUST** be the first item in the TYPE.
TYPE MenuItemType
   wID         AS DWORD  'Menu item's control ID
   zTxt        AS ASCIIZ * %ODM_MAX_STRING
   hIco        AS DWORD  'Default icon image
   hCheckedIco AS DWORD  'Checked icon image
   AccelWidth  AS LONG   'Holds TextExtent of any accelerator key text
END TYPE



TYPE ColorSet
   BkFace            AS LONG  'Color for raised button face
   BkFaceSunken      AS LONG  'Color for depressed button face
   BkHighlight       AS LONG  'Color for sub-menu highlighted items
   BkHighlightSunken AS LONG  'Color for depressed face on sub-menu higlighted items
   BkFocusHighlight  AS LONG  'Color for focus highlighting top level menu bar
   BkFocusSelect     AS LONG  'Color for selected top level menu bar item
   TxDefault         AS LONG  'Default color for text
   TxGrayed          AS LONG  'Color for grayed text
   TxHighlighted     AS LONG  'Color for highlighted text
END TYPE


'--------------------------------------------------------------------------------
'   ** Globals **
'--------------------------------------------------------------------------------
GLOBAL GetColorFor()      AS ColorSet
GLOBAL CurrentDisplayMode AS LONG


'--------------------------------------------------------------------------------
'   ** Macros **
'--------------------------------------------------------------------------------
'The following MACROS were added for coding clarity in the ShowDIALOG1Proc function
MACRO mHighlightMenuItem

        GetWindowRect CB.HNDL, tRect
        tRect.nBottom = FocusRect.nBottom - tRect.nTop
        tRect.nTop    = FocusRect.nTop    - tRect.nTop
        tRect.nRight  = FocusRect.nRight  - tRect.nLeft
        tRect.nLeft   = FocusRect.nLeft   - tRect.nLeft
        hDC = GetWindowDC( CB.HNDL)
        'Draw

         'WinME, WinNT, Win2k --- I'm not sure what the
         ' standard focus highlighting is for these OSes
           DrawEdge hDC, tRect, %BDR_RAISEDOUTER, %BF_RECT

        IF hIcon THEN
              DrawIconEx hDC, tRect.nLeft + %ODM_MARGIN_SPACING - 2,_
              tRect.nTop + 1, hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
        END IF
        ReleaseDC CB.HNDL, hDC

END MACRO


MACRO mRestoreMenuItem

        GetWindowRect CB.HNDL, tRect
        tRect.nBottom = FocusRect.nBottom - tRect.nTop
        tRect.nTop    = FocusRect.nTop    - tRect.nTop
        tRect.nRight  = FocusRect.nRight  - tRect.nLeft
        tRect.nLeft   = FocusRect.nLeft   - tRect.nLeft
        hDC = GetWindowDC( CB.HNDL)
        'Erase

         'WinME, WinNT, Win2k --- I'm not sure what
         'the standard focus highlighting is for these OSes
         FrameRect hDC, tRect, hCustomBrush

        'Redraw icon in case it overlapped the button frame
        IF hIcon THEN
            DrawIconEx hDC, tRect.nLeft + %ODM_MARGIN_SPACING - 2,_
            tRect.nTop + 1, hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
        END IF
        ReleaseDC CB.HNDL, hDC

END MACRO







'--------------------------------------------------------------------------------
'   ** PBMAIN **
'--------------------------------------------------------------------------------
FUNCTION PBMAIN()

     LOCAL dm AS DEVMODE

     DIM GetColorFor( 1)

    'Set colors for 256 color mode
  '  GetColorFor(0).BkFace            = RGB( 128, 128, 0)
 '   GetColorFor(0).BkFaceSunken      = RGB( 128, 128, 0) '%YELLOW does not make good 3D effect
 '   GetColorFor(0).BkHighlight       = RGB( 128, 0, 0)
  '  GetColorFor(0).BkHighlightSunken = RGB( 128, 0, 0)   '%RED does not make good 3D effect


   ' GetColorFor(0).BkFocusHighlight  = GetColorFor(0).BkHighlight
   ' GetColorFor(0).BkFocusSelect     = GetColorFor(0).BkHighlight

   ' GetColorFor(0).TxDefault         = %rgb_mediumblue
   ' GetColorFor(0).TxGrayed          = &H00505050  'Dark Gray
  '  GetColorFor(0).TxHighlighted     = GetSysColor( %COLOR_HIGHLIGHTTEXT)

    'Set colors for 16 bit/High Color or better
    GetColorFor(1).BkFace            = %RGB_AZURE
    GetColorFor(1).BkFaceSunken      = RGB( 220, 220, 188)
    GetColorFor(1).BkHighlight       = %RGB_LIGHTSKYBLUE

    GetColorFor(1).BkHighlightSunken = RGB( 187, 187, 128)


    GetColorFor(1).BkFocusHighlight  = GetColorFor(1).BkHighlight
    GetColorFor(1).BkFocusSelect     = GetColorFor(1).BkHighlight

    GetColorFor(1).TxDefault         = %RGB_MEDIUMBLUE
    GetColorFor(1).TxGrayed          = GetSysColor( %COLOR_GRAYTEXT)
    GetColorFor(1).TxHighlighted     = %RGB_MAGENTA

    'Get Current Display Mode
    dm.dmSize = LEN( DEVMODE)
    EnumDisplaySettings BYVAL 0, %ENUM_CURRENT_SETTINGS, dm
    CurrentDisplayMode = IIF&( dm.dmBitsPerPel > 8, 1, 0)

    ShowDIALOG1 %HWND_DESKTOP

END FUNCTION










 '--------------------------------------------------------------------------------
'   ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

    LOCAL hDlg AS DWORD

    DIALOG NEW hParent, "OwnerDrawMenu Example Including Top Level Menu", 92, _
        98, 402, 272, %WS_OVERLAPPED OR %WS_THICKFRAME OR %WS_CAPTION OR _
        %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR _
        %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE OR _
        %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg

    'It's necessary to add a dummy button to force the menu command
    'accelerators ( '&F'ile ) to work.
    CONTROL ADD BUTTON, hDlg, 100, "Dummy Button", 0, 0, 0, 0

    CreateMenu1 hDlg

    AttachACCELERATOR1 hDlg


    DIALOG SET COLOR hDlg, -1, %RGB_PAPAYAWHIP

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    FUNCTION = lRslt

END FUNCTION



'--------------------------------------------------------------------------------
'   ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()

   REGISTER I AS LONG, K AS LONG

   STATIC hCustomBrush         AS LONG  ' Custom background color
   STATIC hCustomSunkenBrush   AS LONG  ' Custom sunken background color (button depression)
   STATIC hCustomBkBrush       AS LONG  ' Custom background highlight color
   STATIC hCustomSunkenBkBrush AS LONG  ' Custom sunken background highlight color (button depression)
   STATIC hCustomFocusHLBrush  AS LONG  ' Custom highlight color for top level menu item
   STATIC hCustomFocusSelBrush AS LONG  ' Custom highlight color for selected top level menu item
   STATIC RightEdge            AS LONG  ' 'Coordinate' of the dialog's right edge
   STATIC BORDER               AS LONG  ' 'Coordinate' of the right edge of the last top level menubar item
   STATIC FocusItem            AS LONG  ' Control ID of the top level menubar item that has focus
   STATIC hTimer               AS DWORD ' Handle to Timer
   STATIC DialogIsActive       AS LONG  ' Track if dialog is active

   STATIC MenuItemData()  AS MenuItemType  'Maintain info for each ownerdrawn menu item
   'Note:  This is necessary because menu items with fType = %MFT_OWNERDRAW do not
   '       return the dwTypeData correctly.
   'Note:  If you want to have multiple dialogs active concurrently with ownerdrawn menus,
   '       they should have unique dialog callback functions.  Otherwise there will be problems
   '       with the STATIC variables.

   LOCAL Offset                AS LONG 'General purpose local variable
   LOCAL SubMenuID             AS LONG
   LOCAL MaxAccelTxtWidth      AS LONG
   LOCAL StartingSubMenuOffset AS LONG
   LOCAL FocusRect             AS RECT ' Coordinates of the top level menubar item with focus
   LOCAL NewColorMode          AS LONG

   LOCAL hDC      AS LONG  'Handles
   LOCAL hMenu    AS LONG
   LOCAL hSubMenu AS LONG
   LOCAL hIcon    AS LONG
   LOCAL hf       AS LONG

   LOCAL strMenu  AS STRING 'Strings
   LOCAL strMenu2 AS STRING
   LOCAL zTxt     AS ASCIIZ * %ODM_MAX_STRING

   LOCAL tRect    AS RECT   'For processing messages
   LOCAL t2Rect   AS RECT
   LOCAL ptrRECT  AS RECT PTR
   LOCAL SizeA    AS SizeL
   LOCAL ncm      AS NONCLIENTMETRICS
   LOCAL mminfo   AS MINMAXINFO PTR
   LOCAL pt       AS POINTAPI
   LOCAL lpmis    AS MEASUREITEMSTRUCT PTR
   LOCAL lpdis    AS DRAWITEMSTRUCT PTR

   SELECT CASE CB.MSG
       CASE %WM_INITDIALOG
           'Initialize var
           DialogIsActive = %True

           'Get starting dimensions for dialog
           GetClientRect CB.HNDL, tRect
           'Save total width
           RightEdge = tRect.nRight + 4
           hCustomBrush         = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFace)
           hCustomSunkenBrush   = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFaceSunken)
           hCustomBkBrush       = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlight)
           hCustomSunkenBkBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlightSunken)
           hCustomFocusHLBrush  = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusHighlight)
           hCustomFocusSelBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusSelect)

           hMenu = GetMenu( CB.HNDL)

           'Count Max# total menu & sub-menu items
           I = CountItems( hMenu)
           'Dimension array for strings and icons
           DIM MenuItemData( I)
           SubMenuID = %ODM_BASE_SUBMENU_ITEM_ID

           'Now we modify our menu to
           '  1) add control ID's to the top level menubar items
           '  2) change all items to ownerdraw

           FOR K = 0 TO GetMenuItemCount( hMenu) - 1
              '--- SUB-MENUS ----------------------
              hSubMenu = GetSubMenu( hMenu, K)
              ModifySubMenu CB.HNDL, hSubMenu, VARPTR( MenuItemData( 0)), Offset, SubMenuID
              '--- TOP-LEVEL MENUS ----------------------
              GetMenuString hMenu, K, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
              INCR Offset
              'Set an ID for top level menubar items
              MenuItemData( Offset).wID  = %ODM_BASE_MENUBAR_ITEM_ID + K
              MenuItemData( Offset).zTxt = zTxt

              'Modify the following SELECT CASE as desired to add icons
              'where you want them.  You can also load icons from a resource file
              SELECT CASE AS LONG K
                 CASE 0  'First menu bar item
                'Check spacing on menu item with no icon....
'                MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_APPLICATION)
                 CASE 1  'Second menu bar item
                    MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_ASTERISK)
                 CASE 2  'Third menu bar item
                    MenuItemData( Offset).hIco = LoadIcon(0, BYVAL %IDI_WINLOGO)
                 CASE ELSE
                    'No icons to display
              END SELECT
              ModifyMenu hMenu, K, %MF_BYPOSITION OR _
                 %MF_OWNERDRAW, MenuItemData( Offset).wID, BYVAL 0
           NEXT

       CASE %WM_GETMINMAXINFO
           mminfo = CB.LPARAM
           'Set the minimum dialog width to avoid incorrect
           'painting of multi-line top level menubar
           @mminfo.ptMinTrackSize.x = BORDER + 16

       CASE %WM_NCACTIVATE
            DialogIsActive = CB.WPARAM
           'WinME, WinNT, Win2k, WinXP --- I assume these OSes
           ' gray text for dialogs without focus
             IF DialogIsActive THEN
                    RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0,_
                    %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
             END IF


       CASE %WM_DISPLAYCHANGE
           NewColorMode = IIF&( CB.WPARAM > 8, 1, 0)
           IF NewColorMode <> CurrentDisplayMode THEN
              CurrentDisplayMode = NewColorMode
              'Release old brushes
              DeleteObject hCustomBrush
              DeleteObject hCustomSunkenBrush
              DeleteObject hCustomBkBrush
              DeleteObject hCustomSunkenBkBrush
              DeleteObject hCustomFocusHLBrush
              DeleteObject hCustomFocusSelBrush
              'Get new brushes
              hCustomBrush         = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFace)
              hCustomSunkenBrush   = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFaceSunken)
              hCustomBkBrush       = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlight)
              hCustomSunkenBkBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkHighlightSunken)
              hCustomFocusHLBrush  = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusHighlight)
              hCustomFocusSelBrush = CreateSolidBrush( GetColorFor( CurrentDisplayMode).BkFocusSelect)
              'Force redraw of menu bar
              DIALOG SET COLOR  CB.HNDL, _
                  GetColorFor( CurrentDisplayMode).TxDefault, GetColorFor( CurrentDisplayMode).BkFace
              RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, %RDW_ERASE OR _
                %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
           END IF

       CASE %WM_MEASUREITEM
           IF CB.WPARAM = 0 THEN  'a menu is calling
              lpmis = CB.LPARAM

              ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( @lpmis.itemID), TO Offset
              DECR Offset  'Adjust for zero base
              zTxt = PARSE$( MenuItemData( Offset).zTxt, $TAB, 1)

              hDC = GetDC( CB.HNDL)
                ncm.cbSize = LEN( NONCLIENTMETRICS)
                SystemParametersInfo %SPI_GETNONCLIENTMETRICS, SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                IF LEN(ncm.lfMenuFont) THEN
                   hf = CreateFontIndirect(ncm.lfMenuFont)
                   IF hf THEN hf = SelectObject(hDC, hf)
                END IF
                GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                @lpmis.itemHeight = ncm.iMenuHeight + 2
                SELECT CASE AS LONG @lpmis.itemId
                   CASE 0
                      'Separator
                      @lpmis.itemHeight = ncm.iMenuHeight \ 2
                   CASE < %ODM_BASE_MENUBAR_ITEM_ID
                      'Submenu item
                      @lpmis.itemWidth  = sizeA.cx + _
                          MenuItemData( Offset).AccelWidth + _
                           %ODM_ACCEL_KEY_SPACING + %ODM_TEXT_OFFSET_FROM_ICON
                   CASE ELSE
                      'Top level menu item
                      IF MenuItemData( Offset).hIco THEN
                         'Add margins for both right & left sides
                         @lpmis.itemWidth  = sizeA.cx + %ODM_MARGIN_SPACING + %ODM_MARGIN_SPACING
                      ELSE
                         'Add margins for both right & left sides
                         'Remove space for icon
                         @lpmis.itemWidth  = sizeA.cx - %ODM_ICON_IN_MENU_WIDTH + _
                            %ODM_MARGIN_SPACING + %ODM_MARGIN_SPACING
                      END IF
                END SELECT
                IF hf THEN
                    DeleteObject SelectObject(hDC, hf)
                END IF
              ReleaseDC CB.HNDL, hDC
              FUNCTION = 1
           END IF

       CASE %WM_DRAWITEM
           IF CB.WPARAM = 0 THEN
             'if identifier is 0, message was sent by a menu
              lpdis = CB.LPARAM

              IF @lpdis.itemId THEN
                 'Not a separator (they have .itemID=0)

                 ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( @lpdis.itemID), TO Offset
                 DECR Offset  'Adjust for zero base
                 zTxt  = MenuItemData( Offset).zTxt
                 IF (@lpdis.itemState AND %ODS_CHECKED) THEN
                    hIcon = MenuItemData( Offset).hCheckedIco
                 ELSE
                    hIcon = MenuItemData( Offset).hIco
                 END IF

                 MaxAccelTxtWidth = MenuItemData( Offset).AccelWidth
                 Offset = 0  'We will reuse the Offset variable for positioning

                 IF @lpdis.itemId >= %ODM_BASE_MENUBAR_ITEM_ID THEN
                    'Top Level Menu
                    'Erase bottom border...
                    tRect = @lpdis.rcItem
                    INCR tRect.nBottom
                    ' Win2k
                    ' Paint custom background...
                      FillRect @lpdis.hDC, tRect, hCustomBrush
                      IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                             'Standard Windows 98 focus edging
                             DrawEdge @lpdis.hDC, @lpdis.rcItem, %BDR_SUNKENOUTER, %BF_RECT
                             'Needed for our custom color to show top & left edges....
                             ' (If you change the custom color the following may not be necessary)
                             DrawEdge @lpdis.hDC, @lpdis.rcItem, %EDGE_SUNKEN, %BF_TOPLEFT
                       ELSE
                             Offset = -1  'Offset for text to move it when "button" is NOT "clicked"
                       END IF

                    IF ISTRUE DialogIsActive  THEN
                       IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                       ELSE
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxDefault
                       END IF
                    ELSE
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                    END IF

                    'Set Border when at last top level menu item
                    IF @lpdis.itemId = %ODM_BASE_MENUBAR_ITEM_ID + _
                               GetMenuItemCount( GetMenu( CB.HNDL)) - 1 THEN
                       BORDER = @lpdis.rcItem.nRight
                       IF RightEdge > 0 THEN
                           tRect = @lpdis.rcItem
                           tRect.nLeft = BORDER
                           tRect.nRight = RightEdge
                           INCR tRect.nBottom
                           FillRect @lpdis.hDC, tRect, hCustomBrush
                       END IF
                    END IF
                 ELSE
                    'Sub-level Menu
                    IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                       'COLOR NOTE:
                       '   Windows automatically draws the sub-menu arrow icon even with ownerdrawn
                       '   status.  Windows uses the default colors for the arrow icon:
                       '        %COLOR_MENUTEXT? for unhighlighted items and
                       '        %COLOR_HIGHLIGHTTEXT for highlighted items
                       '   Setting the background highlight &/or text to different colors
                       '   may yield unsatisfactory results.
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBkBrush
                       IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                       ELSE
                          SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxHighlighted
                       END IF
                    ELSEIF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxGrayed
                    ELSE
                       FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                       SetTextColor @lpdis.hDC, GetColorFor( CurrentDisplayMode).TxDefault
                    END IF
                 END IF

                 IF (@lpdis.itemState AND %ODS_CHECKED) THEN
                    'Need to show depressed button effect
                    tRect = @lpdis.rcItem
                   'A total width of 20 pixels, 16 for icon, 4 for margins
                    tRect.nRight = tRect.nLeft + 19
                    DrawEdge @lpdis.hDC, tRect, %BDR_SUNKENOUTER, %BF_RECT
                    IF CurrentDisplayMode = 0 THEN
                       '256 color mode
                       'Needed for our custom color to show top & left edges....
                       ' (If you change the custom color the following may not be necessary)
                       DrawEdge @lpdis.hDC, tRect, %EDGE_SUNKEN, %BF_TOPLEFT
                    END IF
                    INCR tRect.nTop
                   ' INCR tRect.nLeft
                    tRect.nLeft = tRect.nLeft + 2
                   ' DECR tRect.nRight
                    tRect.nRight = tRect.nRight -2
                    DECR tRect.nBottom
                    IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                          FillRect @lpdis.hDC, tRect, hCustomSunkenBkBrush
                    ELSE
                          FillRect @lpdis.hDC, tRect, hCustomSunkenBrush
                    END IF
                    IF hIcon = 0 THEN
                       'No user defined icon, so draw standard windows checkmark
                       'Get bitmap
                       hIcon = LoadBitMap( BYVAL 0, BYVAL %OBM_CHECK)
                       IF hIcon <> 0 THEN
                          'Make a brush colored same as text in temporary variable
                          hf = CreateSolidBrush( GetColorFor( CurrentDisplayMode).TxDefault)
                          'Draw checkmark in mono mode so it doesn't draw a background
                          CALL DrawState(@lpdis.hDC, hf, 0&, hIcon, 0&, @lpdis.rcItem.nleft + 3, _
                                  @lpdis.rcItem.nTop + 4, 16, 16, %DST_BITMAP OR %DSS_MONO)
                          'Delete the bitmap when done, to avoid memory leaks!
                          DeleteObject hIcon
                          hIcon = 0
                          DeleteObject hf
                       END IF
                    END IF
                 END IF

                 SetBkMode @lpdis.hDC, %TRANSPARENT

                 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                 ' Get menu item string and split up into
                 ' ev. text and shortcut part
                 strMenu2 = zTxt
                 IF INSTR(strMenu2, $TAB) THEN
                    'if it has shortcut (Ctrl+X, etc.)
                    strMenu  = TRIM$(PARSE$(strMenu2, $TAB, 1))
                    strMenu2 = TRIM$(PARSE$(strMenu2, $TAB, 2))
                 ELSE
                    strMenu = TRIM$(strMenu2)
                    strMenu2 = ""
                 END IF

                 IF LEN( strMenu) <> 0 THEN
                    tRect = @lpdis.rcItem
                    IF Offset THEN
                       tRect.nTop    = tRect.nTop    + Offset
                       tRect.nBottom = tRect.nBottom + Offset
                    END IF
                    IF @lpdis.itemId >= %ODM_BASE_MENUBAR_ITEM_ID THEN
                       IF hIcon THEN
                           'Leave room for icons
                          tRect.nLeft = @lpdis.rcItem.nleft + _
                               %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING\2 + Offset*2
                          DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                                 LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR _
                                  %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                          END IF
                          DrawIconEx @lpdis.hDC, @lpdis.rcItem.nleft + _
                                  %ODM_MARGIN_SPACING + Offset - 1, @lpdis.rcItem.nTop + 2 + Offset, _
                                     hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              DeleteObject hIcon
                          END IF
                       ELSE
                          'When no icon in top level, adjust RECT
                          tRect.nLeft = @lpdis.rcItem.nleft + Offset*2
                          DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                           LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR _
                            %DT_SINGLELINE OR %DT_VCENTER OR %DT_CENTER
                       END IF
                    ELSE
                       tRect.nLeft = @lpdis.rcItem.nleft + _
                         %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING + _
                          %ODM_TEXT_OFFSET_FROM_ICON 'Leave room for icons
                       DrawText @lpdis.hDC, BYVAL STRPTR(strMenu), _
                             LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR _
                                %DT_SINGLELINE OR %DT_VCENTER
                       IF LEN(strMenu2) THEN
                          tRect.nLeft = @lpdis.rcItem.nRight - MaxAccelTxtWidth
                          DrawText @lpdis.hDC, BYVAL STRPTR(strMenu2), _
                           LEN(strMenu2), tRect, %DT_LEFT OR %DT_NOCLIP _
                               OR %DT_SINGLELINE OR %DT_VCENTER
                       END IF
                       'Draw icon if any...
                       IF hIcon THEN
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                          END IF
                          DrawIconEx @lpdis.hDC, @lpdis.rcItem.nleft + 1, _
                                     @lpdis.rcItem.nTop + 2, _
                                     hIcon, 16, 16, 0, BYVAL 0, %DI_NORMAL
                          IF (@lpdis.itemState AND (%ODS_DISABLED OR %ODS_GRAYED)) THEN
                              DeleteObject hIcon
                          END IF
                       END IF
                    END IF
                 END IF
              ELSE
                 'Draw a separator
                 'Sub-level Menu
                 FillRect @lpdis.hDC, @lpdis.rcItem, hCustomBrush
                 tRect = @lpdis.rcItem
                 tRect.nTop  = tRect.nTop + (tRect.nBottom - tRect.nTop)\2
                 DrawEdge @lpdis.hDC, tRect, %EDGE_ETCHED, %BF_TOP
              END IF
              FUNCTION = 1
           END IF

       CASE %WM_SIZING
          SELECT CASE AS LONG CB.WPARAM
             CASE %WMSZ_BOTTOMRIGHT, %WMSZ_TOPRIGHT, %WMSZ_RIGHT
                'Get dimensions for dialog
                GetClientRect CB.HNDL, tRect
                'Save total width
                RightEdge = tRect.nRight + 4

                'Get new proposed size
                ptrRECT = CB.LPARAM

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

                'Get new proposed size
                ptrRECT = CB.LPARAM

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

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

             RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                 %RDW_INVALIDATE OR %RDW_FRAME OR _
                 %RDW_UPDATENOW OR %RDW_ALLCHILDREN
          END IF

       CASE %WM_NCLBUTTONDOWN
          'Mouse cursor is in non-client area
          IF CB.WPARAM = %HTMENU THEN
             'If last item with focus has not been cleared, clear it
             IF hTimer THEN
                KillTimer CB.HNDL, hTimer
                hTimer = 0
                FocusItem = 0
             END IF
          END IF

       CASE %WM_NCMOUSEMOVE
           LOCAL MyPoint AS POINT

          'Mouse cursor is in non-client area
          IF CB.WPARAM = %HTMENU THEN
             'WinME, WinNT, Win2k, WinXP
             'Not sure what the standard focus highlighting behavior is
             'when the dialog is not active.
             'Add focus highlighting only if dialog is active...
             IF ISFALSE DialogIsActive THEN
                EXIT FUNCTION
             END IF


             'If mouse cursor is over the menubar, check which
             ' menubar item is under the cursor
             hMenu = GetMenu( CB.HNDL)
             FOR I = 0 TO GetMenuItemCount( hMenu) - 1
                GetMenuItemRect CB.HNDL, hMenu, I, tRect
                'IF PtInRect( tRect, LO(WORD, CB.LPARAM), HIWRD( CB.LPARAM)) THEN
                MyPoint.x = LO(WORD, CB.LPARAM)
                MyPoint.y = HI(WORD, CB.LPARAM)
                IF PtInRect( tRect, MyPoint) THEN

                   'Check if mouse is still over item with focus
                   IF %ODM_BASE_MENUBAR_ITEM_ID +I = FocusItem THEN
                        EXIT FOR
                   END IF
                   K = GetMenuState( hMenu, I, %MF_BYPOSITION)

                   'If last item with focus has not been cleared, clear it
                   IF hTimer THEN
                      KillTimer CB.HNDL, hTimer
                      hTimer = 0
                      ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                      hIcon = MenuItemData( Offset-1).hIco
                      'Get RECT of menu item that had focus
                      GetMenuItemRect CB.HNDL, hMenu, FocusItem - %ODM_BASE_MENUBAR_ITEM_ID, FocusRect
                      IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                           hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                       END IF
                      mRestoreMenuItem
                      IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                          DeleteObject hIcon
                      END IF
                   END IF

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

                   ARRAY SCAN MenuItemData(), FROM 1 TO 4, =MKDWD$( FocusItem), TO Offset
                   hIcon = MenuItemData( Offset-1).hIco
                   IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                       hIcon = CopyImage( hIcon, %IMAGE_ICON, 16, 16, %LR_MONOCHROME)
                   END IF
                   mHighlightMenuItem
                   IF (LOBYT( LO(WORD, K)) AND (%MF_DISABLED OR %MF_GRAYED)) THEN
                       DeleteObject hIcon
                   END IF
                   hTimer = SetTimer (CB.HNDL, 1, 100, BYVAL %Null)
                   EXIT FOR
                END IF
             NEXT
          END IF

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

       CASE %WM_COMMAND
           SELECT CASE CBCTL
               CASE %IDM_FILE_OPEN
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 0)  'File sub-menu
                   MENU GET STATE hSubMenu, BYCMD %IDM_FILE_OPEN TO Offset 'Dummy variable
                   Offset = Offset XOR %MF_CHECKED
                   MENU SET STATE hSubMenu, BYCMD %IDM_FILE_OPEN, Offset
               CASE %IDM_FILE_SAVE
                   MSGBOX "%IDM_FILE_SAVE=" + FORMAT$(%IDM_FILE_SAVE)
               CASE %IDM_FILE_EXIT
                   MSGBOX "%IDM_FILE_EXIT=" + FORMAT$(%IDM_FILE_EXIT)
               CASE %IDM_EDIT_CUT
                   MSGBOX "%IDM_EDIT_CUT=" + FORMAT$(%IDM_EDIT_CUT) + $CRLF + _
                          "Disabled Copy & Grayed Paste!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)  'Edit sub-menu
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_COPY, %MF_DISABLED
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_PASTE, %MF_GRAYED
               CASE %IDM_EDIT_COPY
                   MSGBOX "%IDM_EDIT_COPY=" + FORMAT$(%IDM_EDIT_COPY) + $CRLF + _
                          "Disabled Double Nested Test Sub-Menu!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)    'Edit sub-menu
                   hSubMenu = GetSubMenu( hSubMenu, 4) 'Sub-Menu Test sub-menu
                   MENU SET STATE hSubMenu, 3, %MF_DISABLED

                   'If you modify the top level menu, you must call
                   ' RedrawWindow to force a repaint
                   MENU SET STATE hMenu, 1, %MF_GRAYED
                   MENU SET STATE hMenu, 3, %MF_GRAYED
                   RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                       %RDW_INVALIDATE OR %RDW_FRAME OR  _
                       %RDW_UPDATENOW OR %RDW_ALLCHILDREN

               CASE %IDM_EDIT_PASTE
                   MSGBOX "%IDM_EDIT_PASTE=" + FORMAT$(%IDM_EDIT_PASTE) + $CRLF + _
                          "Enabled Double Nested Test Sub-Menu!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)    'Edit sub-menu
                   hSubMenu = GetSubMenu( hSubMenu, 4) 'Sub-Menu Test sub-menu
                   MENU SET STATE hSubMenu, 3, %MF_ENABLED

               CASE %IDM_HELP_HELPTOPICS
                   MSGBOX "%IDM_HELP_HELPTOPICS=" + FORMAT$(%IDM_HELP_HELPTOPICS)

               CASE %IDM_HELP_ABOUT
                   MSGBOX "%IDM_HELP_ABOUT=" + FORMAT$(%IDM_HELP_ABOUT)

               CASE %IDM_EDIT_SUB_COOL
                   MSGBOX "%IDM_EDIT_SUB_COOL=" + FORMAT$(%IDM_EDIT_SUB_COOL) + $CRLF + _
                          "Enabled Copy & Paste!"
                   hMenu = GetMenu( CB.HNDL)
                   hSubMenu = GetSubMenu( hMenu, 1)  'Edit sub-menu
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_COPY, %MF_ENABLED
                   MENU SET STATE hSubMenu, BYCMD %IDM_EDIT_PASTE, %MF_ENABLED

                   'If you modify the top level menu, you must call
                   ' RedrawWindow to force a repaint
                   MENU SET STATE hMenu, 1, %MF_ENABLED
                   MENU SET STATE hMenu, 3, %MF_ENABLED
                   RedrawWindow CB.HNDL, BYVAL 0, BYVAL 0, _
                    %RDW_INVALIDATE OR %RDW_FRAME OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN

               CASE %IDM_EDIT_SUB_DARE
                   MSGBOX "%IDM_EDIT_SUB_DARE=" + FORMAT$(%IDM_EDIT_SUB_DARE)
           END SELECT

       CASE %WM_DESTROY
           IF hTimer THEN
               KillTimer CB.HNDL, hTimer
           END IF
           DeleteObject hCustomBrush
           DeleteObject hCustomSunkenBrush
           DeleteObject hCustomBkBrush
           DeleteObject hCustomSunkenBkBrush
           DeleteObject hCustomFocusHLBrush
           DeleteObject hCustomFocusSelBrush
   END SELECT

END FUNCTION


'--------------------------------------------------------------------------------
'   ** Menus ** this creates the menu
'--------------------------------------------------------------------------------
FUNCTION CreateMenu1(BYVAL hDlg AS DWORD) AS DWORD

    LOCAL hMenu AS LONG
    LOCAL hPopUp1 AS LONG
    LOCAL hPopUp2 AS LONG
    LOCAL hPopUp3 AS LONG

    MENU NEW BAR TO hMenu
    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "Super Fabulous &File Menu", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Open" + $TAB + "Ctrl+O", %IDM_FILE_OPEN, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Save" + $TAB + "Ctrl+S", %IDM_FILE_SAVE, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "-", 0, 0
        MENU ADD STRING, hPopUp1, "&Exit" + $TAB + "Ctrl+E", %IDM_FILE_EXIT, _
            %MF_ENABLED

    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "&Edit", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "C&ut" + $TAB + "Ctrl+X", %IDM_EDIT_CUT, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Copy" + $TAB + "Ctrl+C", %IDM_EDIT_COPY, _
            %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Paste" + $TAB + "Ctrl+V", %IDM_EDIT_PASTE, _
            %MF_GRAYED
        MENU ADD STRING, hPopUp1, "-", 0, 0

        MENU NEW POPUP TO hPopUp2
        MENU ADD POPUP, hPopUp1, "&Sub-Menu Test", hPopUp2, %MF_ENABLED
           MENU ADD STRING, hPopUp2, "&Cool", %IDM_EDIT_SUB_COOL, _
               %MF_ENABLED
           MENU ADD STRING, hPopUp2, "-", 0, 0
           MENU NEW POPUP TO hPopUp3
           MENU ADD POPUP, hPopUp2, "Double &Nested Test", hPopUp3, %MF_ENABLED
              MENU ADD STRING, hPopUp3, "&Dare to Dream" + _
                $TAB + "Ctrl+D", %IDM_EDIT_SUB_DARE, _
                  %MF_ENABLED

    MENU NEW POPUP TO hPopUp1
    MENU ADD POPUP, hMenu, "&Help", hPopUp1, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&Help Topics" + $TAB + "F1", _
            %IDM_HELP_HELPTOPICS, %MF_ENABLED
        MENU ADD STRING, hPopUp1, "&About" + $TAB + "Ctrl+A", %IDM_HELP_ABOUT, _
            %MF_ENABLED

    MENU ATTACH hMenu, hDlg

    FUNCTION = hMenu

END FUNCTION






 '--------------------------------------------------------------------------------
'   ** Accelerators **
'
' No code was modified for accelerators.  This is straight out of PBForms
'--------------------------------------------------------------------------------
FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd AS WORD, _
    BYVAL byFVirt AS BYTE) AS LONG
    tAccel.fVirt = byFVirt
    tAccel.key = wKey
    tAccel.cmd = wCmd
END FUNCTION




FUNCTION AttachACCELERATOR1(BYVAL hDlg AS DWORD) AS DWORD

    LOCAL hAccel AS DWORD
    LOCAL tAccel() AS ACCELAPI
    DIM tAccel(1 TO 9)

    ASSIGNACCEL tAccel(1), ASC("O"), %IDM_FILE_OPEN, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(2), ASC("S"), %IDM_FILE_SAVE, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(3), ASC("E"), %IDM_FILE_EXIT, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(4), ASC("X"), %IDM_EDIT_CUT, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(5), ASC("C"), %IDM_EDIT_COPY, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(6), ASC("V"), %IDM_EDIT_PASTE, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(7), %VK_F1, %IDM_HELP_HELPTOPICS, %FVIRTKEY OR %FNOINVERT
    ASSIGNACCEL tAccel(8), ASC("A"), %IDM_HELP_ABOUT, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT
    ASSIGNACCEL tAccel(9), ASC("D"), %IDM_EDIT_SUB_DARE, %FVIRTKEY OR %FCONTROL OR _
        %FNOINVERT

    ACCEL ATTACH hDlg, tAccel() TO hAccel

    FUNCTION = hAccel

END FUNCTION







FUNCTION CountItems( BYVAL hMenu AS LONG) AS LONG

   REGISTER I AS LONG, K AS LONG

   LOCAL hSubMenu AS LONG

   FOR K = 0 TO GetMenuItemCount( hMenu) - 1
      INCR I  'Count hMenu item...
      hSubMenu = GetSubMenu( hMenu, K)
      IF hSubMenu THEN I = I + CountItems( hSubMenu) 'Add all nested items for hSubMenu item
   NEXT

   FUNCTION = I

END FUNCTION



SUB ModifySubMenu( BYVAL hDlg AS LONG, _                'Handle of dialog
                   BYVAL hSubMenu AS LONG, _            'Handle to sub-menu
                   BYVAL ptrMID AS MenuItemType PTR, _  'Pointer to MenuItemData array
                   Offset AS LONG, _                    'Current subscript for MenuItemData array
                   SubMenuID AS LONG)                   'Tracks ID# to assign to a sub-menu

   REGISTER I AS LONG, K AS LONG

   LOCAL MaxAccelTxtWidth AS LONG
   LOCAL Result AS LONG
   LOCAL hf     AS LONG
   LOCAL hDC    AS LONG
   LOCAL SizeA  AS SizeL
   LOCAL ncm    AS NONCLIENTMETRICS
   LOCAL StartingSubMenuOffset AS LONG
   LOCAL zTxt   AS ASCIIZ * %ODM_MAX_STRING
   LOCAL hNestedMenu AS LONG

   'Remember where we started...
   StartingSubMenuOffset = Offset + 1

   'Loop through all sub-menu items...
   FOR I = 0 TO GetMenuItemCount( hSubMenu) - 1
      'Determine what the sub-menu item is...
      Result = GetMenuState( hSubMenu, I, %MF_BYPOSITION)
      hNestedMenu = GetSubMenu( hSubMenu, I)

      IF hNestedMenu THEN
         'Nested sub-menu
         GetMenuString hSubMenu, I, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
         INCR Offset
         @ptrMID[ Offset].wID = SubMenuID
         INCR SubMenuID
         @ptrMID[ Offset].zTxt = zTxt
         SELECT CASE AS CONST$ zTxt
            CASE "&Sub-Menu Test"
               @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_QUESTION)
            CASE "Double &Nested Test"
               @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_HAND)
            CASE ELSE
               'No icons to display
         END SELECT

         'Change to %MFT_OWNERDRAW
         ModifyMenu hSubMenu, I, (LOBYT( LO(WORD, Result)) XOR %MF_POPUP) OR _
             %MF_BYPOSITION OR %MF_OWNERDRAW, @ptrMID[ Offset].wID, BYVAL 0

         'Set max accelerator ket text width for all sub-menu items up to now...
         FOR K = StartingSubMenuOffset TO Offset
            @ptrMID[ K].AccelWidth = MaxAccelTxtWidth + _
             %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING
         NEXT
         'Modify the nested sub-menu...
         ModifySubMenu hDlg, hNestedMenu, ptrMID, Offset, SubMenuID

         'Start new block...
         StartingSubMenuOffset = Offset + 1
      ELSE
         IF (Result AND %MF_SEPARATOR) THEN
            'Change %MFT_SEPARATOR to %MFT_OWNERDRAW, maintain ID = 0
            ModifyMenu hSubMenu, I, Result OR %MF_BYPOSITION OR %MF_OWNERDRAW, 0, BYVAL 0
         ELSE
            'Change %MFT_STRING to %MFT_OWNERDRAW,
            ' add icons, calculate width of accelerator key text
            GetMenuString hSubMenu, I, zTxt, SIZEOF( zTxt), %MF_BYPOSITION
            INCR Offset
            @ptrMID[ Offset].wID = GetMenuItemID( hSubMenu, I)
            @ptrMID[ Offset].zTxt = zTxt

            'Modify the following SELECT CASE as desired to add icons
            'where you want them.  You can also load icons from a resource file
            SELECT CASE AS LONG @ptrMID[ Offset].wID
               CASE %IDM_FILE_OPEN
                  @ptrMID[ Offset].hIco  = LoadIcon(0, BYVAL %IDI_EXCLAMATION)
'Leave out checked icon to test default icon
'Uncomment to see custom checked icon
'              @ptrMID[ Offset].hCheckedIco = LoadIcon(0, BYVAL %IDI_HAND)
               CASE %IDM_EDIT_CUT
                  @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_EXCLAMATION)
               CASE %IDM_HELP_ABOUT
                  @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_APPLICATION)
               CASE %IDM_HELP_HELPTOPICS
                  @ptrMID[ Offset].hIco = LoadIcon(0, BYVAL %IDI_QUESTION)
               CASE ELSE
                  'No icons to display
            END SELECT

            'Change %MFT_STRING to %MFT_OWNERDRAW
            ModifyMenu hSubMenu, I, Result OR %MF_BYPOSITION OR _
              %MF_OWNERDRAW, @ptrMID[ Offset].wID, BYVAL 0

            'Determine width of accelerator key text
            IF INSTR( zTxt, $TAB) THEN
               zTxt = PARSE$( zTxt, $TAB, 2)   'Get accelerator key text
               hDC = GetDC( hDlg)
                  ncm.cbSize = LEN( NONCLIENTMETRICS)
                  SystemParametersInfo %SPI_GETNONCLIENTMETRICS, _
                      SIZEOF( ncm), BYVAL VARPTR(ncm), 0
                  IF LEN(ncm.lfMenuFont) THEN
                     hf = CreateFontIndirect(ncm.lfMenuFont)
                     IF hf THEN
                         hf = SelectObject(hDC, hf)
                     END IF
                  END IF
                  GetTextExtentPoint32 hDC, zTxt, LEN( zTxt), SizeA
                  IF sizeA.cx > MaxAccelTxtWidth THEN
                      MaxAccelTxtWidth = sizeA.cx
                  END IF
                  IF hf THEN
                      DeleteObject SelectObject(hDC, hf)
                  END IF
               ReleaseDC hDlg, hDC
            END IF
         END IF
      END IF
   NEXT
   'Set max accelerator ket text width for all sub-menu items...
   FOR I = StartingSubMenuOffset TO Offset
      @ptrMID[ I].AccelWidth = MaxAccelTxtWidth + _
       %ODM_ICON_IN_MENU_WIDTH + %ODM_MARGIN_SPACING
   NEXT

END SUB

**Stuart McLachlan** · 15 Nov 2020, 09:28 PM

Originally posted by Tim Lakinir View Post

Thank you Stuart found it at

Code:

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

Great! You've learnt something.

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

**Michael Mattias** · 16 Nov 2020, 11:14 AM

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

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

MCM

**Stuart McLachlan** · 16 Nov 2020, 04:49 PM

Originally posted by Michael Mattias View Post

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

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

MCM

You mean like this part of Tim's code where he does exactly that?

Code:

hf = SelectObject( hDC, CreatePen( %PS_SOLID, 0, I))
'Draw frame using custom colored pen
MoveToEx hDC, tRect.nLeft, tRect.nTop, BYVAL 0
LineTo hDC, tRect.nRight-1, tRect.nTop
LineTo hDC, tRect.nRight-1, tRect.nBottom-1
LineTo hDC, tRect.nLeft, tRect.nBottom-1
LineTo hDC, tRect.nLeft, tRect.nTop

An expression about grandmothers and eggs come to mind

**Michael Mattias** · 17 Nov 2020, 10:21 AM

oops... duplicated! Something "glitched:" somewhere!

**Michael Mattias** · 17 Nov 2020, 10:30 AM

An expression about grandmothers and eggs come to mind

No expressions, sayings, old saws or proverbs coming to mind, I checked with Google(r) and found this...

Teaching (your) grandmother to suck eggs is an English language saying that refers to a person giving advice to another person in a subject with which the other person is already familiar (and probably more so than the first person).

.. and assume that is the saying to which you refer.

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

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

MCM

**James C Morgan** · 17 Nov 2020, 09:59 PM

Code:

DrawFrameControl @lpDis.hDC, @lpDis.rcItem, %DFC_BUTTON, %DFCS_BUTTONPUSH Or %DFCS_PUSHED OR %DFCS_MONO

%dfcs_mono makes a border you can color it

**James C Morgan** · 20 Nov 2020, 11:25 PM

Thanks to Borje Hagsten Pierre Bellisle Tim Lakinir for basicroutine

iF YOU LOOK THIS UP THERE ARE ALL KINDS OF FLAGS AND STYLES AND YOU CAN ENTER OR USE IT MANY TIMES
IN MY DRAWITEM I PLACED IT SEVERAL PLACES SO IT WOULD BE THERE ON MOUSE OVER AND MOUSE CLICK'

Code:

DrawEdge @lpDis.hDC, @lpDis.rcItem, %BDR_RAISEDINNER OR %BDR_RAISEDOUTER OR %EDGE_RAISED, %BF_RECT
DrawEdge @lpDis.hDC, @lpDis.rcItem, %BDR_RAISEDINNER OR %BDR_RAISEDOUTER OR %EDGE_RAISED, %BF_RECT

@lpDis.rcItem YOU PROBALY CAN CHANGE THE WIDTH. It uses the rectangle size

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

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

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

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

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

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

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

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

[code]
it colors the menu bar all submenu items

Thanks

Announcement

Owner draw popup menu with double border - how to?

Owner draw popup menu with double border - how to?

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment