vbAccelerator - Contents of code file: cCommandBarInt.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cCommandBarInt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' cComamndBarInt is the real cCommandBar object.
' It holds a collection of object pointers to cCommandBarItemInt
' objects as well as a collection of each of the controls which
' own this command bar.

Private m_colhWndUser As Collection

Private m_sKey As String
Private m_sTitle As String
Private m_colItems As Collection

Friend Sub Dump(ByVal indent As Long)
Dim vlPtr As Variant
Dim btnInt As cButtonInt
   Debug.Print Space$(indent) & m_sKey & " (" & m_sTitle & ") :Bar"
   For Each vlPtr In m_colItems
      Set btnInt = ObjectFromPtr(vlPtr)
      If Not (btnInt Is Nothing) Then
         btnInt.Dump indent + 1
      End If
   Next
End Sub
Friend Function AddRefhWnd(ByVal hWnd As Long)
   m_colhWndUser.Add hWnd, "H" & hWnd
End Function
Friend Function ReleaseRef(ByVal hWnd As Long)
   m_colhWndUser.Remove "H" & hWnd
End Function
Friend Sub NotifyUsers(ByVal eventType As Long, Optional Item As cButtonInt =
 Nothing)
Dim vHwnd As Variant
Dim ctlCmdBar As vbalCommandBar
Static noRecurse As Boolean


   If Not (Item Is Nothing) Then
      If (eventType = CHANGENOTIFICATIONBUTTONCHECKCHANGE) Then
         
         If Not noRecurse Then
         
            Dim bThisIsChecked As Boolean
            Dim bFoundCheckedItem As Boolean
            Dim vlPtr As Variant
            Dim btnInt As cButtonInt
            Dim iIndex As Long
            Dim iFirstIndex As Long
            Dim iLastIndex As Long
            Dim iBtnIndex As Long
            Dim iCheckCount As Long
            Dim bFoundButton As Boolean
            
            ' Confirm which other items to
            ' change check state:
            If (Item.Style = eRadio) Or (Item.Style = eRadioNullable) Then
                           
               bThisIsChecked = Item.Checked
               bFoundCheckedItem = bThisIsChecked
               
               noRecurse = True
               
               For Each vlPtr In m_colItems
                  iIndex = iIndex + 1
                  Set btnInt = ObjectFromPtr(vlPtr)
                  If (btnInt.Key = Item.Key) Then
                     bFoundButton = True
                     iBtnIndex = iIndex
                  Else
                     If (bFoundButton) Then
                        If (btnInt.Style = eSeparator) Then
                           iLastIndex = iIndex - 1
                           Exit For
                        Else
                           iLastIndex = iIndex
                        End If
                     Else
                        If (iFirstIndex = 0) Then
                           iFirstIndex = iIndex
                        ElseIf (btnInt.Style = eSeparator) Then
                           iFirstIndex = iIndex + 1
                        End If
                     End If
                  End If
               Next
               
               If (Item.Style = eRadioNullable) Then
                  ' any other items in the same group
                  ' must be unchecked
                  If (Item.Checked) Then
                     For iIndex = iFirstIndex To iLastIndex
                        If (iIndex <> iBtnIndex) Then
                           Set btnInt = ObjectFromPtr(m_colItems(iIndex))
                           btnInt.Checked = False
                        End If
                     Next iIndex
                  End If
                  
               ElseIf (Item.Style = eRadio) Then
                  ' any other items in the same group must
                  ' be unchecked; if no items are checked
                  ' then this item must be rechecked.
                  If (Item.Checked) Then
                     For iIndex = iFirstIndex To iLastIndex
                        If (iIndex <> iBtnIndex) Then
                           Set btnInt = ObjectFromPtr(m_colItems(iIndex))
                           btnInt.Checked = False
                        End If
                     Next iIndex
                  Else
                     For iIndex = iFirstIndex To iLastIndex
                        Set btnInt = ObjectFromPtr(m_colItems(iIndex))
                        iCheckCount = iCheckCount + Abs(btnInt.Checked)
                     Next iIndex
                     If (iCheckCount = 0) Then
                        Item.Checked = True
                     End If
                  End If
                  
               End If
               
               noRecurse = False
            End If
                     
         End If
      End If
   End If

   For Each vHwnd In m_colhWndUser
      If ControlFromhWnd(vHwnd, ctlCmdBar) Then
         ctlCmdBar.ChangeNotification Me, eventType, Item
      End If
   Next
   
End Sub
Friend Sub fInit(ByVal sKey As String)
   m_sKey = sKey
End Sub
Friend Property Get Key() As String
   Key = m_sKey
End Property
Friend Property Get IndexOf(ByVal sBtnKey As String) As Long
Dim iItem As Long
Dim vlPtr As Variant
Dim btnInt As cButtonInt
   For Each vlPtr In m_colItems
      iItem = iItem + 1
      Set btnInt = ObjectFromPtr(vlPtr)
      If (btnInt.Key = sBtnKey) Then
         IndexOf = iItem
         Exit For
      End If
   Next
End Property
Friend Property Get Title() As String
   Title = m_sTitle
End Property
Friend Property Let Title(ByVal sTitle As String)
   m_sTitle = sTitle
   NotifyUsers 3
End Property
Friend Property Get Count() As Long
   Count = m_colItems.Count
End Property
Friend Property Get Item(ByVal index As Variant) As cButtonInt
Dim lPtr As Long
   lPtr = m_colItems(index)
   If Not (lPtr = 0) Then
      Set Item = ObjectFromPtr(lPtr)
   End If
End Property
Friend Sub Add(button As cButtonInt)
Dim sKey As String
   sKey = button.Key
   If CollectionContains(m_colItems, sKey) Then
      gErr 5
   Else
      m_colItems.Add ObjPtr(button), sKey
      button.AddedToBar Me
      NotifyUsers 1
   End If
End Sub
Friend Sub InsertBefore(button As cButtonInt, buttonBefore As cButtonInt)
   If CollectionContains(m_colItems, button.Key) Then
      gErr 5
   Else
      If Not (CollectionContains(m_colItems, buttonBefore.Key)) Then
         gErr 3
      Else
         m_colItems.Add ObjPtr(button), button.Key, buttonBefore
         button.AddedToBar Me
         NotifyUsers 1
      End If
   End If
End Sub
Friend Sub InsertAfter(button As cButtonInt, buttonAfter As cButtonInt)
   If CollectionContains(m_colItems, button.Key) Then
      gErr 5
   Else
      If Not (CollectionContains(m_colItems, buttonAfter.Key)) Then
         gErr 3
      Else
         m_colItems.Add ObjPtr(button), button.Key, , buttonAfter
         button.AddedToBar Me
         NotifyUsers 1
      End If
   End If
End Sub
Friend Sub Remove(button As cButtonInt)
   If CollectionContains(m_colItems, button.Key) Then
      m_colItems.Remove button
      button.RemovedFromBar Me
      NotifyUsers 1
   Else
      gErr 3
   End If
End Sub
Friend Sub Clear()
Dim vlPtr As Variant
Dim itm As cButtonInt
   For Each vlPtr In m_colItems
      Set itm = ObjectFromPtr(vlPtr)
      If Not (itm Is Nothing) Then
         itm.RemovedFromBar Me
      End If
   Next
   Set m_colItems = New Collection
   NotifyUsers 1
End Sub
Friend Sub CalculateMenuWithVisibleCheckSize( _
      cMP As cMeasureButtonParams, _
      ByRef menuWidth As Long, _
      ByRef menuHeight As Long, _
      ByRef Item() As cDisplayButtonInfo _
   )
   ' basically same as calculate menu size,
   ' but we add an extra check width and ignore
   ' if items are marked as invisible.
   
End Sub
Friend Sub CalculateMenuSize( _
      cMP As cMeasureButtonParams, _
      ByRef menuWidth As Long, _
      ByRef menuHeight As Long, _
      ByRef Item() As cDisplayButtonInfo _
   )
   
   '
   menuWidth = 0
   menuHeight = 0
   
   If (m_colItems.Count > 0) Then
      
      ' ensure we calculate the required height first
      ' time around:
      cMP.Height = 0
      
      Dim vlPtr As Variant
      Dim btnInt As cButtonInt
      Dim btnWidth As Long
      Dim btnHeight As Long
      Dim iItem As Long
      Dim maxWidth As Long
            
      For Each vlPtr In m_colItems
         iItem = iItem + 1
         
         btnWidth = 0
         btnHeight = 0

         Set btnInt = ObjectFromPtr(vlPtr)
         If Not (btnInt Is Nothing) Then
            If (btnInt.Visible) Then
               If Not (btnInt.InfrequentlyUsed) Or
                mCommandBars.ShowingInfrequentlyUsed Then
                  cMP.Height = 0
                  btnWidth = btnInt.Size(cMP)
                  btnHeight = cMP.Height
                  If (btnWidth > maxWidth) Then
                     maxWidth = btnWidth
                  End If
               End If
            End If
         End If

         Item(iItem).left = 0
         If (menuHeight = 0) Then
            menuHeight = 1
         End If
         Item(iItem).top = menuHeight
         menuHeight = menuHeight + btnHeight
         Item(iItem).bottom = menuHeight
      Next
      
      menuWidth = maxWidth
      ' Set the width for the items:
      For iItem = 1 To m_colItems.Count
         Item(iItem).right = menuWidth
      Next
      
   End If
   '
End Sub
Friend Sub Draw( _
      cDP As cDrawButtonParams, _
      Item() As cDisplayButtonInfo _
   )
   If (m_colItems.Count > 0) Then
      
      Dim vlPtr As Variant
      Dim btnInt As cButtonInt
      Dim iItem As Long
      
      For Each vlPtr In m_colItems
         iItem = iItem + 1
         Set btnInt = ObjectFromPtr(vlPtr)
         If Not (btnInt Is Nothing) Then
            cDP.left = Item(iItem).left
            cDP.top = Item(iItem).top
            cDP.Size = Item(iItem).right - Item(iItem).left
            cDP.Height = Item(iItem).bottom - Item(iItem).top
            cDP.MouseDownButton = Item(iItem).mouseDown
            cDP.MouseOverButton = Item(iItem).mouseOver
            cDP.mouseDownSplit = Item(iItem).mouseDownSplit
            cDP.mouseOverSplit = Item(iItem).mouseOverSplit
            btnInt.Draw cDP
         End If
      Next
   End If
End Sub
Friend Sub DrawOneButton( _
      cDP As cDrawButtonParams, _
      itemIndex As Long _
   )
Dim vlPtr As Variant
Dim btnInt As cButtonInt
   vlPtr = m_colItems(itemIndex)
   Set btnInt = ObjectFromPtr(vlPtr)
   If Not (btnInt Is Nothing) Then
      btnInt.Draw cDP
   End If
End Sub
Friend Sub ClickButton( _
      index As Long _
   )
   If (Item(index).Style = eCheck) Or (Item(index).Style = eRadio) Or
    (Item(index).Style = eRadioNullable) Then
      ' this will cause notify users to be called.
       Item(index).Checked = Not (Item(index).Checked)
   Else
      '
   End If
End Sub
Friend Sub CalculateToolbarSize( _
      cMP As cMeasureButtonParams, _
      ByRef toolbarWidth As Long, _
      ByRef toolbarHeight As Long, _
      ByRef Item() As cDisplayButtonInfo _
   )
   
   ' The toolbar width is constrained.  We calculate
   ' the desired height for a single button and also
   ' hide buttons with lower priorities if there isn't
   ' enough room.  We also return the actual width
   ' needed for the bar in the toolbarWidth param
   '
   ' The first loop calculates the total width we end up with
   '
   
   Dim availableWidth As Long
   availableWidth = toolbarWidth
   toolbarWidth = 0
   toolbarHeight = 0
   
   If (m_colItems.Count > 0) Then
      
      cMP.Height = 0
      
      Dim vlPtr As Variant
      Dim btnInt As cButtonInt
      Dim btnWidth As Long
      Dim btnHeight As Long
      Dim iItem As Long
      Dim lastRight As Long
      Dim offset As Long
      
      If (cMP.RightToLeft) Then
         lastRight = availableWidth
      End If
      
      For Each vlPtr In m_colItems
         iItem = iItem + 1
         
         Set btnInt = ObjectFromPtr(vlPtr)
         If Not (btnInt Is Nothing) Then
            If (btnInt.Visible) Then
               btnWidth = btnInt.Size(cMP)
               btnHeight = cMP.Height
               If (btnHeight > toolbarHeight) Then
                  toolbarHeight = btnHeight
               End If
            Else
               btnWidth = 0
               btnHeight = 0
            End If
         End If

         If (cMP.Orientation = eLeft) Or (cMP.Orientation = eRight) Then
            Item(iItem).top = lastRight
            lastRight = lastRight + btnWidth
            Item(iItem).bottom = lastRight
            Item(iItem).left = 0
            Item(iItem).right = btnHeight
         Else
            If (cMP.RightToLeft) Then
               Item(iItem).right = lastRight
               lastRight = Item(iItem).right - btnWidth
               Item(iItem).left = lastRight
            Else
               Item(iItem).left = lastRight
               lastRight = Item(iItem).left + btnWidth
               Item(iItem).right = lastRight
            End If
            Item(iItem).top = 0
            Item(iItem).bottom = btnHeight
         End If
      Next
      
      toolbarWidth = lastRight
            
      ' Should hide lower priority buttons if the toolbar is too narrow
      If (toolbarWidth > availableWidth) Then
         ' start making items invisible working
         ' backwards from the end downwards:
         ' TODO
      End If
      
      ' If we're a vertical toolbar then there can be a difference
      ' between an individual button's width and the width of the
      ' toolbar as a whole:
      If (cMP.Orientation = eLeft Or cMP.Orientation = eRight) Then
         iItem = 0
         For Each vlPtr In m_colItems
            iItem = iItem + 1
            Set btnInt = ObjectFromPtr(vlPtr)
            If Not (btnInt Is Nothing) Then
               If btnInt.Style = eSeparator Then
                  Item(iItem).right = toolbarHeight
               Else
                  If (Item(iItem).right - Item(iItem).left < toolbarHeight) Then
                     ' centre:
                     offset = (toolbarHeight - (Item(iItem).right -
                      Item(iItem).left)) / 2
                     Item(iItem).left = Item(iItem).left + offset
                     Item(iItem).right = Item(iItem).right + offset
                  End If
               End If
            End If
         Next
      End If
   End If
   
   
   '
   
End Sub
Friend Sub CalculateWrappableToolbarSize( _
      cMP As cMeasureButtonParams, _
      ByRef toolbarWidth As Long, _
      ByRef toolbarHeight As Long, _
      ByRef Item() As cDisplayButtonInfo _
   )
   
   ' The width is kind of constrained but it will be
   ' adjusted to the nearest snap position if we need
   ' to wrap
   
   '
      
End Sub

Friend Sub Dispose()
   Set m_colItems = New Collection
   Set m_colhWndUser = New Collection
End Sub

Private Sub Class_Initialize()
   Set m_colhWndUser = New Collection
   Set m_colItems = New Collection
End Sub

Private Sub Class_Terminate()
   Clear
End Sub