Visual Basic Menu API Routines
SetMenuItemInfo: Split Long Menus into Columns
     
Posted:   Friday July 10, 1998
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB5, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

SetMenuItemInfo: Menu Scroll a Standard VB Menu
SetMenuItemInfo: Custom Application Menu Colours
SetMenuItemInfo: Create a Multi-Column Font Menu
     
 Prerequisites
None.

vbnssetmenuiteminfo1.gif (4891 bytes)Often, in attempting to display a menu with a large number of selections, it may exceed the screen height truncating the menu list. This page details using the SetMenuItemInfo API to split a menu into sections.

Two methods are provided. The first simply uses the menu item count to split the menu before the last entry. The second method splits a menu in half; if it contains an odd number of entries, it assures that the 'extra' entry is added into the first column.

 BAS Module Code
None.

 Form Code
Add 2 command buttons (Command1 and Command2). In addition, create a menu array as shown, with any number of entries ... here I used 20. Name the menu array mnuOptions, and set the index of the first menu array item to 0. Add the following code to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MIIM_STATE As Long = &H1
Private Const MIIM_ID As Long = &H2
Private Const MIIM_SUBMENU As Long = &H4
Private Const MIIM_CHECKMARKS As Long = &H8
Private Const MIIM_TYPE As Long = &H10
Private Const MIIM_DATA As Long = &H20

Private Const MFT_RADIOCHECK As Long = &H200
Private Const MFT_STRING As Long = &H0

Private Const RGB_STARTNEWCOLUMNWITHVERTBAR As Long = &H20
Private Const RGB_STARTNEWCOLUMN As Long = &H40
Private Const RGB_EMPTY As Long = &H100
Private Const RGB_VERTICALBARBREAK As Long = &H160
Private Const RGB_SEPARATOR As Long = &H800

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 String
   cch As Long
End Type

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 GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function GetMenuItemInfo Lib "user32" _
    Alias "GetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal un As Long, _
    ByVal b As Boolean, lpmii As MENUITEMINFO) As Long

Private Declare Function SetMenuItemInfo Lib "user32" _
    Alias "SetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal uItem As Long, _
    ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long


Private Sub Command1_Click()
  
  'divides the menu at the last menu 
  'item (mnuItemCount - 1)  
   Dim hSubMenu As Long
   Dim mnuItemCount As Long
   Dim mInfo As MENUITEMINFO
  
  'get the menuitem handle  
   hSubMenu = GetSubMenu(GetMenu(Me.hWnd), 0)
   mnuItemCount = GetMenuItemCount(hSubMenu)
  
  'retrieve the current information for the
  'last item in the menu into an MENUITEMINFO
  'structure.
  'True means MF_BYPOSITION.
   With mInfo
      .cbSize = Len(mInfo)
      .fMask = MIIM_TYPE
      .fType = MFT_STRING
      .dwTypeData = Space$(256)
      .cch = Len(mInfo.dwTypeData)
   End With

   Call GetMenuItemInfo(hSubMenu, mnuItemCount - 1, True, mInfo)
      
  'modify its attributes to the new Type,
  'telling the menu to insert a break before
  'the member in the MENUITEMINFO structure.  
   mInfo.fType = RGB_STARTNEWCOLUMNWITHVERTBAR
     
  'we only want to change the style, 
  'so reset fMask  
   mInfo.fMask = MIIM_TYPE
   
   Call SetMenuItemInfo(hSubMenu, mnuItemCount - 1, True, mInfo)

   Print " Done !"

End Sub


Private Sub Command2_Click()

  'divides the menu into 2 even columns
   Dim hSubMenu As Long
   Dim mnuItemCount As Long
   Dim mInfo As MENUITEMINFO

   Dim pad As Long
  
  'get the menuitem handle  
   hSubMenu = GetSubMenu(GetMenu(Me.hWnd), 0)
   mnuItemCount = GetMenuItemCount(hSubMenu)
  
  'if there are an odd number of menu items, make
  'sure that the left column has the extra item  
   If mnuItemCount Mod 2 <> 0 Then pad = 1
  
  'retrieve the current information for the
  'last item in the menu into an MENUITEMINFO 
  'structure.
  'True means MF_BYPOSITION.  
   With mInfo
      .cbSize = Len(mInfo)
      .fMask = MIIM_TYPE
      .fType = MFT_STRING
      .dwTypeData = Space$(256)
      .cch = Len(mInfo.dwTypeData)
   End With

   Call GetMenuItemInfo(hSubMenu, (mnuItemCount \ 2) + pad, True, mInfo)
  
  'modify its attributes to the new Type,
  'telling the menu to insert a break before
  'the member in the MENUITEMINFO structure.  
   mInfo.fType = RGB_STARTNEWCOLUMNWITHVERTBAR
   mInfo.fMask = MIIM_TYPE

   Call SetMenuItemInfo(hSubMenu, (mnuItemCount \ 2) + pad, True, mInfo)

   Print " Done !"
   
End Sub
 Comments
Save and run the project. Selecting the first command button will insert a separator bar before the last menu item, preserving the item just preceding it. Selecting the second button will split the menu in half (based on the menu item count).

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter