Is there a way to increase the font size of menu items in a VB
program? The default size appears to be around 10 pt. I'd like to
increase to 14 or 16.

---

Clarification of Question by skippy60-ga on 08 Apr 2004 12:37 PDT

Hi,

Thanks for the thorough answer. Please post it as an answer so that I can pay you.

Skip

Can you please specify which version of VB your using?

Example: VB 6.0 SP6, VB .NET...

I'm using VB 6.0.

The answer to your question is both yes and no.  Here's why:

- The menus for Visual Basic Windows desktop applications use the
system menu fonts.  So, from within VB6 there is no way to adjust the
menu font types or sizes using VB menu properties.  You can control
the overall desktop font styles and sizes for all applications using
the Display Properties in Windows.

- You can, however, create custom bitmap menus for your VB6
applications and replace the system text menus.  The process would be
to use Paint or something similar to create the bitmap text of the
font style and size you want in the menu.  Then, use the following
Windows API code in VB to replace the menus defined with your own when
your applicatin loads.  The key in the code is to get the number of
menu items to replace and also create a PictureBox control array
called picMenus() with each menu bitmap:

'Number of customized menus
Const CUSTOMMENUS = 2

'Windows API menu item data structure
Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wid As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As Long
    cch As Long
End Type

'Windows API menu functions
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long,
ByVal nPos As Long) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bypos
As Long, lpcMenuItemInfo As MENUITEMINFO) As Long

'Windows API menu constants
Private Const MF_BITMAP = &H4&
Private Const MFT_BITMAP = MF_BITMAP
Private Const MIIM_TYPE = &H10

Private Sub Form_Load()

    Dim hwndMainMenu As Long
    Dim hwndSubMenu As Long
    Dim typMenuInfo As MENUITEMINFO
    Dim i As Integer

    'Get the handle of the current menu
    hwndMainMenu = GetMenu(hwnd)
    hwndSubMenu = GetSubMenu(hwndMainMenu, 0)
    
    'Iterate through menus to alter
    For i = 0 To CUSTOMMENUS - 1
        With typMenuInfo
            .cbSize = Len(typMenuInfo)
            .fType = MFT_BITMAP
            .fMask = MIIM_TYPE
            'The custom menus are stored as bitmap data in a picture array
            .dwTypeData = picMenus(i).Picture
        End With
        SetMenuItemInfo hwndSubMenu, i, True, typMenuInfo
    Next i
End Sub


I hope this helps!

I'm sorry - but I'm not qualified as a Google Answers researcher.  You
can send Google a recommendation about me though! ;-)

don,

I have sent Google answers a strong recommendation, citing the link to
this answer as support.

Thanks again for an excellent answer. 

Skipper