Menu with a flat border (Office XP style)

[Bud Meyer]

I'm trying to create a popup menu without the 3D border, which is done using a hook/subclass.
It works, but the right side and bottom have a ~5 pixel dead area, and I'm not sure why.

Any help would be appreciated.

#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"

%ODM_MARGIN_SPACING = 4

FUNCTION PBMAIN () AS LONG
    LOCAL result      AS LONG
    LOCAL hMenuDialog AS LONG
    DIALOG NEW %HWND_DESKTOP, "Right-click anywhere for the menu", 100, 100, 200, 25, %WS_POPUP OR %WS_BORDER OR _
        %WS_DLGFRAME OR %WS_SYSMENU OR %DS_CENTER, , TO hMenuDialog
    DIALOG SHOW MODAL hMenuDialog CALL ShowDialogCallback TO result
END FUNCTION

'============================================================================================================
'== ShowDialogCallback ======================================================================================
'============================================================================================================
CALLBACK FUNCTION ShowDialogCallback() AS LONG
    LOCAL tempstr AS STRING

    STATIC TxDefault      AS LONG  'Default color for text
    STATIC TxHighlighted  AS LONG  'Color for highlighted text
    STATIC hCustomBrush   AS LONG  'Custom background color
    STATIC hCustomBkBrush AS LONG  'Custom background highlight color
    STATIC hMenuHighlightOutlineBrush AS LONG  'Custom background highlight color
    STATIC hIconGutterBrush AS LONG

    STATIC hMenu AS LONG    'menu handle
    LOCAL hDC    AS LONG
    LOCAL hIcon  AS LONG

    LOCAL strMenu AS STRING
    LOCAL zTxt    AS ASCIIZ * 100 'max length of a menu item

    LOCAL tRect   AS RECT
    LOCAL SizeA   AS SIZEL
    LOCAL ncm     AS NONCLIENTMETRICS
    LOCAL lpmis   AS MEASUREITEMSTRUCT PTR
    LOCAL lpdis   AS DRAWITEMSTRUCT PTR

    LOCAL mii     AS MENUITEMINFO
    LOCAL subhndl AS DWORD
    LOCAL zCap    AS ASCIIZ * 260

    LOCAL lf    AS LOGFONT
    LOCAL hFont AS LONG

    LOCAL index AS LONG
    LOCAL icongutter AS LONG

    STATIC hHookOldMenuFilter AS LONG

    STATIC FlatMenu     AS LONG 'true/false
    STATIC CustomFont   AS LONG   'true/false
    STATIC FontName     AS STRING
    STATIC FontSize     AS LONG
    STATIC MenuTransparency AS LONG

    LOCAL itemcount AS LONG
    LOCAL result AS LONG


    SELECT CASE AS LONG CBMSG

        CASE %WM_INITDIALOG
            FlatMenu    = %TRUE
            CustomFont  = %TRUE
            FontName    = "Verdana"
            FontSize    = 22
            MenuTransparency = 210  '0-255

            IF FlatMenu THEN  '-- set a hook to create a menu with a flat border:
                hHookOldMenuFilter = SetWindowsHookEx(%WH_CALLWNDPROC, CODEPTR(MenuHookCallback), GetModuleHandle(""), BYVAL GetCurrentThreadId())
            END IF

            'TxDefault        = GetSysColor(%COLOR_MENUTEXT)
            'TxHighlighted    = GetSysColor(%COLOR_HIGHLIGHTTEXT)
            'hCustomBrush     = CreateSolidBrush( GetSysColor(%COLOR_MENU) )
            'hCustomBkBrush   = CreateSolidBrush( GetSysColor(%COLOR_HIGHLIGHT) )

            hIconGutterBrush = CreateSolidBrush( RGB(188, 188, 122) )
            TxDefault        = RGB(0, 0, 0)
            TxHighlighted    = RGB(255, 255, 255)
            hCustomBrush     = CreateSolidBrush( RGB(212, 208, 200) )
            hCustomBkBrush   = CreateSolidBrush( RGB(0, 112, 166) )
            hMenuHighlightOutlineBrush = CreateSolidBrush( RGB(0, 0, 0) )

        '----------------------------------------------------------------------------------

        CASE %WM_CONTEXTMENU
            '-- create the menu:
            CALL CreatePopupMenu TO hMenu

            RESET mii
            mii.cbSize = SIZEOF(MENUITEMINFO)
            mii.fMask  = %MIIM_STRING OR %MIIM_ID OR %MIIM_FTYPE
            mii.fType  = %MFT_OWNERDRAW
            mii.dwTypeData = VARPTR(zCap)

            itemcount = 6000
            INCR itemcount
            mii.wID = itemcount
            zCap    = "Notepad.exe"
            CALL InsertMenuItem(hMenu, mii.wID - 1, %TRUE, mii)

            INCR itemcount
            mii.wID = itemcount
            zCap    = "Calc.exe"
            CALL InsertMenuItem(hMenu, mii.wID - 1, %TRUE, mii)

            INCR itemcount
            mii.fMask    = %MIIM_STRING OR %MIIM_ID OR %MIIM_FTYPE OR %MIIM_SUBMENU
            mii.wID      = itemcount
            mii.hSubMenu = CreatePopupMenu
            zCap    = "Write.exe"
            CALL InsertMenuItem(hMenu, mii.wID - 1, %TRUE, mii)
                INCR itemcount
                mii.wID = itemcount
                mii.fMask = %MIIM_STRING OR %MIIM_ID OR %MIIM_FTYPE
                zCap    = "subitem"
                CALL InsertMenuItem(mii.hSubMenu, mii.wID - 1, %TRUE, mii)

            INCR itemcount
            mii.wID = itemcount
            zCap    = "another item"
            CALL InsertMenuItem(hMenu, mii.wID - 1, %TRUE, mii)

            result = TrackPopupMenuEx(hMenu, %TPM_RETURNCMD, LOWRD(CBLPARAM), HIWRD(CBLPARAM), CBHNDL, BYVAL %NULL)
            IF result > 0 THEN
                MSGBOX "Item #" & FORMAT$(result) & " was selected."
                CALL DestroyMenu(hMenu) TO result
                DIALOG END CBHNDL
            END IF

        '----------------------------------------------------------------------------------

        CASE %WM_MEASUREITEM
            IF CBWPARAM = 0 THEN  '0 means that a menu sent the message
                lpmis = CBLPARAM
                IF @lpmis.CtlType = %ODT_MENU THEN  'it's an owner-drawn menu
                    subhndl = GetSubMenu(hMenu, @lpmis.itemID)
                    IF subhndl = 0 THEN subhndl = hMenu
                    mii.cbSize     = SIZEOF(MENUITEMINFO)
                    mii.fMask      = %MIIM_STRING OR %MIIM_SUBMENU
                    mii.cch        = SIZEOF(zCap)
                    mii.dwTypeData = VARPTR(zCap)
                    IF GetMenuItemInfo(subhndl, @lpmis.itemID, %FALSE, mii) THEN zTxt = zCap

                    '-- get the text metrics:
                    hDC = GetDC(CBHNDL)
                    ncm.cbSize = LEN(NONCLIENTMETRICS)
                    CALL SystemParametersInfo(%SPI_GETNONCLIENTMETRICS, SIZEOF(ncm), BYVAL VARPTR(ncm), 0)

                    IF CustomFont = %TRUE THEN
                        lf.lfHeight = -MulDiv(FontSize, GetDeviceCaps(hDC, %LOGPIXELSY), 72)
                        lf.lfWeight = %FW_REGULAR
                        lf.lfFaceName = FontName & CHR$(0)
                        hFont = CreateFontIndirect(lf)
                    ELSEIF LEN(ncm.lfMenuFont) THEN
                        ncm.lfMenuFont.lfWeight = %FW_REGULAR
                        hFont = CreateFontIndirect(ncm.lfMenuFont)
                    END IF

                    IF hFont THEN SelectObject(hDC, hFont)
                    CALL GetTextExtentPoint32(hDC, zTxt, LEN(zTxt), SizeA)
                    IF hFont THEN CALL DeleteObject(hFont)
                    CALL ReleaseDC(CBHNDL, hDC)

                    @lpmis.itemHeight = sizeA.cy
                    IF @lpmis.itemHeight < 18 THEN @lpmis.itemHeight = 18   'need 16px for icons + 2 for margin

                    IF @lpmis.itemId = 0 THEN 'separator
                        @lpmis.itemHeight = ncm.iMenuHeight \ 3
                    ELSE 'submenu item
                        @lpmis.itemWidth = sizeA.cx + @lpmis.itemHeight
                        '-- if this item has a submenu (right arrow), then increase the width:
                        IF mii.hSubMenu THEN @lpmis.itemWidth = @lpmis.itemWidth + 5
                    END IF

                    FUNCTION = 1
                END IF  'owner-drawn menu?
            END IF

        '----------------------------------------------------------------------------------

        CASE %WM_DRAWITEM
            IF CBWPARAM = 0 THEN  '0 means that a menu sent the message
                lpdis = CBLPARAM
                IF @lpdis.CtlType = %ODT_MENU THEN  'it's an owner-drawn menu

                    @lpdis.rcItem.nRight  = @lpdis.rcItem.nRight  + 6 '<--compensate for no border
                    @lpdis.rcItem.nBottom = @lpdis.rcItem.nBottom + 6 '<--

                    icongutter = @lpdis.rcItem.nleft + (@lpdis.rcItem.nbottom - @lpdis.rcItem.ntop)

                    IF @lpdis.itemId THEN 'an item, that is NOT a separator (0)
                        '-- full menu transparency:
                        STATIC hPrevMenu AS LONG
                        LOCAL hMenuWnd AS LONG
                        hMenuWnd = WindowFromDC(@lpdis.hDC)
                        IF hMenuWnd <> hPrevMenu THEN   'is this a different menu than before? (only need to change to WS_EX_LAYERED once per menu)
                            hPrevMenu = hMenuWnd
                            IF (IsWindow(hMenuWnd)) THEN
                                CALL SetWindowLong(hMenuWnd, %GWL_EXSTYLE, GetWindowLong(hMenuWnd, %GWL_EXSTYLE) OR %WS_EX_LAYERED)
                                CALL SetLayeredWindowAttributes(hMenuWnd, 0, MenuTransparency, %LWA_ALPHA)
                            END IF
                        END IF

                        '-- fill the menu background:
                        IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                            CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hCustomBkBrush)
                            '-- outline rect:
                            tRect = @lpdis.rcItem
                            tRect.nRight = icongutter
                            CALL FrameRect(@lpdis.hDC, @lpdis.rcItem, hMenuHighlightOutlineBrush)
                            CALL SetTextColor(@lpdis.hDC, TxHighlighted)
                        ELSE
                            CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hCustomBrush)
                            CALL SetTextColor(@lpdis.hDC, TxDefault)
                        END IF

                        '-- set the text background to be completely transparent:
                        CALL SetBkMode(@lpdis.hDC, %TRANSPARENT)

                        '-- get the item text:
                        subhndl = GetSubMenu(hMenu, @lpdis.itemID)
                        IF subhndl = 0 THEN subhndl = hMenu
                        mii.cbSize     = SIZEOF(MENUITEMINFO)
                        mii.fMask      = %MIIM_STRING OR %MIIM_STATE
                        mii.cch        = SIZEOF(zCap)
                        mii.dwTypeData = VARPTR(zCap)
                        IF GetMenuItemInfo(subhndl, @lpdis.itemID, %FALSE, mii) THEN zTxt = zCap

                        '-- item text to draw?
                        strMenu = TRIM$(zTxt)
                        IF LEN(strMenu) THEN
                            IF CustomFont = %TRUE THEN
                                lf.lfHeight = -MulDiv(FontSize, GetDeviceCaps(@lpdis.hDC, %LOGPIXELSY), 72)
                                lf.lfWeight = %FW_REGULAR
                                lf.lfFaceName = FontName & CHR$(0)
                                hFont = CreateFontIndirect(lf)
                                IF hFont THEN SelectObject(@lpdis.hDC, hFont)
                            END IF

                            tRect = @lpdis.rcItem
                            index = @lpdis.itemID

                            '-- adjust the left edge of the rect (where the text will start):
                            tRect.nLeft = icongutter + %ODM_MARGIN_SPACING
                            CALL DrawText(@lpdis.hDC, BYVAL STRPTR(strMenu), LEN(strMenu), tRect, %DT_LEFT OR %DT_NOCLIP OR %DT_SINGLELINE OR %DT_VCENTER)
                            IF hFont THEN CALL DeleteObject(hFont)  'delete the custom font if there was one
                        END IF

                        '-- icon to draw:
                        LOCAL LargeIconArrayPtr, SmallIconArrayPtr AS DWORD PTR
                        LOCAL itemheight AS LONG
                        itemheight = @lpdis.rcItem.nbottom - @lpdis.rcItem.ntop
                        tempstr = zTxt

                        IF LEN(tempstr) THEN    'icon path?
                            hIcon = ExtractIconEx(tempstr & $NUL, 0, LargeIconArrayPtr, SmallIconArrayPtr, 1)
                            IF itemheight >= 32 THEN    'enough room for a large icon?
                                hIcon = LargeIconArrayPtr
                            ELSE    'no. use a small one (16x16)
                                hIcon = SmallIconArrayPtr
                            END IF
                            IF hIcon = %NULL THEN   'didn't find an icon in the exe/dll? then try getting the associated icon..
                                '-- find large (32x32) icon:
                                'hIcon = ExtractAssociatedIcon(GetModuleHandle(""), tempstr & $NUL, 0)
                                '-- find either the small or large icon, depending on the item height:
                                LOCAL SFI AS SHFILEINFO
                                CALL SHGetFileInfo(tempstr & $NUL, _
                                        0, _
                                        SFI, SIZEOF(SFI), %SHGFI_ICON OR _
                                        IIF&(itemheight >= 32, %SHGFI_LARGEICON, %SHGFI_SMALLICON))
                                hIcon = SFI.hIcon
                            END IF
                        END IF

                    ELSE  'separator
                        tRect = @lpdis.rcItem
                        CALL FillRect(@lpdis.hDC, tRect, hCustomBrush)
                        tRect.nTop = tRect.nTop + (tRect.nBottom - tRect.nTop) \ 2
                        CALL DrawEdge(@lpdis.hDC, tRect, %EDGE_ETCHED, %BF_TOP)
                    END IF '@lpdis.itemId 'an item, that is NOT a separator (0)

                    '-- icon gutter stripe:
                    IF (@lpdis.itemState AND %ODS_SELECTED) = 0 THEN    'if NOT selected
                        tRect = @lpdis.rcItem
                        tRect.nRight = icongutter
                        CALL FillRect(@lpdis.hDC, tRect, hIconGutterBrush)
                    END IF

                    '-- draw icon:
                    IF hIcon <> %NULL THEN  'got an icon handle?
                        LOCAL AdjustX, AdjustY AS LONG
                        AdjustY = IIF&(itemheight >= 32, itemheight - 32, itemheight - 16)
                        IF AdjustY > 0 THEN AdjustY = AdjustY / 2
                        AdjustX = itemheight - @lpdis.rcItem.nleft - IIF&(itemheight >= 32, 32, 16)
                        IF AdjustX > 0 THEN AdjustX = AdjustX / 2
                        CALL DrawIconEx(@lpdis.hDC, _
                                        @lpdis.rcItem.nleft + AdjustX, _    'x
                                        @lpdis.rcItem.ntop  + AdjustY, _    'y
                                        hIcon, _                            'icon handle
                                        IIF&(itemheight >= 32, 32, 16), _   'width
                                        IIF&(itemheight >= 32, 32, 16), _   'height
                                        0, BYVAL 0, %DI_NORMAL)
                                        'itemheight - AdjustX, _   'width
                                        'itemheight - AdjustY, _   'height
                        CALL DestroyIcon(hIcon)
                    END IF 'hIcon <> %NULL 'got an icon handle?

                END IF  'owner-drawn menu?

                FUNCTION = 1
            END IF

        '----------------------------------------------------------------------------------

        CASE %WM_DESTROY
            IF hFont                      THEN CALL DeleteObject(hFont)
            IF hCustomBrush               THEN CALL DeleteObject(hCustomBrush)
            IF hCustomBkBrush             THEN CALL DeleteObject(hCustomBkBrush)
            IF hMenuHighlightOutlineBrush THEN CALL DeleteObject(hMenuHighlightOutlineBrush)
            IF hIconGutterBrush           THEN CALL DeleteObject(hIconGutterBrush)
            IF hHookOldMenuFilter THEN CALL UnhookWindowsHookEx(hHookOldMenuFilter)

    END SELECT

END FUNCTION


'============================================================================================================
'== MenuSubclassCallback ====================================================================================
'============================================================================================================
FUNCTION MenuSubclassCallback (BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    LOCAL hWndProcOldProc AS LONG
    LOCAL szProperty AS ASCIIZ * 25

    szProperty = "OldMenuProc"
    hWndProcOldProc = GetProp(hWnd, szProperty)

    SELECT CASE Msg
        CASE %WM_CREATE '1st message
            '-- change to flat menu: (doesn't seem to work here; must subclass/hook instead!)
            CALL SetWindowLong(hWnd, %GWL_STYLE,   GetWindowLong(hWnd, %GWL_STYLE) AND NOT %WS_BORDER)
            CALL SetWindowLong(hWnd, %GWL_EXSTYLE, GetWindowLong(hWnd, %GWL_EXSTYLE) AND NOT %WS_EX_WINDOWEDGE AND NOT %WS_EX_DLGMODALFRAME)
        'CASE %WM_NCPAINT     '2nd message  (draw on frame of window)
        'CASE %WM_ERASEBKGND  '3rd message
        'CASE %WM_PAINT       '4th message
        'CASE %WM_PRINT       'never recieved?  (draw on NON-client area)
        'CASE %WM_PRINTCLIENT 'never recieved?  (draw on client area)
        'Case %WM_DESTROY
        '    '-- unsubclass the window:
        '    call RemoveProp(hwnd, szProperty)
        '    call SetWindowLong(hwnd, %GWL_WNDPROC, hWndProcOldProc)
    END SELECT

    FUNCTION = CallWindowProc(hWndProcOldProc, hWnd, Msg, wParam, lParam)
END FUNCTION

'============================================================================================================
'== MenuHookCallback ========================================================================================
'============================================================================================================
' This is the core of the Hook, it will scan each occurance of the #32768 class which is the window containing the Menu.
FUNCTION MenuHookCallback (BYVAL code AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    LOCAL pStruct AS CWPSTRUCT PTR
    LOCAL szClassName AS ASCIIZ * 258
    LOCAL Count AS LONG
    LOCAL hWndProcOldProc AS LONG
    LOCAL szProperty AS ASCIIZ * 25

    szProperty = "OldMenuProc"
    pStruct = lParam

    IF code = %HC_ACTION THEN
        IF @pStruct.Message = %WM_CREATE THEN
            Count = GetClassName(@pStruct.hWnd, szClassName, 25)
            IF INSTR(szClassName, "#32768") THEN
                '-- subclass the menu window:
                hWndProcOldProc = SetWindowLong(@pStruct.hWnd, %GWL_WNDPROC, CODEPTR(MenuSubclassCallback))
                CALL SetProp(@pStruct.hWnd, szProperty, hWndProcOldProc)
            END IF
        END IF
    END IF

    FUNCTION = CallNextHookEx(%WH_CALLWNDPROC, code, wParam, lParam)
END FUNCTION

[This message has been edited by Bud Meyer (edited February 10, 2007).]

[Jules Marchildon]

Bud,

I tested on my Sony Notebook, and looks perfect!
Can even read the text without my spec's.

Don't see any unpainted border issue. I'll read thru your code now...

Regards,
Jules

later... okay, now I see it, had to increase the size of your dialog
and spotted it on the gray background.

later.. later..
you will need to replace what was lost when you removed the border.
find the thickness of the borders and you have your solution.
this value of 6 is hard coded to demonstrate;

@lpdis.rcItem.nRight  = @lpdis.rcItem.nRight  + 6 '<--compensate for no border
@lpdis.rcItem.nBottom = @lpdis.rcItem.nBottom + 6 '<--

------------------




[This message has been edited by Jules Marchildon (edited February 10, 2007).]

[Bud Meyer]

Thanks, Jules.
But while the width can be expanded, the height does not work as well. You can see that the selected item's rect is off and intrudes on the surrounding items.
I've updated the code to have a submenu, where you can also see that the right-arrow does not get moved down along with the item..

It's strange that other implementations of this flat menu I've come across (C/C++/etc) don't seem to imply that any offset calculation is needed.

[This message has been edited by Bud Meyer (edited February 10, 2007).]