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

Setting Fonts for Menu-Item Text Strings

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

  • Setting Fonts for Menu-Item Text Strings

    ' Setting Fonts for Menu-Item Text Strings
    '
    ' This was inspired by discussion in the windows forum:
    ' http://www.powerbasic.com/support/pb...ad.php?t=35977
    '
    ' The present code is a slightly modified version of a code made by Semen Matusovski, originally presented
    ' here: http://www.powerbasic.com/support/pb...25MF_OWNERDRAW
    ' I hade small problems having his code run on PBWin8x, hence this version.
    '
    ' I think the code is inspired by code from this Microsoft link:
    ' http://msdn2.microsoft.com/en-us/lib...m_Text_Strings
    '
    ' January 6, 2008: Small changes made. Now the menu bar font is also user defined. I think the code can be further
    ' refined by conforming in greater detail with the Microsoft example referred to above.

    Code:
       #COMPILE EXE
       #REGISTER NONE
       #DIM ALL
       #INCLUDE "WIN32API.INC"
    
       TYPE MYITEMM
          hfont AS LONG
          psz   AS ASCIIZ * 255
       END TYPE
    
       FUNCTION GetAFont(fnFont AS LONG) AS LONG
    
          LOCAL lf AS LOGFONT
          LOCAL sFontName AS STRING
          GetObject GetStockObject(%ANSI_VAR_FONT), SIZEOF(lf), BYVAL VARPTR(lf)
    
          IF (fnFont = 1) THEN
             lf.lfHeight = -14
             lf.lfWeight = %FW_BOLD
             lf.lfFaceName = "Times New Roman"
          ELSE
             lf.lfWeight = %FW_NORMAL
          END IF
          lf.lfItalic = (fnFont = 2)
          lf.lfUnderline = (fnFont = 3)
          FUNCTION = CreateFontIndirect(lf)
    
       END FUNCTION
    
       FUNCTION MainWndProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam  AS DWORD, BYVAL lParam  AS DWORD) EXPORT AS LONG
    
          DIM hMenuPopup AS LONG
          DIM pMyItem AS MYITEMM PTR
          DIM MyItem(0 TO 4) AS STATIC MYITEMM
          STATIC hmenu AS LONG
          LOCAL lpmis AS MEASUREITEMSTRUCT PTR
          LOCAL lpdis AS DRAWITEMSTRUCT PTR
          LOCAL hdc AS LONG
          LOCAL SizeA AS SizeL
          LOCAL i AS LONG
          LOCAL hfontOld AS LONG
    
          SELECT CASE wMsg
             CASE %WM_CREATE
                hMenu = CreateMenu: hMenuPopup  = CreateMenu
                FOR i = 0 TO 3: InsertMenu hMenuPopup, %MF_BYCOMMAND, %MF_STRING, 100 + i, "":  NEXT
                AppendMenu hMenu, %MF_POPUP OR %MF_STRING, hMenuPopup, "&File": SetMenu hWnd, hMenu
                '
                ' modify MENU BAR. Use the %MF_BYPOSITION flag here.
                ModifyMenu hmenu, 0, %MF_BYPOSITION OR %MF_OWNERDRAW, i, BYVAL VARPTR(myitem(4))
                MyItem(4).hfont = GetAFont(1)
                MyItem(4).psz = "&File"
                '
                FOR i = 0 TO 3 ' modify MENU ITEMS. Use the %MF_BYCOMMAND flag here.
                   ModifyMenu hmenu, 100 + i, %MF_BYCOMMAND OR %MF_OWNERDRAW, i, BYVAL VARPTR(myitem(i))
                   MyItem(i).hfont = GetAFont(i)
                   MyItem(i).psz = TRIM$(MID$("OPT. 1 OPT. 2 OPT. 3 OPT. 4     ", 7 * i + 1, 7))
                NEXT
                '
             CASE %WM_DESTROY
                FOR i = 0 TO 4 : DeleteObject MyItem(i).hfont : NEXT
                PostQuitMessage 0
                EXIT FUNCTION
    
            CASE %WM_MEASUREITEM
                hdc = GetDC(hwnd)
                lpmis = lParam
                pmyitem = @lpmis.itemData
                hfontOld = SelectObject(hdc, @pmyitem.hfont)
                GetTextExtentPoint32 hdc, @pmyitem.psz, LEN(@pmyitem.psz), SizeA
                @lpmis.itemWidth = 8 + sizeA.cx
                @lpmis.itemHeight = sizeA.cy
                SelectObject hdc, hfontOld
                ReleaseDC hwnd, hdc
                FUNCTION = %TRUE: EXIT FUNCTION
    
            CASE %WM_DRAWITEM
                lpdis = lParam
                pmyitem = @lpdis.itemData
                IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                   SetTextColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)
                   SetBkColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)
                ELSE
                   SetTextColor @lpdis.hDC, GetSysColor(%COLOR_MENUTEXT)
                   SetBkColor @lpdis.hDC, GetSysColor(%COLOR_MENU)
                END IF
    
                hfontOld = SelectObject(@lpdis.hDC, @pmyitem.hfont)
                ExtTextOut @lpdis.hDC, 8 + @lpdis.rcItem.nleft, @lpdis.rcItem.nTop, %ETO_OPAQUE, _
                    @lpdis.rcItem, @pmyitem.psz, LEN(@pmyitem.psz), BYVAL 0
                SelectObject @lpdis.hDC, hfontOld
                FUNCTION = %TRUE: EXIT FUNCTION
          END SELECT
    
          FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
       END FUNCTION
    
       FUNCTION PBMAIN
    
          LOCAL Msg         AS tagMsg
          LOCAL wndclass1   AS WndClassEx
          LOCAL szClassName AS ASCIIZ * 80
          LOCAL hWnd        AS LONG
    
          szClassName            = "LtrGUITop"
          wndclass1.cbSize        = SIZEOF(WndClass1)
          wndclass1.lpfnWndProc   = CODEPTR(MainWndProc)
          wndclass1.hInstance     = GetModuleHandle (BYVAL 0&)
          wndclass1.hbrBackground = GetStockObject(%LTGRAY_BRUSH )
          wndclass1.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW )
          wndclass1.lpszMenuName  = %NULL
          wndclass1.lpszClassName = VARPTR(szClassName)
          RegisterClassEx wndclass1
    
          hWnd = CreateWindow(szClassName, "Set Menu Font", %WS_SYSMENU OR %WS_MINIMIZEBOX, 250, 150, 300, 300, 0, BYVAL %Null, wndclass1.hInstance, BYVAL %NULL)
          ShowWindow hWnd, %SW_SHOW
          UpdateWindow hWnd
    
          WHILE GetMessage(Msg, %NULL, 0, 0)
             TranslateMessage Msg
             DispatchMessage Msg
          WEND
          FUNCTION = msg.wParam
       END FUNCTION
    Last edited by Erik Christensen; 6 Jan 2008, 04:23 PM. Reason: The Menu BAR Font is now also user defined.

  • #2
    ' Here is another menu font example using PowerBasic DDT as far as possible.
    ' The method in the previous example using a pointer to MYITEMS does not work
    ' with DDT. Therefore the font-data are being held in an array.
    '
    ' The program uses DrawState to draw menu items. With the %DST_PREFIXTEXT flag set
    ' this function also draws underscored characters used as keyboard accelerators.
    ' Using ALT + underscored character generates a selection of the menu item in question.
    '
    ' This example can certainly be improved in many ways. I invite you to do so in this thread.
    '
    ' The splendid code by Borje Hagsten in the link below can give further ideas in this respect.
    ' http://www.reonis.com/POFFS/index.htm
    ' Look for: 'DrawMenu' under the heading: Samples and Utilities - Public Domain
    '
    ' José Roca has another very fine code using a slightly different bitmap technique in this link.
    ' http://www.jose.it-berater.org/smffo...php?topic=28.0
    ' You should register in his site to get access to the necessary PBR-resource-file
    '
    ' Best regards --------- Erik Christensen --------- January 13, 2008
    Code:
    ' Here is another menu font example using PowerBasic DDT as far as possible.
    ' The method in the previous example using a pointer to MYITEMS does not work
    ' with DDT. Therefore the font-data are being held in an array.
    '
    ' The program uses DrawState to draw menu items. With the %DST_PREFIXTEXT flag set
    ' this function also draws underscored characters used as keyboard accelerators.
    ' Using ALT + underscored character generates a selection of the menu item in question.
    '
    ' This example can certainly be improved in many ways. I invite you to do so in this thread. :)
    '
    ' The splendid code by Borje Hagsten in the link below can give further ideas in this respect.
    ' http://www.reonis.com/POFFS/index.htm
    ' Look for: 'DrawMenu' under the heading: Samples and Utilities - Public Domain
    '
    ' José Roca has another very fine code using a slightly different bitmap technique in this link. 
    ' http://www.jose.it-berater.org/smffo...php?topic=28.0
    ' You should register in his site to get access to the necessary PBR-resource-file
    '
    ' Best regards --------- Erik Christensen --------- January 13, 2008
    '
    #COMPILE EXE
    #DIM ALL
    #DEBUG ERROR ON
    #INCLUDE "WIN32API.INC"
    '
    %IDC_BUTTON1    = 1006
    %IDC_TEXTBOX1   = 1007
    %IDD_DIALOG1    =  101
    '
    CALLBACK FUNCTION ShowDIALOG1Proc()
        STATIC hMenu   AS DWORD                 ' handle to main menu
        STATIC hPopUp1 AS DWORD                 ' handle to popup menu
        LOCAL lpmis AS MEASUREITEMSTRUCT PTR    ' pointer to item of data
        LOCAL lpdis AS DRAWITEMSTRUCT PTR       ' pointer to item drawing data
        STATIC crSelText AS LONG                ' text color of selected item
        STATIC crSelBkgnd AS LONG               ' background color of selected item
        STATIC crText AS LONG                   ' text color of unselected item
        STATIC crBkgnd AS LONG                  ' background color unselected item
        STATIC wCheckX AS WORD                  ' check-mark width
        STATIC nTextX AS WORD                   ' width of menu item
        STATIC nTextY AS LONG                   ' height of menu item
        STATIC hfontOld AS LONG                 ' handle to old font
        STATIC fSelected AS LONG                ' menu-item selection flag
        LOCAL Id AS LONG
        LOCAL hdc AS LONG
        LOCAL SizeA AS SizeL
        DIM IdFont(0 TO 100) AS STATIC STRING
        STATIC t AS STRING, tx AS ASCIIZ * 255
        STATIC Flag AS LONG
        '
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                ' Initialization handler
                MENU NEW BAR TO hMenu
                '
                MENU NEW POPUP TO hPopUp1
                '
                ' Id 0-9 are menu bar items
                ' Id 0 is the first menu bar item
                Id = 0 : MENU ADD POPUP, hMenu, "&File", hPopUp1, %MF_ENABLED     : IdFont(Id) = "Arial, 18"
                    '
                    ' Id 10-19 are drop down items for first menu bar item having Id = 0
                    Id = 10 : MENU ADD STRING, hPopUp1, "&Open", Id, %MF_ENABLED  : IdFont(Id) = "Arial, 18"
                    Id = 11 : MENU ADD STRING, hPopUp1, "&Save", Id, %MF_ENABLED  : IdFont(Id) = "Times New Roman, 20"
                              MENU ADD STRING, hPopUp1, "-", 0, 0  ' separator - does not have an Id
                    id = 12 : MENU ADD STRING, hPopUp1, "E&xit", Id, %MF_ENABLED  : IdFont(Id) =  "Courier New, 18"
                    '
                MENU NEW POPUP TO hPopUp1
                '
                ' Id 1 is the second menu bar item
                Id = 1 : MENU ADD POPUP, hMenu, "&Help", hPopUp1, %MF_ENABLED     : IdFont(Id) = "Arial, 18"
                    '
                    ' Id 20-29 are drop down items for second menu bar item having Id = 1
                    Id = 20 : MENU ADD STRING, hPopUp1, "H&elp", Id, %MF_ENABLED : IdFont(Id) = "Courier New, 18"
                              MENU ADD STRING, hPopUp1, "-", 0, 0 ' separator - does not have an Id
                    Id = 21 : MENU ADD STRING, hPopUp1, "&About", Id, %MF_ENABLED : IdFont(Id) = "Times New Roman, 20"
                MENU ATTACH hMenu, CBHNDL
                '
                ' Modify the menu items to make them owner-drawn.
    
                ModifyMenu hMenu, 0, %MF_BYPOSITION OR %MF_OWNERDRAW, 0,  BYVAL %NULL ' The %MF_BYPOSITION flag is used
                ModifyMenu hMenu, 1, %MF_BYPOSITION OR %MF_OWNERDRAW, 1,  BYVAL %NULL ' for menu bar items
                '
                ModifyMenu hMenu, 10, %MF_BYCOMMAND OR %MF_OWNERDRAW, 10, BYVAL %NULL ' The %MF_BYCOMMAND flag is used
                ModifyMenu hMenu, 11, %MF_BYCOMMAND OR %MF_OWNERDRAW, 11, BYVAL %NULL ' for drop down menu items
                ModifyMenu hMenu, 12, %MF_BYCOMMAND OR %MF_OWNERDRAW, 12, BYVAL %NULL
                '
                ModifyMenu hMenu, 20, %MF_BYCOMMAND OR %MF_OWNERDRAW, 20, BYVAL %NULL
                ModifyMenu hMenu, 21, %MF_BYCOMMAND OR %MF_OWNERDRAW, 21, BYVAL %NULL
    
                ' Retrieve the text and background colors of the
                ' selected menu text.
    
                crSelText = GetSysColor(%COLOR_HIGHLIGHTTEXT)
                crSelBkgnd = GetSysColor(%COLOR_HIGHLIGHT)
    
                CONTROL ADD BUTTON, CBHNDL, %IDC_BUTTON1, "E&xit", 320, 165, 70, 26
                CONTROL ADD TEXTBOX, CBHNDL, %IDC_TEXTBOX1, "", 10, 85, 380, 74, %ES_MULTILINE OR %WS_VSCROLL, %WS_EX_CLIENTEDGE
                t = "Menu item identifiers and texts:"+$CRLF
                FUNCTION = 0 : EXIT FUNCTION
    
            CASE %WM_SIZE
                '
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN ' window is inactive
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
                '
            CASE %WM_DESTROY
                '
                PostQuitMessage 0
                FUNCTION = 0 : EXIT FUNCTION
                '
            CASE %WM_MEASUREITEM
                IF CBWPARAM = 0 THEN ' meassage sent by a menu
    
                    ' Retrieve a device context for the main window.
    
                    hdc = GetDC(CBHNDL)
    
                    ' Retrieve pointers to the menu item's MEASUREITEMSTRUCT structure.
    
                    lpmis = CBLPARAM
    
                    Id = @lpmis.itemID ' Id of menu item
    
                    ' get text string of menu item
    
                    IF Id < 10 THEN Flag = %MF_BYPOSITION ELSE Flag = %MF_BYCOMMAND
                    GetMenuString(BYVAL hMenu, BYVAL Id, tx, 100, BYVAL Flag)
                    ' MENU GET TEXT hMenu, [BYCMD] pos& TO txt$ - does not work for some reason
    
                    ' Select the font associated with the item into
                    ' the main window's device context.
    
                    t = t + "Item:"+STR$(Id)
                    hfontOld = SelectObject(hdc, CreateFont(VAL(PARSE$(IdFont(Id),",",2)),0,0,0,400,0,0,0,0,3,2,1,82,PARSE$(IdFont(Id),",",1)))
    
                    t = t + "  """+ tx + """      "
                    CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX1, t
    
                    ' Retrieve the width and height of the item's string,
                    ' and then copy the width and height into the
                    ' MEASUREITEMSTRUCT structure's itemWidth and
                    ' itemHeight members.
                    ' The ampersand (&) should be excluded from the calculation.
    
                    GetTextExtentPoint32 hdc, REMOVE$(tx, "&"), LEN(REMOVE$(tx, "&")), SizeA
                    @lpmis.itemWidth = sizeA.cx
                    @lpmis.itemHeight = sizeA.cy
    
                    ' Select the old font back into the device context,
                    ' and then release the device context.
    
                    SelectObject hdc, hfontOld
                    ReleaseDC CBHNDL, hdc
    
                    FUNCTION = %TRUE: EXIT FUNCTION
                END IF
    
            CASE %WM_DRAWITEM
                IF CBWPARAM = 0 THEN ' meassage sent by a menu
    
                    ' Get pointers to the menu item's DRAWITEMSTRUCT structure.
    
                    lpdis = CBLPARAM
                    Id = @lpdis.itemID
    
                    ' If the user has selected the item, use the selected
                    ' text and background colors to display the item.
    
                    IF (@lpdis.itemState AND %ODS_SELECTED) THEN
                        crText = SetTextColor(@lpdis.hDC, crSelText)
                        crBkgnd = SetBkColor(@lpdis.hDC, crSelBkgnd)
                        fSelected = %TRUE
                    END IF
    
                    ' Remember to leave space in the menu item for the
                    ' check-mark bitmap. Retrieve the width of the bitmap
                    ' and add it to the width of the menu item.
    
                    wCheckX = GetSystemMetrics(%SM_CXMENUCHECK)
                    nTextX = wCheckX + @lpdis.rcItem.nLeft
                    nTextY = @lpdis.rcItem.nTop
    
                    ' Select the font associated with the item into the
                    ' item's device context, and then draw the string.
    
                    hfontOld = SelectObject(@lpdis.hDC, CreateFont(VAL(PARSE$(IdFont(Id),",",2)),0,0,0,400,0,0,0,0,3,2,1,82,PARSE$(IdFont(Id),",",1)))
    
                    ' get text string of menu item
    
                    IF Id < 10 THEN Flag = %MF_BYPOSITION ELSE Flag = %MF_BYCOMMAND
                    GetMenuString(BYVAL hMenu, BYVAL Id, tx, 100, BYVAL Flag)
    
                    ' Draw menu item text using DrawState, which with the %DST_PREFIXTEXT flag set
                    ' draws the underscored character (preceeded by the ampersand, which is not drawed).
    
                    DrawState @lpDis.hDC, 0, 0, BYVAL VARPTR(tx), LEN(tx), _
                        8 + @lpdis.rcItem.nLeft, @lpdis.rcItem.nTop, nTextX, nTextY, %DST_PREFIXTEXT
    
                    ' Select the previous font back into the device
                    ' context.
    
                    SelectObject(@lpdis.hDC, hfontOld)
    
                    IF fSelected THEN
                        SetTextColor(@lpdis.hDC, crText)
                        SetBkColor(@lpdis.hDC, crBkgnd)
                    END IF
    
                    FUNCTION = %TRUE: EXIT FUNCTION
                END IF
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE LOWRD(CBWPARAM)
                'SELECT CASE AS LONG CBCTL
                    CASE %IDC_BUTTON1 ' exit
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL, 0
    
                    CASE 10 : MSGBOX "10: Open selected",  %MB_TASKMODAL, "Selection:"
    
                    CASE 11 : MSGBOX "11: Save selected",  %MB_TASKMODAL, "Selection:"
    
                    CASE 12 : MSGBOX "12: Exit selected",  %MB_TASKMODAL, "Selection:"  ' : DIALOG END CBHNDL
    
                    CASE 20 : MSGBOX "20: Help selected",  %MB_TASKMODAL, "Selection:"
    
                    CASE 21 : MSGBOX "21: About selected", %MB_TASKMODAL, "Selection:"
    
                END SELECT
        END SELECT
    END FUNCTION
    '
    FUNCTION PBMAIN()
        LOCAL lRslt AS LONG
        LOCAL hDlg  AS DWORD
        DIALOG NEW PIXELS, %HWND_DESKTOP, "Menu Font Drawing", , _
            , 400,220 , %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR _
            %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
            %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
            %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
            %WS_EX_RIGHTSCROLLBAR, TO hDlg
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
        FUNCTION = lRslt
    END FUNCTION
    Last edited by Erik Christensen; 13 Jan 2008, 08:27 AM.

    Comment


    • #3
      See also the very fine last code in this link:

      http://www.powerbasic.com/support/pb...ad.php?t=23442

      Comment

      Working...
      X