cmenuitems.cls

Address Book implemented in VB 6,can be use for storing person information

If Err Then
    Err.Clear
    Exit Sub
End If
' now see if the panel has a sidebar. If it does, the SidebarMenuItem will not be zero
If vPanels(pIndex).SidebarMenuItem = 0 Then Exit Sub

' now let's retrieve the array index to the menu item which is the sidebar
On Error GoTo AbortMenuUpdate
Index = cItems(vPanels(pIndex).SidebarMenuItem & "." & hMenu)
MIS.cbSize = Len(MIS)
' we want to update the menu item's ID, Enabled state and caption (type)
MIS.fMask = MIIM_ID Or MIIM_STATE Or MIIM_TYPE
MIS.fType = 0       ' equivalent to MFT_STRING
If Len(vItems(Index).Cached) Then
    MIS.dwTypeData = vItems(Index).Cached
Else
    MIS.dwTypeData = vItems(Index).Caption
End If
MIS.cch = Len(MIS.dwItemData)
MIS.dwItemData = hMenu          ' reset the submenu crossreference
MIS.wID = vItems(Index).ID      ' reapply the old menu ID
' if the caption was disabled before it was removed, ensure it stays disabled
If ((vItems(Index).Status And lv_mDisabled) = lv_mDisabled) Then MIS.fState = MF_DISABLED
If ((vItems(Index).Status And lv_mSBarHidden) = lv_mSBarHidden) Then
    ' if it was removed from the menu, its status flag would include lv_mSBarHidden
    vItems(Index).Status = vItems(Index).Status And Not lv_mSBarHidden
Else
    ' This is done vs simply updating the menu to force windows to remeasure the sidebar. If we don't do
    ' this the sidebar may never be remeasured.  Simply changing the type of non-OwnerDrawn doesn't
    ' do the trick under Win98/ME
    RemoveMenu hMenu, MIS.wID, 0
End If
' now simply add it to the top of the menu list
If InsertMenuItem(hMenu, 0, True, MIS) Then bUpdated = True

If bUpdated Then DrawMenuBar FormHwnd
AbortMenuUpdate:
End Sub

Public Sub GetPanelItem(hMenu As Long)
' ========================================================================
' Function pouplates a general use MenuComponentData structure with the requested submenu ID
' This is called each time a menu item is selected or unselected
' ========================================================================

On Error Resume Next
Dim PanelInfo As PanelData, Index As Long
XferPanelData = PanelInfo                       ' blank out the general use -- just in case
Index = cPanels("p" & hMenu)                ' find our copy in the our array
If Err = 0 Then
    XferPanelData = vPanels(Index)          ' if found, then we set the general use structure
Else
    gMenus("g" & hMenu).GetPanelItem hMenu  ' see if a child class has the item
End If
Err.Clear
End Sub

Public Function IsWindowList(hSubMenu As Long, bIsSysMenu As Boolean) As Boolean
' ========================================================================
' Primary function to add or update owner drawn menus to our class
' The main message processor prevents calling this routine while the user
' is in a menu loop and the menu has been displayed already;
' otherwise it is called each time a menu is initially displayed and again
' each time the menu loop is closed and the menu is then displayed again
' Exception: Windows Lists are processed completely every single time
' ========================================================================

Dim lMenus As Long, lState As Long, Looper As Integer
On Error Resume Next
' since our gMenus (generated menus from list/comboboxes) are processed in a
' separate child class, we test to see if the menu being processed belongs to
' a child class, if any

' Never create a menu item in a list/combobox that would create another
' submenu item referring to a list/combo box or custom menu. Doing so
' would produce undesirable effects. These routines are not designed to
' nest gMenu items.

' simple test to see if we have a gMenu item for the submenu being processed
lMenus = gMenus("g" & hSubMenu).ShowTips
If Err = 0 Then
    ' no error? then child class exists, send menu to that class
    gMenus("g" & hSubMenu).IsWindowList hSubMenu, False
    Exit Function
End If
Err.Clear

Dim OverallHeight As Long, Height As Long, maxHeight As Long
Dim MI() As Byte, Items2Check() As Long
Dim MII As MENUITEMINFO
Dim lType As Long, lStatus As Long, CachedMenus As Long
Dim sCaption As String, sNoScroll As String
Dim bBarBreak As Boolean, NewSubmenuID As Long
Dim bSideBarItem As Boolean, bHasSideBar As Boolean
Dim PageIDs() As Long, bNoOwnerDrawn As Boolean

On Error Resume Next
'Debug.Print "Processing submenu panel "; hSubMenu
' test this once at this routine & pass to GetMenuMetrix.
' More efficient then testing it for each submenu item
CachedMenus = modMenus.MenuCaptionListBox
If CachedMenus Then
    ' user is using a listbox to store caption flags
    If IsWindow(CachedMenus) = 0 Then CachedMenus = 0
End If
' get the number of submenu menu items & loop thru each subitem
' we have to do this at a minimum, 'cause VB will take ownership
' back of any menu that has changed (i.e., visibility, etc)
lMenus = GetMenuItemCount(hSubMenu)
ReDim Items2Check(0 To lMenus)  ' array of items being processed
ReDim PageIDs(0 To 0)           ' array of items forcing a new menu column
maxHeight = Screen.Height / Screen.TwipsPerPixelY - 7

For Looper = 0 To lMenus - 1
    ' by referencing the dwTypeData as a byte array vs long or string,
    ' we bypass the VB crash that happens on Win98 & XP & probably others
    bNoOwnerDrawn = False   ' flag to include/exclude MF_OWNERDRAWN
    ReDim MI(0 To 1023)
    MII.cbSize = Len(MII)
    MII.fType = 0
    MII.fMask = MIIM_ID Or MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU Or MIIM_DATA
    MII.dwTypeData = VarPtr(MI(0))
    MII.cch = UBound(MI)
    ' get the submenu item information
    GetMenuItemInfo hSubMenu, Looper, True, MII
    ' whether or not this is a system menu will be passed to this routine, via the bIsSysMenu parameter
    ' but we will check anyway. System menu items have IDs > &HF000&
    If MII.wID >= &HF000& And MII.hSubMenu = 0 Then
        bIsSysMenu = True
    Else
        ' the following most likely is a Windows List & we want to always process these since
        ' windows will take ownership back every single time it is displayed.  By setting the
        ' function return value to True, the core Message Processor function will never bypass
        ' this windows list submenu any time it appears.
        If MII.wID > &H7FFF And MII.hSubMenu = 0 Then IsWindowList = True
    End If
    Items2Check(Looper + 1) = MII.wID   ' add to array of items to check
    lStatus = 0                         ' reset the status
    ' now set/remove some flags & stuff to return the caption, checked & enabled status, etc
    ' first we look for the current status of the menu item
    If ((MII.fState And MF_DISABLED) = MF_DISABLED) Or ((MII.fState And MF_GRAYED) = MF_GRAYED) Then lStatus = lStatus Or lv_mDisabled
    If ((MII.fState And MF_CHECKED) = MF_CHECKED) Then lStatus = lStatus Or lv_mChk
    If ((MII.fState And MF_DEFAULT) = MF_DEFAULT) Then lStatus = lStatus Or lv_mDefault
    If MII.hSubMenu Then lStatus = lStatus Or lv_mSubmenu
    
    ' now we remove any previous column breaks. These would have been created if we have a scrolling menu
    ' and the user is showing a sidebar. Since menu items can be removed without me knowing (i.e., setting
    ' the menu visibility to False), we have no way to determine if these column breaks are still valid -- so we remove all of them
    If ((MII.fType And MF_MENUBARBREAK) = MF_MENUBARBREAK) Then
        MII.fType = MII.fType And Not MF_MENUBARBREAK
        bNoOwnerDrawn = True    ' we don't want MF_OWNERDRAWN for now
    End If
    If ((MII.fType And MF_MENUBREAK) = MF_MENUBREAK) Then
        MII.fType = MII.fType And Not MF_MENUBREAK
        bNoOwnerDrawn = True    ' we don't want MF_OWNERDRAWN for now
    End If
    If bIsSysMenu Then bNoOwnerDrawn = True ' we don't want MF_OWNERDRAWN for now
    lType = MII.fType
    lState = MII.fState
    sCaption = Trim$(Replace$(StrConv(MI, vbUnicode), Chr$(0), ""))    ' get the menu item caption
    'Debug.Print "caption = "; sCaption; "<"; hSubMenu; MII.wID; MII.fState
    
    ' lState will return some of the new fState attributes & lType returns new fType attributes
    ' If no major changes to a processed menu item, the next function returns within a few lines of code
    GetMenuMetrix sCaption, lStatus, lType, lState, hSubMenu, MII.wID, Looper, bSideBarItem, Height, NewSubmenuID, CachedMenus
    If bBarBreak = True Then    ' used in conjunction with the "If bSideBarItem" statement below
        ' if a sidebar is used, it gets placed in its own panel, this allows us to easily
        ' place it and we can even make it  clickable. Therefore item following sidebar
        ' starts a new column. We tag the menu id as starting a new column
        ReDim Preserve PageIDs(0 To UBound(PageIDs) + 1)
        PageIDs(UBound(PageIDs)) = MII.wID  ' add to array of new columns
        bBarBreak = False                   ' reset some flags
        OverallHeight = 0                   ' reset height for next panel
        bNoOwnerDrawn = True
    End If
    If bSideBarItem = True And bHasSideBar = False Then
        ' flag indicating that the next menu item after the sidebar
        ' must be a menu break to start a new column
        bBarBreak = True            ' flag indicating next item is a column break
        PageIDs(0) = MII.wID        ' identify which ID is the sidebar item
        bHasSideBar = True          ' flag indicating sidebar in use
        bNoOwnerDrawn = True
        Height = 0
    End If
    ' set for all non-sidebar/sys menu items
    If Not bNoOwnerDrawn Then lType = lType Or MF_OWNERDRAW
    ' calculate the overall height of the menu panel. This is only needed/used
    ' when a sidebar is being used for this menu panel
    OverallHeight = OverallHeight + Height
    If OverallHeight > maxHeight And bHasSideBar = True Then
        ' Curses on windows inflexibility. Menus scroll if there are too many
        ' menu items to display on screen. Well, if you insert a menubreak
        ' guest what? You loose the scroll functionality completely, even if the next column
        ' of menu items goes off the screen
        ' To get past that, we need to keep track of the estimated panel height
        ' and add any additional menubreaks ourselves
        ReDim Preserve PageIDs(0 To UBound(PageIDs) + 1)
        PageIDs(UBound(PageIDs)) = MII.wID  ' keep track of which IDs will start a new column/page
        If UBound(PageIDs) = 2 Then maxHeight = OverallHeight - Height
        OverallHeight = Height                   ' reset height for next panel
    End If
    MII.fMask = 0
    ' save updates to allow us to draw the menu item
    If NewSubmenuID <> 0 Or MII.hSubMenu <> 0 Then
        MII.fMask = MIIM_SUBMENU
        ' this menu item forced creation of a gMenu if NewSubmenuID<>0
        ' we need to change it to a menu having a submenu
        If NewSubmenuID <> 0 Then MII.hSubMenu = NewSubmenuID
    End If
        ' this helps us coordinate classes with menu items, without it? #&@!@
        ' only needed for the DoDrawItem & DoMeasureItem since Windows does not
        ' pass the submenu ID for ownerdrawn menus
        MII.dwItemData = hSubMenu   ' identifies which submenu menu item is on
        MII.fState = lState         ' menu item state
        MII.fType = lType           ' menu item type
        MII.fMask = MII.fMask Or MIIM_ID Or MIIM_STATE Or MIIM_DATA Or MIIM_TYPE
        SetMenuItemInfo hSubMenu, MII.wID, False, MII      ' update the menu item
        ' here's where we force windows to remeasure system menu items, by saving it again!
        If bNoOwnerDrawn Then
            MII.fType = MII.fType Or MF_OWNERDRAW
            SetMenuItemInfo hSubMenu, MII.wID, False, MII
        End If
Next
If bHasSideBar Then
' now if a sidebar is being shown, the user has an option to not show it if the menu scrolls since the
' sidebar forces columns on the menu. Well we see if that option has been selected
    With vItems(cItems(PageIDs(0) & "." & hSubMenu))
        ' get the coded part of the sidebar caption & test for the NoScroll option
        SeparateCaption .Caption, "", sCaption
        ReturnComponentValue sCaption, "NOSCROLL", sNoScroll
        If UBound(PageIDs) > 1 And Len(sNoScroll) > 0 Then
        ' scrolling menu & user doesn't want sidebar to show
            ' flag indicating we are deleting menu item but want it back
            .Status = .Status Or lv_mSBarHidden
            ' removing sidebar for scrolling menu
            RemoveMenu hSubMenu, PageIDs(0), 0
            ' we want no column breaks
            ReDim PageIDs(0 To 0)
        End If
    End With
    ' if menu will scroll we need to add menu breaks
    ' update the 1st PageID to be a menubreak
    ' then update remaining to be menubarbreaks