Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Intermediate
May 26, 2001



Building the Right Environment to Support AI, Machine Learning and Deep Learning

SplitSubMenu - Split a submenu with vertical bars

    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 GetSubMenu Lib "user32" (ByVal hMenu As Long, _
    ByVal nPos As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As _
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
    (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, _
    lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" _
    (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, _
    lpcMenuItemInfo As MENUITEMINFO) As Long

Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = 0

' Split a menu with one or more vertical lines
' Return True if successful
' HWND is the handle of the parent window
' ITEMSINSECTION is the max number of items in each
'       section created by the vertical lines
' MENUPOS is a list of arguments that point to the menu item to be split
'    the first argument is the top-level menu
'       (0 = the left-most top-level menu)
'    the second argument, if specified, is the position
'    of the submenu inside the top-level menu
'       (0 = the submenu is the first item in the top-level menu)
'    and so on
' For example, suppose you want to split the File menu
' (the left-most toplevel menu) in groups of 10 items
'      SplitMenu Me.hWnd, 10, 0
' the following statement splits the 5th submenu of the
' Edit menu (which is the 2nd toplevel menu)
'      SplitMenu Me.hWnd, 10, 1, 4

Function SplitSubMenu(ByVal hWnd As Long, ByVal itemsInSection As Long, _
    ParamArray menuPos() As Variant) As Boolean
    Dim hMenu As Long
    Dim itemCount As Long
    Dim itemInfo As MENUITEMINFO
    Dim index As Long
    Dim ret As Long
    ' get the handle of the menu bar
    hMenu = GetMenu(hWnd)
    ' get the handle of the specified menu
    For index = 0 To UBound(menuPos)
        hMenu = GetSubMenu(hMenu, menuPos(index))
    ' get the number of items in this submenu
    itemCount = GetMenuItemCount(hMenu)
    ' init the MENUITEMINFO structure
    itemInfo.cbSize = Len(itemInfo)
    For index = itemsInSection To itemCount Step itemsInSection
        ' we only want to retrieve the menu type
        itemInfo.fMask = MIIM_TYPE
        ' retrieve caption as well
        itemInfo.fType = MFT_STRING
        itemInfo.dwTypeData = Space$(128)
        itemInfo.cch = Len(itemInfo.dwTypeData)
        ' get information about the specified menu item
        ' (True means that 2nd arg is the item's position)
        ret = GetMenuItemInfo(hMenu, index, True, itemInfo)
        ' exit if unsuccessful
        If ret = 0 Then Exit Function
        ' set the new style for this item
        itemInfo.fType = itemInfo.fType Or RGB_STARTNEWCOLUMNWITHVERTBAR
        ret = SetMenuItemInfo(hMenu, index, True, itemInfo)
        ' exit if unsuccessful
        If ret = 0 Then Exit Function
    ' True if successful
    SplitSubMenu = True
End Function
Francesco Balena
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date