Menu Font

[Criss]

Hi!

Is it possible to change the MenuTitle-Font and the MenuItems-Font?

Thanks, for the Help!
Criss

[netmaestro]

I'm afraid you're in for heavy lifting ahead if you really want to accomplish this, afaik there just isn't an easy way. If you'd like to take a kick at the cat, here's the relevant MSDN doc:

http://msdn2.microsoft.com/en-us/librar ... xt_Strings

[Sparkie]

Here's a poor-mans version of changing menu fonts. You can do some optimizing by creating brushes for use during the various drawing stages. I was too lazy to that for you.

Also, take a look at the _PureBasic CodeArchiv website_ for code by Andreas.

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

[yrreti]

That's nice Sparkie, thanks for the code.