Does anyone know how to change the font face or size for menu items or menu bars and to change the font size of face on the title bar? Is there a way using the API?
The following is a somewhat cheap example for simplicity sake; for much better examples, search up 'Menu fonts' (or something similar) at http://www.planet-source-code.com.
Add to a Form with some menus.
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Const MF_BITMAP = &H4&
Const MF_STRING = &H0&
Private Sub Command1_Click()
'Declare our Variables
Dim hID As Long
Dim hMenu As Long
Dim hSubMenu As Long
Dim hDC As Long
Dim hFont As Long
Dim hBmp As Long
Dim lh()
'The the DC and hWnd of the form and Menu's
hMenu = GetMenu(Form1.hwnd)
hSubMenu = GetSubMenu(hMenu, 0)
hDC = CreateCompatibleDC(Me.hDC)
'Get the number of SubMenus
iCount = GetMenuItemCount(hSubMenu)
ReDim lh(iCount)
'Loop through the SubMenus
For i = 0 To GetMenuItemCount(hSubMenu)
hID = GetMenuItemID(hSubMenu, i)
'Create the Font
hFont = CreateFont(-16, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, Me.FontName)
lh(i) = CreateCompatibleBitmap(hDC, 200, 18)
hBmp = SelectObject(hDC, lh(i))
SelectObject hDC, hFont
Rectangle hDC, -1, -1, 201, 19
'Set the Menu Text
TextOut hDC, 0, 0, "SubMenu" & i, 8
'Make the modifications
ModifyMenu hSubMenu, hID, MF_BITMAP, hID, lh(i)
Next i
End Sub
Private Sub Form_Load()
'Change the FontName here
Me.FontName = "Courier"
End Sub
Yeah...
So what are all those numbers:
hFont = CreateFont(-16, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, Me.FontName)
How do they relate to the point size / boldness of the font?