Announcement

Collapse

Forum Guidelines

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

Owner Drawn Menu Bar - completely customizable

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

  • Owner Drawn Menu Bar - completely customizable

    [CODE]
    '************************************************************************
    '* odrawmenu *
    '* by bernard ertl *
    '* july 11, 2002 *
    '* revamped july 12 - changed from drawstate to drawtext *
    '* - changed sizing handlers for min dialog width *
    '* and maximizing *
    '* - added static array to track menu item data *
    '* - streamlined tracking of focus rects *
    '* modified july 13 - changed wm_initdialog to eliminate reliance on*
    '* getmenuiteminfo & setmenuiteminfo *
    '* - changed wm_measure handler to calculate tabbed*
    '* submenu items correctly *
    '* - adjusted height for separators *
    '* modified july 14 - added wm_nclbuttondown handler *
    '* - eliminated need for static focusrect & wm_move*
    '* repainting *
    '* - corrected spacing of top level menu items *
    '* modified july 15 - added support for nested sub-menus *
    '* - overhauled painting & drawing to better *
    '* conform to standard menu behavior *
    '* - ensured proper key-navigation for separators *
    '* modified july 16 - included option to maintain focus highlighting*
    '* when dialog is inactive *
    '* - corrected code for grayed/disabled items *
    '* modified july 17 - grayed top menu bar when dialog is inactive *
    '* - added support for %mf_checked *
    '* - added support for auto-adjusting to the *
    '* color display mode *
    '* modified july 18 - added default checkmark if user does not *
    '* specify an icon *
    '* - shows icons for disabled/grayed items as *
    '* monochrome now *
    '* - corrected display for top level menu items *
    '* that are disabled/grayed *
    '* modified july 21 - added os versioning support. menu conforms to*
    '* standard behavior for the current os. *
    '* ** win95 tested ok *
    '* ** win98 tested ok (default) *
    '* ** winxp added, not fully tested *
    '* *
    '* credits: *
    '* much of this code has been adapted from borje hagsten's & semen *
    '* matusovski's code found here: *
    '* http://www.powerbasic.com/support/pb...ead.php?t=4361 *
    '* *
    '* also, code has been adapted from borje hagsten's excellent drawmenu *
    '* code. *
    '* *
    '* original skeleton code designed with pbforms 1.0. pb forms *
    '* metastatements have been removed since i had to do some editing *
    '* to the pb forms blocks and it can not be reloaded correctly. *
    '* *
    '* thanks to aleksander hjalmar for testing and suggesting improvements.*
    '* *
    '* thanks to scott turchin for the windows os version function. i *
    '* modified it to suit my tastes... *
    '* *
    '* description: *
    '* this code shows how to completely customize a menu including the top *
    '* level menu bar. you can set colors and icons for all menu items. *
    '* *
    '* restrictions: *
    '* - code requires that top level menubar items have ids in a range *
    '* greater than all sublevel menu items *
    '* - code assumes that all top level menubar items have sub-menus (no *
    '* separators). separators are ok in sub-menus. *
    '* - code assumes that all top level menubar items are unchecked *
    '* - code restricts minimum sizing of dialog width to the size of the *
    '* menu bar because the background coloring of the menu bar does not *
    '* work correctly at all times when the toolbar is multiple lines in *
    '* height. *
    '************************************************************************

    #compile exe
    #dim all

    '--------------------------------------------------------------------------------
    ' ** includes **
    '--------------------------------------------------------------------------------
    #if not %def(%winapi)
    #include "win32api.inc"
    #endif
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** constants **
    '--------------------------------------------------------------------------------
    %idd_dialog1 = 101
    %idr_menu1 = 102
    %idm_file_open = 1001
    %idr_accelerator1 = 103
    %idm_file_save = 1002
    %idm_file_exit = 1003
    %idm_edit_cut = 1004
    %idm_edit_copy = 1005
    %idm_edit_paste = 1006
    %idm_help_helptopics = 1007
    %idm_help_about = 1008
    %idm_edit_sub_cool = 1009
    %idm_edit_sub_dare = 1010

    'these constants help define the menu structure
    %odm_base_menubar_item_id = 9000 'this is the id threshold for top level menubar items
    %odm_base_submenu_item_id = 2000 'this is the id threshold for any (sub-)menu items that contain sub-menus
    %odm_max_string = 40 'number of bytes for asciiz menu strings

    %odm_accel_key_spacing = 10 'seems to work good
    %odm_icon_in_menu_width = 16 '16 for icon
    %odm_margin_spacing = 4
    %odm_text_offset_from_icon = 2 'add spacing between sub-menu item's text and icon

    'these constants enumerate the different possible windows os platforms
    %winunknown = 0
    %win95 = 1
    %win98 = 2
    %winme = 3
    %winnt = 4
    %win2k = 5
    %winxp = 6
    %windotnetserver = 7
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** types **
    '--------------------------------------------------------------------------------
    'note: hico is the default icon image to display. if you want to display checked/unchecked states,
    ' hico = unchecked state icon (could be null for no image)
    ' hcheckedico = checked state icon (can be the same as hico too)
    'note: wid **must** be the first item in the type.
    type menuitemtype
    wid as dword 'menu item's control id
    ztxt as asciiz * %odm_max_string
    hico as dword 'default icon image
    hcheckedico as dword 'checked icon image
    accelwidth as long 'holds textextent of any accelerator key text
    end type

    type colorset
    bkface as long 'color for raised button face
    bkfacesunken as long 'color for depressed button face
    bkhighlight as long 'color for sub-menu highlighted items
    bkhighlightsunken as long 'color for depressed face on sub-menu higlighted items
    bkfocushighlight as long 'color for focus highlighting top level menu bar
    bkfocusselect as long 'color for selected top level menu bar item
    txdefault as long 'default color for text
    txgrayed as long 'color for grayed text
    txhighlighted as long 'color for highlighted text
    end type
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** globals **
    '--------------------------------------------------------------------------------
    global getcolorfor() as colorset
    global currentdisplaymode as long
    global osversion as long
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** declarations **
    '--------------------------------------------------------------------------------
    declare function attachmenu1(byval hdlg as dword) as dword
    declare function assignaccel(taccel as accelapi, byval wkey as word, byval wcmd _
    as word, byval byfvirt as byte) as long
    declare function attachaccelerator1(byval hdlg as dword) as dword
    declare callback function showdialog1proc()
    declare function showdialog1(byval hparent as dword) as long
    declare function getwindowsversion() as long
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** pbmain **
    '--------------------------------------------------------------------------------
    function pbmain()

    local dm as devmode
    local osvo as osversioninfo
    dim getcolorfor( 1)

    'get current os version
    'note: you can force a behavior style by explicitly assigning an equate to osversion
    osversion = getwindowsversion() '%winxp

    'set colors for 256 color mode
    getcolorfor(0).bkface = rgb( 128, 128, 0)
    getcolorfor(0).bkfacesunken = rgb( 128, 128, 0) '%yellow does not make good 3d effect
    getcolorfor(0).bkhighlight = rgb( 128, 0, 0)
    getcolorfor(0).bkhighlightsunken = rgb( 128, 0, 0) '%red does not make good 3d effect
    select case as long osversion
    case %winxp
    getcolorfor(0).bkfocushighlight = getcolorfor(0).bkhighlight
    getcolorfor(0).bkfocusselect = getcolorfor(0).bkfacesunken
    case else
    getcolorfor(0).bkfocushighlight = getcolorfor(0).bkhighlight
    getcolorfor(0).bkfocusselect = getcolorfor(0).bkhighlight
    end select
    getcolorfor(0).txdefault = getsyscolor( %color_menutext)
    getcolorfor(0).txgrayed = &h00505050 'dark gray
    getcolorfor(0).txhighlighted = getsyscolor( %color_highlighttext) 'to match the sub-menu arrow graphic

    'set colors for 16 bit/high color or better
    getcolorfor(1).bkface = rgb( 200, 200, 152)
    getcolorfor(1).bkfacesunken = rgb( 220, 220, 188)
    getcolorfor(1).bkhighlight = rgb( 173, 173, 101)
    getcolorfor(1).bkhighlightsunken = rgb( 187, 187, 128)
    select case as long osversion
    case %winxp
    getcolorfor(1).bkfocushighlight = rgb(159, 220, 133)
    getcolorfor(1).bkfocusselect = getcolorfor(1).bkfacesunken
    case else
    getcolorfor(1).bkfocushighlight = getcolorfor(1).bkhighlight
    getcolorfor(1).bkfocusselect = getcolorfor(1).bkhighlight
    end select
    getcolorfor(1).txdefault = getsyscolor( %color_menutext)
    getcolorfor(1).txgrayed = getsyscolor( %color_graytext)
    getcolorfor(1).txhighlighted = getsyscolor( %color_highlighttext) 'to match the sub-menu arrow graphic

    'get current display mode
    dm.dmsize = len( devmode)
    enumdisplaysettings byval 0, %enum_current_settings, dm
    currentdisplaymode = iif&( dm.dmbitsperpel > 8, 1, 0)

    showdialog1 %hwnd_desktop

    end function
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** macros **
    '--------------------------------------------------------------------------------
    'the following macros were added for coding clarity in the showdialog1proc function
    macro mhighlightmenuitem

    getwindowrect cbhndl, trect
    trect.nbottom = focusrect.nbottom - trect.ntop
    trect.ntop = focusrect.ntop - trect.ntop
    trect.nright = focusrect.nright - trect.nleft
    trect.nleft = focusrect.nleft - trect.nleft
    hdc = getwindowdc( cbhndl)
    'draw
    select case as long osversion
    case %winxp
    'calculate a darker shade of the focus color for the frame
    i = getcolorfor( currentdisplaymode).bkfocushighlight
    !xor edx, edx 'clear edx
    !mov eax, i
    !shr eax, 18 'divide blue value by 4
    !mov dl, al
    !shl edx, 16
    !mov eax, i
    !shr ah, 2 'divide green value by 4
    !shr al, 2 'divide blue value by 4
    !mov dx, ax
    !mov i, edx
    hf = selectobject( hdc, createpen( %ps_solid, 0, i))
    'draw frame using custom colored pen
    movetoex hdc, trect.nleft, trect.ntop, byval 0
    lineto hdc, trect.nright-1, trect.ntop
    lineto hdc, trect.nright-1, trect.nbottom-1
    lineto hdc, trect.nleft, trect.nbottom-1
    lineto hdc, trect.nleft, trect.ntop

    deleteobject selectobject( hdc, createpen( %ps_solid, 0, getcolorfor( currentdisplaymode).bkfocushighlight))
    for i = 1 to ((trect.nbottom - trect.ntop) * (trect.nright - trect.nleft)) \ 2
    do
    pt.x = rnd( trect.nleft+1, trect.nright-1)
    loop until pt.x mod 2
    do
    pt.y = rnd( trect.ntop+1, trect.nbottom-1)
    loop until pt.y mod 2
    movetoex hdc, pt.x, pt.y, byval 0
    lineto hdc, pt.x+1, pt.y
    next
    deleteobject selectobject( hdc, hf)

    settextcolor hdc, getcolorfor( currentdisplaymode).txdefault
    setbkmode hdc, %transparent

    strmenu = menuitemdata( offset-1).ztxt

    if len( strmenu) <> 0 then
    ncm.cbsize = len( nonclientmetrics)
    systemparametersinfo %spi_getnonclientmetrics, sizeof( ncm), byval varptr(ncm), 0
    if len(ncm.lfmenufont) then
    hf = createfontindirect(ncm.lfmenufont)
    if hf then hf = selectobject(hdc, hf)
    end if
    t2rect = trect
    'adjust for offset
    decr t2rect.ntop
    decr t2rect.nbottom
    if menuitemdata( offset-1).hico then
    t2rect.nleft = t2rect.nleft + %odm_icon_in_menu_width + %odm_margin_spacing\2 - 2 'leave room for icons
    else
    'when no icon in top level, adjust rect
    t2rect.nleft = t2rect.nleft - 2
    end if
    drawtext hdc, byval strptr(strmenu), len(strmenu), t2rect, %dt_left or %dt_noclip or %dt_singleline or %dt_vcenter or %dt_center
    if hf then deleteobject selectobject(hdc, hf)
    end if
    case %win98
    drawedge hdc, trect, %bdr_raisedouter, %bf_rect
    case else 'winme, winnt, win2k --- i'm not sure what the standard focus highlighting is for these oses
    drawedge hdc, trect, %bdr_raisedouter, %bf_rect
    end select
    if hicon then drawiconex hdc, trect.nleft + %odm_margin_spacing - 2, trect.ntop + 1, hicon, 16, 16, 0, byval 0, %di_normal
    releasedc cbhndl, hdc

    end macro

    macro mrestoremenuitem

    getwindowrect cbhndl, trect
    trect.nbottom = focusrect.nbottom - trect.ntop
    trect.ntop = focusrect.ntop - trect.ntop
    trect.nright = focusrect.nright - trect.nleft
    trect.nleft = focusrect.nleft - trect.nleft
    hdc = getwindowdc( cbhndl)
    'erase
    select case as long osversion
    case %winxp
    fillrect hdc, trect, hcustombrush

    settextcolor hdc, getcolorfor( currentdisplaymode).txdefault
    setbkmode hdc, %transparent

    strmenu = menuitemdata( offset-1).ztxt

    if len( strmenu) <> 0 then
    ncm.cbsize = len( nonclientmetrics)
    systemparametersinfo %spi_getnonclientmetrics, sizeof( ncm), byval varptr(ncm), 0
    if len(ncm.lfmenufont) then
    hf = createfontindirect(ncm.lfmenufont)
    if hf then hf = selectobject(hdc, hf)
    end if
    t2rect = trect
    'adjust for offset
    decr t2rect.ntop
    decr t2rect.nbottom
    if menuitemdata( offset-1).hico then
    t2rect.nleft = t2rect.nleft + %odm_icon_in_menu_width + %odm_margin_spacing\2 - 2 'leave room for icons
    else
    'when no icon in top level, adjust rect
    t2rect.nleft = t2rect.nleft - 2
    end if
    drawtext hdc, byval strptr(strmenu), len(strmenu), t2rect, %dt_left or %dt_noclip or %dt_singleline or %dt_vcenter or %dt_center
    if hf then deleteobject selectobject(hdc, hf)
    end if
    case %win98
    framerect hdc, trect, hcustombrush
    case else 'winme, winnt, win2k --- i'm not sure what the standard focus highlighting is for these oses
    framerect hdc, trect, hcustombrush
    end select
    'redraw icon in case it overlapped the button frame
    if hicon then drawiconex hdc, trect.nleft + %odm_margin_spacing - 2, trect.ntop + 1, hicon, 16, 16, 0, byval 0, %di_normal
    releasedc cbhndl, hdc

    end macro
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** menus **
    '--------------------------------------------------------------------------------
    function attachmenu1(byval hdlg as dword) as dword

    local hmenu as long
    local hpopup1 as long
    local hpopup2 as long
    local hpopup3 as long

    menu new bar to hmenu
    menu new popup to hpopup1
    menu add popup, hmenu, "super fabulous &file menu", hpopup1, %mf_enabled
    menu add string, hpopup1, "&open" + $tab + "ctrl+o", %idm_file_open, _
    %mf_enabled
    menu add string, hpopup1, "&save" + $tab + "ctrl+s", %idm_file_save, _
    %mf_enabled
    menu add string, hpopup1, "-", 0, 0
    menu add string, hpopup1, "&exit" + $tab + "ctrl+e", %idm_file_exit, _
    %mf_enabled
    menu new popup to hpopup1
    menu add popup, hmenu, "&edit", hpopup1, %mf_enabled
    menu add string, hpopup1, "c&ut" + $tab + "ctrl+x", %idm_edit_cut, _
    %mf_enabled
    menu add string, hpopup1, "&copy" + $tab + "ctrl+c", %idm_edit_copy, _
    %mf_enabled
    menu add string, hpopup1, "&paste" + $tab + "ctrl+v", %idm_edit_paste, _
    %mf_grayed
    menu add string, hpopup1, "-", 0, 0
    menu new popup to hpopup2
    menu add popup, hpopup1, "&sub-menu test", hpopup2, %mf_enabled
    menu add string, hpopup2, "&cool", %idm_edit_sub_cool, _
    %mf_enabled
    menu add string, hpopup2, "-", 0, 0
    menu new popup to hpopup3
    menu add popup, hpopup2, "double &nested test", hpopup3, %mf_enabled
    menu add string, hpopup3, "&dare to dream" + $tab + "ctrl+d", %idm_edit_sub_dare, _
    %mf_enabled
    menu new popup to hpopup1
    menu add popup, hmenu, "&help", hpopup1, %mf_enabled
    menu add string, hpopup1, "&help topics" + $tab + "f1", _
    %idm_help_helptopics, %mf_enabled
    menu add string, hpopup1, "&about" + $tab + "ctrl+a", %idm_help_about, _
    %mf_enabled

    menu attach hmenu, hdlg

    function = hmenu

    end function
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** accelerators **
    '
    ' no code was modified for accelerators. this is straight out of pbforms
    '--------------------------------------------------------------------------------
    function assignaccel(taccel as accelapi, byval wkey as word, byval wcmd as word, _
    byval byfvirt as byte) as long
    taccel.fvirt = byfvirt
    taccel.key = wkey
    taccel.cmd = wcmd
    end function

    function attachaccelerator1(byval hdlg as dword) as dword

    local haccel as dword
    local taccel() as accelapi
    dim taccel(1 to 9)

    assignaccel taccel(1), asc("o"), %idm_file_open, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(2), asc("s"), %idm_file_save, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(3), asc("e"), %idm_file_exit, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(4), asc("x"), %idm_edit_cut, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(5), asc("c"), %idm_edit_copy, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(6), asc("v"), %idm_edit_paste, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(7), %vk_f1, %idm_help_helptopics, %fvirtkey or %fnoinvert
    assignaccel taccel(8), asc("a"), %idm_help_about, %fvirtkey or %fcontrol or _
    %fnoinvert
    assignaccel taccel(9), asc("d"), %idm_edit_sub_dare, %fvirtkey or %fcontrol or _
    %fnoinvert

    accel attach hdlg, taccel() to haccel

    function = haccel

    end function
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** support procs **
    '--------------------------------------------------------------------------------
    function getwindowsversion() as long
    'this function courtesy of scott turchin. i've modified it for this code.
    'original posting can be found here:
    'http://www.powerbasic.com/support/pbforums/showthread.php?t=2295t].wid = submenuid
    incr submenuid
    @ptrmid[ offset].ztxt = ztxt
    select case as const$ ztxt
    case "&sub-menu test"
    @ptrmid[ offset].hico = loadicon(0, byval %idi_question)
    case "double &nested test"
    @ptrmid[ offset].hico = loadicon(0, byval %idi_hand)
    case else
    'no icons to display
    end select

    'change to %mft_ownerdraw
    modifymenu hsubmenu, i, (lobyt( lowrd( result)) xor %mf_popup) or %mf_byposition or %mf_ownerdraw, @ptrmid[ offset].wid, byval 0

    'set max accelerator ket text width for all sub-menu items up to now...
    for k = startingsubmenuoffset to offset
    @ptrmid[ k].accelwidth = maxacceltxtwidth + %odm_icon_in_menu_width + %odm_margin_spacing
    next
    'modify the nested sub-menu...
    modifysubmenu hdlg, hnestedmenu, ptrmid, offset, submenuid

    'start new block...
    startingsubmenuoffset = offset + 1
    else
    if (result and %mf_separator) then
    'change %mft_separator to %mft_ownerdraw, maintain id = 0
    modifymenu hsubmenu, i, result or %mf_byposition or %mf_ownerdraw, 0, byval 0
    else
    'change %mft_string to %mft_ownerdraw, add icons, calculate width of accelerator key text
    getmenustring hsubmenu, i, ztxt, sizeof( ztxt), %mf_byposition
    incr offset
    @ptrmid[ offset].wid = getmenuitemid( hsubmenu, i)
    @ptrmid[ offset].ztxt = ztxt
    'modify the following select case as desired to add icons
    'where you want them. you can also load icons from a resource file
    select case as long @ptrmid[ offset].wid
    case %idm_file_open
    @ptrmid[ offset].hico = loadicon(0, byval %idi_exclamation)
    'leave out checked icon to test default icon
    'uncomment to see custom checked icon
    ' @ptrmid[ offset].hcheckedico = loadicon(0, byval %idi_hand)
    case %idm_edit_cut
    @ptrmid[ offset].hico = loadicon(0, byval %idi_exclamation)
    case %idm_help_about
    @ptrmid[ offset].hico = loadicon(0, byval %idi_application)
    case %idm_help_helptopics
    @ptrmid[ offset].hico = loadicon(0, byval %idi_question)
    case else
    'no icons to display
    end select
    'change %mft_string to %mft_ownerdraw
    modifymenu hsubmenu, i, result or %mf_byposition or %mf_ownerdraw, @ptrmid[ offset].wid, byval 0

    'determine width of accelerator key text
    if instr( ztxt, $tab) then
    ztxt = parse$( ztxt, $tab, 2) 'get accelerator key text
    hdc = getdc( hdlg)
    ncm.cbsize = len( nonclientmetrics)
    systemparametersinfo %spi_getnonclientmetrics, sizeof( ncm), byval varptr(ncm), 0
    if len(ncm.lfmenufont) then
    hf = createfontindirect(ncm.lfmenufont)
    if hf then hf = selectobject(hdc, hf)
    end if
    gettextextentpoint32 hdc, ztxt, len( ztxt), sizea
    if sizea.cx > maxacceltxtwidth then maxacceltxtwidth = sizea.cx
    if hf then deleteobject selectobject(hdc, hf)
    releasedc hdlg, hdc
    end if
    end if
    end if
    next
    'set max accelerator ket text width for all sub-menu items...
    for i = startingsubmenuoffset to offset
    @ptrmid[ i].accelwidth = maxacceltxtwidth + %odm_icon_in_menu_width + %odm_margin_spacing
    next

    end sub
    '--------------------------------------------------------------------------------



    '--------------------------------------------------------------------------------
    ' ** callbacks **
    '--------------------------------------------------------------------------------
    callback function showdialog1proc()

    register i as long, k as long

    static hcustombrush as long ' custom background color
    static hcustomsunkenbrush as long ' custom sunken background color (button depression)
    static hcustombkbrush as long ' custom background highlight color
    static hcustomsunkenbkbrush as long ' custom sunken background highlight color (button depression)
    static hcustomfocushlbrush as long ' custom highlight color for top level menu item
    static hcustomfocusselbrush as long ' custom highlight color for selected top level menu item
    static rightedge as long ' 'coordinate' of the dialog's right edge
    static border as long ' 'coordinate' of the right edge of the last top level menubar item
    static focusitem as long ' control id of the top level menubar item that has focus
    static htimer as dword ' handle to timer
    static dialogisactive as long ' track if dialog is active

    static menuitemdata() as menuitemtype 'maintain info for each ownerdrawn menu item
    'note: this is necessary because menu items with ftype = %mft_ownerdraw do not
    ' return the dwtypedata correctly.
    'note: if you want to have multiple dialogs active concurrently with ownerdrawn menus,
    ' they should have unique dialog callback functions. otherwise there will be problems
    ' with the static variables.

    local offset as long 'general purpose local variable
    local submenuid as long
    local maxacceltxtwidth as long
    local startingsubmenuoffset as long
    local focusrect as rect ' coordinates of the top level menubar item with focus
    local newcolormode as long

    local hdc as long 'handles
    local hmenu as long
    local hsubmenu as long
    local hicon as long
    local hf as long

    local strmenu as string 'strings
    local strmenu2 as string
    local ztxt as asciiz * %odm_max_string

    local trect as rect 'for processing messages
    local t2rect as rect
    local ptrrect as rect ptr
    local sizea as sizel
    local ncm as nonclientmetrics
    local mminfo as minmaxinfo ptr
    local pt as pointapi
    local lpmis as measureitemstruct ptr
    local lpdis as drawitemstruct ptr

    select case cbmsg
    case %wm_initdialog
    'initialize var
    dialogisactive = %true

    'get starting dimensions for dialog
    getclientrect cbhndl, trect
    'save total width
    rightedge = trect.nright + 4
    hcustombrush = createsolidbrush( getcolorfor( currentdisplaymode).bkface)
    hcustomsunkenbrush = createsolidbrush( getcolorfor( currentdisplaymode).bkfacesunken)
    hcustombkbrush = createsolidbrush( getcolorfor( currentdisplaymode).bkhighlight)
    hcustomsunkenbkbrush = createsolidbrush( getcolorfor( currentdisplaymode).bkhighlightsunken)
    hcustomfocushlbrush = createsolidbrush( getcolorfor( currentdisplaymode).bkfocushighlight)
    hcustomfocusselbrush = createsolidbrush( getcolorfor( currentdisplaymode).bkfocusselect)

    hmenu = getmenu( cbhndl)

    'count max# total menu & sub-menu items
    i = countitems( hme
    Bernard Ertl
    InterPlan Systems

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

    Thanks a lot
    Eros
    thinBasic programming language
    Win10 64bit - 8GB Ram - i7 M620 2.67GHz - NVIDIA Quadro FX1800M 1GB

    Comment


    • #3
      Copied from POFFS

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

      Comment


      • #4
        Thanks a lot!
        thinBasic programming language
        Win10 64bit - 8GB Ram - i7 M620 2.67GHz - NVIDIA Quadro FX1800M 1GB

        Comment


        • #5
          PB10 &amp; WinXP problem

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

          It possible to solve this problem? Somebody can help me? :confused2:
          Gustavo Asplanatti
          gustavoa at computecsrl.com.ar

          Comment


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

            It possible to solve this problem? Somebody can help me? :confused2:
            No solutions. Only that I have 100% replicated the issue on my machine. E.g. Win7 running PB 10. Move it to XP and it's broken text.

            Comment


            • #7
              If the OS is XP, instead of

              Code:
              ncm.cbSize = LEN( NONCLIENTMETRICS)
              use

              Code:
              ncm.cbSize = 340.
              The NONCLIENTMETRICS structure has a size of 340 bytes in XP and below and of 344 bytes in Vista and Windows 7.
              Forum: http://www.jose.it-berater.org/smfforum/index.php

              Comment


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

                Code:
                TYPE NONCLIENTMETRICS
                  cbSize AS DWORD
                  iBorderWidth AS LONG
                  iScrollWidth AS LONG
                  iScrollHeight AS LONG
                  iCaptionWidth AS LONG
                  iCaptionHeight AS LONG
                  lfCaptionFont AS LOGFONT
                  iSMCaptionWidth AS LONG
                  iSMCaptionHeight AS LONG
                  lfSMCaptionFont AS LOGFONT
                  iMenuWidth AS LONG
                  iMenuHeight AS LONG
                  lfMenuFont AS LOGFONT
                  lfStatusFont AS LOGFONT
                  lfMessageFont AS LOGFONT
                END TYPE
                When using PB10 and it's includes, you're using:

                Code:
                TYPE NONCLIENTMETRICSA
                    cbSize             AS DWORD
                    iBorderWidth       AS LONG
                    iScrollWidth       AS LONG
                    iScrollHeight      AS LONG
                    iCaptionWidth      AS LONG
                    iCaptionHeight     AS LONG
                    lfCaptionFont      AS LOGFONTA
                    iSmCaptionWidth    AS LONG
                    iSmCaptionHeight   AS LONG
                    lfSmCaptionFont    AS LOGFONTA
                    iMenuWidth         AS LONG
                    iMenuHeight        AS LONG
                    lfMenuFont         AS LOGFONTA
                    lfStatusFont       AS LOGFONTA
                    lfMessageFont      AS LOGFONTA
                #IF (%WINVER >= &H0600)
                    iPaddedBorderWidth AS LONG
                #ENDIF ' %WINVER >= &H0600
                END TYPE
                
                TYPE NONCLIENTMETRICSW
                    cbSize             AS DWORD
                    iBorderWidth       AS LONG
                    iScrollWidth       AS LONG
                    iScrollHeight      AS LONG
                    iCaptionWidth      AS LONG
                    iCaptionHeight     AS LONG
                    lfCaptionFont      AS LOGFONTW
                    iSmCaptionWidth    AS LONG
                    iSmCaptionHeight   AS LONG
                    lfSmCaptionFont    AS LOGFONTW
                    iMenuWidth         AS LONG
                    iMenuHeight        AS LONG
                    lfMenuFont         AS LOGFONTW
                    lfStatusFont       AS LOGFONTW
                    lfMessageFont      AS LOGFONTW
                #IF (%WINVER >= &H0600)
                    iPaddedBorderWidth AS LONG
                #ENDIF ' %WINVER >= &H0600
                END TYPE
                
                #IF %DEF(%UNICODE)
                TYPE NONCLIENTMETRICS
                    NONCLIENTMETRICSW
                END TYPE
                #ELSE
                TYPE NONCLIENTMETRICS
                    NONCLIENTMETRICSA
                END TYPE
                #ENDIF ' UNICODE
                Forum: http://www.jose.it-berater.org/smfforum/index.php

                Comment


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

                  Comment

                  Working...
                  X