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