Announcement

Collapse
No announcement yet.

Owner draw popup menu with double border - how to?

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

  • James C Morgan
    replied
    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

    Leave a comment:


  • James C Morgan
    replied
    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

    Leave a comment:


  • Michael Mattias
    replied
    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


    Leave a comment:


  • Michael Mattias
    replied
    oops... duplicated! Something "glitched:" somewhere!

    Leave a comment:


  • Stuart McLachlan
    replied
    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

    Leave a comment:


  • Michael Mattias
    replied
    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

    Leave a comment:


  • Stuart McLachlan
    replied
    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?

    Leave a comment:


  • Tim Lakinir
    replied
    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

    Leave a comment:


  • Tim Lakinir
    replied
    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

    Leave a comment:


  • Stuart McLachlan
    replied
    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 ?

    Leave a comment:


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

    Leave a comment:


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

    Leave a comment:


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

    Leave a comment:


  • Stuart McLachlan
    replied
    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)

    Leave a comment:


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

    Could be a Menu style that they use?


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

    Leave a comment:


  • Tim Lakinir
    started a topic Owner draw popup menu with double border - how to?

    Owner draw popup menu with double border - how to?

    Hi All,

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

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

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

    Click image for larger version

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



Working...
X