Change menu and popup menu fonts

Just starting out? Need help? Post your questions and find answers here.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Change menu and popup menu fonts

Post by Fangbeast »

In my quest to continue same fonts, colours for 'standard' forms, is it possible to change the menu, popupmenu and popupmenu fonts? (and colours for all of them, naturally!!)

NetMaestro showed me how to do colour on standard menus and I am not greedy, just want it all (ROFL)

Don't care if it is API, it all works:):)
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
morosh
Enthusiast
Enthusiast
Posts: 329
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: Change menu and popup menu fonts

Post by morosh »

I got this code, sometimes ago, from this forum, it's not my own work

HTH

Code: Select all

    ;...Portions of this code are based on code by Andreas
    ;...which can be found at PureBasic CodeArchiv website
    Structure myMenuItem
      hFont.l
      text$
    EndStructure

    Structure myMENUBARINFO
      cbSize.l
      rcBar.RECT
      hMenu.l
      hwndMenu.l
      fBarFocused.w
      fFocused.w
    EndStructure

    ;...Array of Menu item info
    Global Dim menuItems.myMenuItem(2, 3)

    Procedure myWindowCallback(hwnd, msg, wParam, lParam)
      Shared menuParent$
      result = #PB_ProcessPureBasicEvents
      Select msg
        Case #WM_MEASUREITEM
          ;...Measure menu items here
          *pMIS.MEASUREITEMSTRUCT = lParam
          *pMenuItem.myMenuItem = *pMIS\itemData
          StartDrawing(WindowOutput(0))
          DrawingFont(*pMenuItem\hFont)
          *pMIS\itemWidth = TextWidth(*pMenuItem\text$)
          *pMIS\itemHeight = TextHeight(*pMenuItem\text$)
          StopDrawing()
          ProcedureReturn  #True
        Case #WM_DRAWITEM
          ;...Draw our menu items here
          If wParam = 0
            *dis.DRAWITEMSTRUCT = lParam
            *pMenuItem.myMenuItem = *dis\itemData
            hOldFont = SelectObject_(*dis\hdc, *pMenuItem\hFont)
            If *dis\CtlType = #ODT_MENU
              If *dis\itemState & #ODS_SELECTED
                SetTextColor_(*dis\hdc,#Red)
              Else
                SetTextColor_(*dis\hdc, #Black)
              EndIf
              DrawTextEx_(*dis\hdc, *pMenuItem\text$, Len(*pMenuItem\text$),  *dis\rcItem, #DT_LEFT | #DT_NOCLIP, 0)
              SelectObject_(*dis\hdc, hOldFont)
            EndIf
          EndIf
          ProcedureReturn  #True
      EndSelect
      ProcedureReturn result
    EndProcedure
    If OpenWindow(0, 10, 10, 300, 200, "OwnerDraw Menu", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
      SetWindowCallback(@myWindowCallback())
      hMenu = CreateMenu(0, WindowID(0))
      MenuTitle("&File")
      MenuItem(1, "&Open")
      MenuItem(2, "&Save")
      MenuItem(3, "E&xit")
      MenuTitle("&Edit")
      MenuItem(4, "&Cut")
      MenuItem(5, "C&opy")
      MenuItem(6, "&Paste")
     
      ;...Load our Menu font(s)
      MenuTitleFont = LoadFont(0, "Comic Sans MS", 10)
      MenuItemFont = LoadFont(1, "Courier New", 16)
     
      ;...Fill our array data
      ;...Menu Title "File"
      menuItems(0, 0)\text$ = GetMenuTitleText(0, 0)
      menuItems(0, 0)\hFont = MenuTitleFont
      ;...Subitems of File
      menuItems(0, 1)\text$ = GetMenuItemText(0, 1)
      menuItems(0, 1)\hFont = MenuItemFont
     
      menuItems(0, 2)\text$ = GetMenuItemText(0, 2)
      menuItems(0, 2)\hFont = MenuItemFont
     
      menuItems(0, 3)\text$ = GetMenuItemText(0, 3)
      menuItems(0, 3)\hFont = MenuItemFont
     
      ;...Menu Title "Edit"
      menuItems(1, 0)\text$ = GetMenuTitleText(0, 1)
      menuItems(1, 0)\hFont = MenuTitleFont
      ;...Subitems of Edit
      menuItems(1, 1)\text$ = GetMenuItemText(0, 4)
      menuItems(1, 1)\hFont = MenuItemFont
     
      menuItems(1, 2)\text$ = GetMenuItemText(0, 5)
      menuItems(1, 2)\hFont = MenuItemFont
     
      menuItems(1, 3)\text$ = GetMenuItemText(0, 6)
      menuItems(1, 3)\hFont = MenuItemFont
     
      ;...Here we set ownerdraw for Menu Titles "File" and "Edit"
      For i = 0 To 1
        ModifyMenu_(hMenu, i, #MF_BYPOSITION | #MF_OWNERDRAW, i, menuItems(i ,0))
      Next i
     
      ;...Here we set ownerdraw for submenu items of Menu Title "File"
      For i = 0 To 2
        ModifyMenu_(GetSubMenu_(hMenu, 0), i, #MF_BYPOSITION | #MF_OWNERDRAW, i, menuItems(0, i + 1))
      Next i
     
      For i = 0 To 2
        ;...Here we set ownerdraw for submenu items of Menu Title "Edit"
        ModifyMenu_(GetSubMenu_(hMenu, 1), i, #MF_BYPOSITION | #MF_OWNERDRAW, i, menuItems(1, i + 1))
      Next i
     
      ;...Show the menu changes
      DrawMenuBar_(WindowID(0))
     
      Repeat
        Event = WaitWindowEvent()
      Until Event = #PB_Event_CloseWindow 
    EndIf
    End
    
PureBasic: Surprisingly simple, diabolically powerful
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Change menu and popup menu fonts

Post by Fangbeast »

Thank you morosh, greatly appreciated and snagged.
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
Post Reply