vbAccelerator - Contents of code file: cButtonInt.clsVERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cButtonInt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" ( _
ByVal cChar As Byte) As Integer
Private Declare Function VkKeyScanW Lib "user32" ( _
ByVal cChar As Integer) As Integer
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" ( _
ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Function MapVirtualKeyW Lib "user32" (ByVal wCode As Long, _
ByVal wMapType As Long) As Long
Private Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" ( _
ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetKeyNameTextW Lib "user32" (ByVal lParam As Long, _
ByVal lpBuffer As Long, ByVal nSize As Long) As Long
' cComamndBarItemInt is a real cCommandBarItem object.
' It holds the description of the item, a collection of object
' pointers to the owning command bar(s)
Private m_lBorderSize As Long ' = 4
Private m_lSplitWidth As Long ' = 11
Private m_lMenuGlyphWidth As Long ' = 24
Private m_sKey As String
Private m_sCaption As String
Private m_iIconIndex As Long
Private m_oColour As OLE_COLOR
Private m_bShowCaptionInToolbar As Boolean
Private m_bShowDropDownInToolbar As Boolean
Private m_eStyle As EButtonStyle
Private m_lPanelWidth As Long
Private m_lPtrPanelControl As Long
Private m_bEnabled As Boolean
Private m_bLocked As Boolean
Private m_bVisible As Boolean
Private m_bInFrequentlyUsed As Boolean
Private m_iPriority As Long
Private m_bChecked As Boolean
Private m_sToolTip As String
Private m_vShortcutKey As Integer
Private m_eShortcutModifiers As ShiftConstants
Private m_lPtrBar As Long
Private m_hWnd As Long
Private m_eVisibleCheck As CheckBoxConstants
Private m_sTag As String
Private m_lItemData As Long
Private m_cCacheSize() As cMeasureButtonParams
Private m_iSizeCacheCount As Long
' Owning bar collection:
Private m_ptrBars As Collection
' Collection of form window handles that this button is
' associated with:
Private m_colHandles As Collection
Friend Sub AddParenthWnd(ByVal hWnd As Long, ByVal hWndParent As Long)
If Not (CollectionContains(m_colHandles, "H" & hWndParent)) Then
m_colHandles.Add hWnd, "H" & hWndParent
If Not (m_lPtrBar = 0) Then
Dim Bar As cCommandBarInt
Set Bar = ObjectFromPtr(m_lPtrBar)
If Not Bar Is Nothing Then
Bar.AddRefhWnd hWnd, hWndParent
End If
End If
End If
End Sub
Friend Sub RemoveParenthWnd(ByVal hWndParent As Long)
If (CollectionContains(m_colHandles, "H" & hWndParent)) Then
m_colHandles.Remove "H" & hWndParent
End If
End Sub
Friend Property Get Tag() As String
Tag = m_sTag
End Property
Friend Property Let Tag(ByVal sTag As String)
m_sTag = sTag
End Property
Friend Property Get itemData() As Long
itemData = m_lItemData
End Property
Friend Property Let itemData(ByVal lData As Long)
m_lItemData = lData
End Property
Friend Property Get VisibleCheck() As CheckBoxConstants
VisibleCheck = m_eVisibleCheck
End Property
Friend Property Let VisibleCheck(ByVal eCheck As CheckBoxConstants)
m_eVisibleCheck = eCheck
End Property
Friend Function RemovedFromBar(barInt As cCommandBarInt)
m_ptrBars.Remove barInt.Key
End Function
Friend Function AddedToBar(barInt As cCommandBarInt)
m_ptrBars.Add ObjPtr(barInt), barInt.Key
End Function
Friend Function Deleted()
Dim vlPtr As Variant
Dim barInt As cCommandBarInt
For Each vlPtr In m_ptrBars
Set barInt = ObjectFromPtr(vlPtr)
If Not (barInt Is Nothing) Then
barInt.Remove Me
End If
Next
End Function
Friend Property Get CanAction( _
ByVal eOrientation As ECommandBarOrientation, _
ByVal bItemInMenu As Boolean, _
ByVal bVisibleCheckMenu As Boolean _
) As Boolean
Dim bCanAction As Boolean
bCanAction = m_bEnabled And m_bVisible And Not (m_eStyle = eSeparator) And
Not (m_bLocked)
If (bCanAction) Then
If (m_eStyle = ePanel) Then
If (eOrientation = eLeft Or eOrientation = eRight) Then
bCanAction = (m_iIconIndex > -1)
Else
bCanAction = False
End If
End If
Else
If (bVisibleCheckMenu And Not (m_eVisibleCheck = vbGrayed)) Then
bCanAction = True
End If
End If
CanAction = bCanAction
End Property
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 Caption() As String
Caption = m_sCaption
End Property
Friend Property Let Caption(ByVal sCaption As String)
m_sCaption = sCaption
Remeasure
End Property
Friend Property Get ToolTip() As String
ToolTip = m_sToolTip
End Property
Friend Property Let ToolTip(ByVal sToolTip As String)
m_sToolTip = sToolTip
End Property
Friend Property Get colourBox() As OLE_COLOR
colourBox = m_oColour
End Property
Friend Property Let colourBox(ByVal oColor As OLE_COLOR)
m_oColour = oColor
Remeasure
End Property
Friend Property Get IconIndex() As Long
IconIndex = m_iIconIndex
End Property
Friend Property Let IconIndex(ByVal lIconIndex As Long)
m_iIconIndex = lIconIndex
Remeasure
End Property
Friend Property Get Enabled() As Boolean
Enabled = m_bEnabled
End Property
Friend Property Let Enabled(ByVal bEnabled As Boolean)
m_bEnabled = bEnabled
NotifyUsers CHANGENOTIFICATIONBUTTONREDRAW
End Property
Friend Property Get Locked() As Boolean
Locked = m_bLocked
End Property
Friend Property Let Locked(ByVal bLocked As Boolean)
m_bLocked = bLocked
NotifyUsers CHANGENOTIFICATIONBUTTONREDRAW
End Property
Friend Property Get InfrequentlyUsed() As Boolean
InfrequentlyUsed = m_bInFrequentlyUsed
End Property
Friend Property Let InfrequentlyUsed(ByVal bInfrequentlyUsed As Boolean)
m_bInFrequentlyUsed = bInfrequentlyUsed
Remeasure
End Property
Friend Property Get Checked() As Boolean
Checked = m_bChecked
End Property
Friend Property Let Checked(ByVal bChecked As Boolean)
If (m_eStyle = eCheck Or m_eStyle = eRadio Or m_eStyle = eRadioNullable) Then
m_bChecked = bChecked
' We need to check here for any other buttons
' which might be affected!
NotifyUsers CHANGENOTIFICATIONBUTTONCHECKCHANGE
End If
End Property
Friend Property Get Visible() As Boolean
Visible = m_bVisible
End Property
Friend Property Let Visible(ByVal bVisible As Boolean)
m_bVisible = bVisible
Remeasure
End Property
Friend Property Get Priority() As Long
Priority = m_iPriority
End Property
Friend Property Let Priority(ByVal lPriority As Long)
m_iPriority = lPriority
Remeasure
End Property
Friend Property Get PanelWidth() As Long
PanelWidth = m_lPanelWidth
End Property
Friend Property Let PanelWidth(ByVal lPanelWidth As Long)
m_lPanelWidth = lPanelWidth
Remeasure
End Property
Friend Property Get PanelControl() As Object
If Not (m_lPtrPanelControl = 0) Then
Set PanelControl = ObjectFromPtr(m_lPtrPanelControl)
End If
End Property
Friend Property Let PanelControl(ctl As Object)
pSetPanelControl ctl
End Property
Friend Property Set PanelControl(ctl As Object)
pSetPanelControl ctl
End Property
Private Sub pSetPanelControl(ctl As Object)
If (ctl Is Nothing) Then
m_lPtrPanelControl = 0
Else
m_lPtrPanelControl = ObjPtr(ctl)
End If
Remeasure
End Sub
Friend Property Get ShowCaptionInToolbar() As Boolean
ShowCaptionInToolbar = m_bShowCaptionInToolbar
End Property
Friend Property Let ShowCaptionInToolbar(ByVal bShowCaptionInToolbar As Boolean)
m_bShowCaptionInToolbar = bShowCaptionInToolbar
Remeasure
End Property
Friend Property Get ShowDropDownInToolbar() As Boolean
ShowDropDownInToolbar = m_bShowDropDownInToolbar
End Property
Friend Property Let ShowDropDownInToolbar(ByVal bShowDropDownInToolbar As
Boolean)
m_bShowDropDownInToolbar = bShowDropDownInToolbar
Remeasure
End Property
Friend Property Get ShortcutKey() As Integer
ShortcutKey = m_vShortcutKey
End Property
Friend Property Let ShortcutKey(ByVal vShortcutKey As Integer)
m_vShortcutKey = vShortcutKey
End Property
Friend Property Get Style() As EButtonStyle
Style = m_eStyle
End Property
Friend Property Let Style(eStyle As EButtonStyle)
m_eStyle = eStyle
Remeasure
End Property
Friend Property Get ShortcutModifiers() As ShiftConstants
ShortcutModifiers = m_eShortcutModifiers
End Property
Friend Property Let ShortcutModifiers(eShortcutModifiers As ShiftConstants)
m_eShortcutModifiers = eShortcutModifiers
End Property
Friend Property Get Bar() As cCommandBarInt
If Not (m_lPtrBar = 0) Then
Set Bar = ObjectFromPtr(m_lPtrBar)
End If
End Property
Friend Function SetBar(cmdBar As cCommandBarInt)
Dim lPtrNew As Long
Dim Bar As cCommandBarInt
If (cmdBar Is Nothing) Then
lPtrNew = 0
Else
lPtrNew = ObjPtr(cmdBar)
End If
If Not (lPtrNew = m_lPtrBar) Then
If Not (m_lPtrBar = 0) Then
Set Bar = ObjectFromPtr(m_lPtrBar)
If Not (Bar Is Nothing) Then
End If
End If
If (lPtrNew = 0) Then
m_lPtrBar = 0
Else
m_lPtrBar = lPtrNew
End If
End If
End Function
Friend Sub NotifyUsers(ByVal eventType As Long)
Dim vlPtr As Variant
Dim Bar As cCommandBarInt
For Each vlPtr In m_ptrBars
Set Bar = ObjectFromPtr(vlPtr)
If Not (Bar Is Nothing) Then
Bar.NotifyUsers eventType, Me
End If
Next
End Sub
Friend Function TooltipText(ByVal showShortcut As Boolean) As String
Dim sRet As String
Dim sShortcut As String
sRet = m_sToolTip
If (showShortcut) Then
sShortcut = ShortcutText()
If (Len(sShortcut) > 0) Then
sRet = sRet & " (" & ShortcutText() & ")"
End If
End If
TooltipText = sRet
End Function
Friend Function ShortcutText() As String
' TODO: Fill in the shortcut, appropriately internationalized
Dim sShortcut As String
Dim lScanCode As Long
Dim sBuf As String
Dim lSize As Long
Dim b() As Byte
Dim sKeyName As String
' Translate the virtual-key code into a scan code.
If Not (m_vShortcutKey = 0) Then
If (m_eShortcutModifiers > 0) Then
If ((m_eShortcutModifiers And vbCtrlMask) = vbCtrlMask) Then
sShortcut = sShortcut & "Ctrl+"
End If
If ((m_eShortcutModifiers And vbShiftMask) = vbShiftMask) Then
sShortcut = sShortcut & "Shift+"
End If
If ((m_eShortcutModifiers And vbAltMask) = vbAltMask) Then
sShortcut = sShortcut & "Alt+"
End If
End If
If (m_vShortcutKey = vbKeyDelete) Then
sKeyName = "Del"
Else
If (IsNt) Then
lScanCode = MapVirtualKeyW(m_vShortcutKey, 0)
Else
lScanCode = MapVirtualKey(m_vShortcutKey, 0)
End If
'' GetKeyNameText retrieves the name of a key (the scan code
' must be in bits 16-23):
lScanCode = lScanCode * &H10000
If (IsNt) Then
ReDim b(0 To 512) As Byte
lSize = GetKeyNameTextW(lScanCode, VarPtr(b(0)), 256)
If (lSize > 0) Then
sBuf = b
sKeyName = left$(sBuf, lSize)
End If
Else
sBuf = Space$(256)
lSize = GetKeyNameText(lScanCode, sBuf, 256)
sKeyName = left$(sBuf, lSize)
End If
End If
sShortcut = sShortcut & StrConv(sKeyName, vbProperCase)
End If
ShortcutText = sShortcut
End Function
Friend Function OverSplit( _
ByVal xOffset As Long, _
ByVal yOffset As Long, _
ByVal lWidth As Long, _
ByVal lHeight As Long, _
ByVal RightToLeft As Boolean, _
ByVal Orientation As ECommandBarOrientation _
)
If (m_eStyle = eSplit) Then
'If (orientation = eLeft) Or (orientation = eRight) Then
' OverSplit = (yOffset > (lHeight - m_lSplitWidth))
'Else
If (RightToLeft) Then
OverSplit = (xOffset < m_lSplitWidth)
Else
OverSplit = (xOffset > (lWidth - m_lSplitWidth))
End If
'End If
End If
End Function
Friend Sub DrawMenuStyle( _
cDP As cDrawButtonParams _
)
Dim iIdx As Long
Dim bEnabled As Boolean
Dim hPen As Long
Dim hPenOld As Long
Dim hFontOld As Long
Dim tJ As POINTAPI
bEnabled = cDP.Enabled
cDP.Enabled = (m_bEnabled And cDP.Enabled)
If (cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
cDP.Enabled = Not (m_eVisibleCheck = vbGrayed)
End If
' A menu style thing. Now in a menu, if the item has a
' blank caption, we take that to mean it should be drawn
' as just the icon, whereas if it has a caption then
' we extend across.
'
' Here we'll take it as read that the background of the
' menu has been drawn.
Dim lTextXStart As Long
If (cDP.RightToLeft) Then
lTextXStart = cDP.left + 4 '+ cDP.Size - cDP.IconWidth - 16
Else
lTextXStart = 16 + cDP.ImageList.IconWidth
End If
If (cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
If (cDP.RightToLeft) Then
'lTextXStart = lTextXStart - cDP.IconWidth - 6
Else
lTextXStart = lTextXStart + cDP.ImageList.IconWidth + 6
End If
End If
If (m_eStyle = eSeparator) Then
hPen = CreatePen(PS_SOLID, 1, DarkColor)
hPenOld = SelectObject(cDP.hdc, hPen)
If (cDP.RightToLeft) Then
MoveToEx cDP.hdc, cDP.left + cDP.Size - cDP.ImageList.IconWidth - 4 -
cDP.ImageList.IconWidth, cDP.top + 1, tJ
Else
MoveToEx cDP.hdc, lTextXStart, cDP.top + 1, tJ
End If
LineTo cDP.hdc, IIf(cDP.RightToLeft, cDP.left, cDP.Size), cDP.top + 1
SelectObject cDP.hdc, hPenOld
DeleteObject hPen
Else
' is the item highlighted?
Dim checkColorStart As Long
Dim checkColorEnd As Long
checkColorStart = MenuCheckedBackgroundColorStart
checkColorEnd = MenuCheckedBackgroundColorEnd
If (cDP.Enabled) Or (HighlightDisabledItems) Then
If (cDP.MouseOverButton) Or (cDP.ShowingMenu) Then
' Fill the highlight rectangle:
If (cDP.Enabled) Then
checkColorStart = MenuCheckedHotBackgroundColorStart
checkColorEnd = MenuCheckedHotBackgroundColorEnd
UtilDrawBackground cDP.hdc, _
MenuHotBackgroundColorStart, MenuHotBackgroundColorEnd, _
cDP.left + 2, cDP.top + 1, cDP.Size - 4, cDP.Height - 1
Else
UtilDrawBackground cDP.hdc, _
MenuBackgroundColorStart, MenuBackgroundColorEnd, _
cDP.left + 2, cDP.top + 1, cDP.Size - 4, cDP.Height - 1
End If
UtilDrawBorderRectangle cDP.hdc, MenuHotBorderColor, _
cDP.left + 2, cDP.top + 1, cDP.Size - 4, cDP.Height - 1, False
End If
End If
If (cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
If (cDP.RightToLeft) Then
If Not (VisibleCheck = Gray) Then
UtilDrawBackground cDP.hdc, _
checkColorStart, checkColorEnd, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4,
cDP.top + 2, cDP.ImageList.IconWidth + 5,
cDP.ImageList.IconHeight + 5
UtilDrawBorderRectangle cDP.hdc, MenuHotBorderColor, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4,
cDP.top + 2, cDP.ImageList.IconWidth + 5,
cDP.ImageList.IconHeight + 5, True
If (VisibleCheck = OLE_TRISTATE.Checked) Then
' Draw the check glyph
UtilDrawCheckGlyph cDP.hdc, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4 + 2,
cDP.top + (cDP.Height - cDP.ImageList.IconHeight) \ 2, _
cDP.ImageList.IconWidth, cDP.ImageList.IconHeight, _
m_bEnabled, &H0
End If
End If
cDP.Size = cDP.Size - cDP.ImageList.IconWidth - 4
Else
If Not (VisibleCheck = Gray) Then
UtilDrawBackground cDP.hdc, _
checkColorStart, checkColorEnd, _
cDP.left + 3, cDP.top + 2, cDP.ImageList.IconWidth + 5,
cDP.ImageList.IconHeight + 5
UtilDrawBorderRectangle cDP.hdc, MenuHotBorderColor, _
cDP.left + 3, cDP.top + 2, cDP.ImageList.IconWidth + 5,
cDP.ImageList.IconHeight + 5, True
If (VisibleCheck = OLE_TRISTATE.Checked) Then
UtilDrawCheckGlyph cDP.hdc, _
cDP.left + 5, cDP.top + (cDP.Height -
cDP.ImageList.IconHeight) \ 2, _
cDP.ImageList.IconWidth, cDP.ImageList.IconHeight, _
m_bEnabled, &H0
End If
End If
cDP.left = cDP.left + cDP.ImageList.IconWidth + 4
cDP.Size = cDP.Size - cDP.ImageList.IconWidth - 4
End If
End If
' Checked?
If (m_bChecked) Then
If (cDP.RightToLeft) Then
UtilDrawBackground cDP.hdc, _
checkColorStart, checkColorEnd, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4, cDP.top +
2, cDP.ImageList.IconWidth + 5, cDP.ImageList.IconHeight + 5
UtilDrawBorderRectangle cDP.hdc, MenuHotBorderColor, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4, cDP.top +
2, cDP.ImageList.IconWidth + 5, cDP.ImageList.IconHeight + 5,
True
Else
UtilDrawBackground cDP.hdc, _
checkColorStart, checkColorEnd, _
cDP.left + 3, cDP.top + 2, cDP.ImageList.IconWidth + 5,
cDP.ImageList.IconHeight + 5
UtilDrawBorderRectangle cDP.hdc, MenuHotBorderColor, _
cDP.left + 3, cDP.top + 2, cDP.ImageList.IconWidth + 5,
cDP.ImageList.IconHeight + 5, True
End If
End If
' Icon:
If (m_iIconIndex > -1) Or Not (m_oColour = CLR_NONE) Then
If (cDP.RightToLeft) Then
UtilDrawIcon cDP.hdc, cDP.ImageList, m_iIconIndex, m_oColour, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4 + 2, _
cDP.top + (cDP.Height - cDP.ImageList.IconHeight) \ 2, _
IIf(cDP.Enabled, eIconStandard, eIconDIsabled)
Else
UtilDrawIcon cDP.hdc, cDP.ImageList, m_iIconIndex, m_oColour, _
cDP.left + 5, _
cDP.top + (cDP.Height - cDP.ImageList.IconHeight) \ 2, _
IIf(cDP.Enabled, eIconStandard, eIconDIsabled)
End If
Else
If (m_bChecked) Then
If (cDP.RightToLeft) Then
' Draw the check glyph
UtilDrawCheckGlyph cDP.hdc, _
cDP.left + cDP.Size - 4 - cDP.ImageList.IconWidth - 4 + 2, _
cDP.top + (cDP.Height - cDP.ImageList.IconHeight) \ 2, _
cDP.ImageList.IconWidth, cDP.ImageList.IconHeight, _
m_bEnabled, &H0
Else
' Draw the check glyph
UtilDrawCheckGlyph cDP.hdc, _
cDP.left + 5, cDP.top + (cDP.Height -
cDP.ImageList.IconHeight) \ 2, _
cDP.ImageList.IconWidth, cDP.ImageList.IconHeight, _
m_bEnabled, &H0
End If
End If
End If
' Text
Dim lTextColor As Long
If (m_bEnabled) Then
If (cDP.MouseOverButton Or cDP.ShowingMenu) Then
lTextColor = MenuTextHotColor
Else
lTextColor = MenuTextColor
End If
Else
lTextColor = MenuTextDisabledColor
End If
hFontOld = SelectObject(cDP.hdc, cDP.hFont)
UtilDrawText _
cDP.hdc, m_sCaption, _
lTextXStart, cDP.top, cDP.Size - lTextXStart, cDP.Height, _
m_bEnabled, lTextColor, cDP.Orientation, False
Dim sShortcut As String
Dim tR As RECT
sShortcut = ShortcutText
If (Len(sShortcut) > 0) Then
' draw the short cut text;
tR.bottom = cDP.Height
DrawText cDP.hdc, sShortcut, -1, tR, DT_CALCRECT Or DT_SINGLELINE
Dim lShortcutLeft As Long
If (cDP.RightToLeft) Then
Else
lShortcutLeft = cDP.left + cDP.Size - (tR.right - tR.left) -
m_lMenuGlyphWidth
UtilDrawText _
cDP.hdc, sShortcut, _
lShortcutLeft, cDP.top, cDP.Size - lShortcutLeft, cDP.Height, _
m_bEnabled, lTextColor, cDP.Orientation, False
End If
End If
SelectObject cDP.hdc, hFontOld
' Sub Menu?
If Not (m_lPtrBar = 0) Then
If (cDP.RightToLeft) Then
Else
UtilDrawSubMenuGlyph cDP.hdc, _
cDP.left + cDP.Size - m_lMenuGlyphWidth, cDP.top,
m_lMenuGlyphWidth, cDP.Height, _
m_bEnabled, lTextColor
End If
End If
End If
cDP.Enabled = bEnabled
End Sub
Private Sub DrawButtonStyle( _
cDP As cDrawButtonParams _
)
Dim iIdx As Long
Dim bEnabled As Boolean
Dim bMouseOver As Boolean
Dim bMouseOverSplit As Boolean
Dim hPen As Long
Dim hPenOld As Long
Dim hFontOld As Long
Dim tJ As POINTAPI
Dim lTextColor As Long
Dim hasSplitGlyph As Boolean
Dim startColor As Long
Dim endColor As Long
Dim hotSplit As Boolean
Dim drawBorder As Boolean
Dim drawSplitBorder As Boolean
Dim tSplitRect As RECT
Dim lBackWidth As Long
Dim lBackHeight As Long
Dim skipBackground As Boolean
Dim bHotText As Boolean
Dim bDefaultDraw As Boolean
Dim eStyle As EIconProcessorStyle
bEnabled = cDP.Enabled
cDP.Enabled = CanAction(cDP.Orientation, _
(cDP.SizeStyle = COMMANDBARSIZESTYLEMENU) Or (cDP.SizeStyle =
COMMANDBARSIZESTYLEMENUVISIBLECHECK), _
cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK)
' Backgrounds:
If (cDP.Enabled) Then
If (m_eStyle = eSplit) Then
If (cDP.MouseDownSplit And cDP.MouseOverSplit) Or cDP.ShowingMenu Then
drawBorder = True
startColor = GradientColorStart
endColor = GradientColorEnd
bHotText = True
ElseIf (cDP.MouseOverSplit) Or (cDP.MouseOverButton) Then
drawBorder = True
drawSplitBorder = True
If (cDP.MouseDownButton) Then
' Draw hot down background:
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
bHotText = True
' Overdraw the split with the hot up color:
hotSplit = True
Else
' Background hot for both:
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
bHotText = True
End If
ElseIf (cDP.MouseDownButton) Then
drawBorder = True
drawSplitBorder = True
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
bHotText = True
Else
startColor = ButtonBackgroundColorStart
endColor = ButtonBackgroundColorEnd
End If
Else
If (cDP.ShowingMenu) Then
drawBorder = True
If (m_lPtrBar = 0) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
bHotText = True
Else
If (mCommandBarColours.Style = eMoney) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
bHotText = True
Else
startColor = GradientColorStart
endColor = GradientColorEnd
End If
End If
Else
If (cDP.MouseOverButton) Then
drawBorder = True
If (cDP.MouseDownButton) Then
If (m_lPtrBar = 0) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
bHotText = True
Else
startColor = GradientColorStart
endColor = GradientColorEnd
End If
Else
If (m_bChecked) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
bHotText = True
Else
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
bHotText = True
End If
End If
ElseIf (cDP.MouseDownButton) Then
drawBorder = True
If (m_bChecked) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
bHotText = True
Else
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
bHotText = True
End If
Else
If (m_bChecked) Then
drawBorder = True
startColor = ButtonCheckedBackgroundColorStart
endColor = ButtonCheckedBackgroundColorEnd
Else
startColor = ButtonBackgroundColorStart
endColor = ButtonBackgroundColorEnd
End If
End If
End If
End If
Else
skipBackground = True
eStyle = eIconDIsabled
If (HighlightDisabledItems) Then
drawBorder = cDP.MouseOverButton
End If
End If
If (cDP.Enabled) And (mCommandBarColours.Style = eMoney) Then
If (cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR) Or (cDP.SizeStyle =
COMMANDBARSIZESTYLETOOLBARWRAPPABLE) Then
If (Len(m_sCaption) > 0) And (m_iIconIndex > -1) And
(m_bShowCaptionInToolbar) Then
skipBackground = True
drawBorder = False
eStyle = IIf(bHotText, eIconHighlighted, eIconNonHighlighted)
End If
End If
End If
hasSplitGlyph = (m_eStyle = eSplit) Or ((m_lPtrBar <> 0) And
(m_bShowDropDownInToolbar))
If (hasSplitGlyph) Then
If ((cDP.Orientation = eLeft) Or (cDP.Orientation = eRight)) And Not
(m_eStyle = eSplit) Then
tSplitRect.left = cDP.left + 1
tSplitRect.top = cDP.top + 1 + cDP.Height - 2 - m_lSplitWidth
tSplitRect.right = tSplitRect.left + cDP.Size - 2
tSplitRect.bottom = tSplitRect.top + m_lSplitWidth
Else
If (cDP.RightToLeft) Then
tSplitRect.left = cDP.left + 1
tSplitRect.top = cDP.top + 1
tSplitRect.right = tSplitRect.left + m_lSplitWidth
tSplitRect.bottom = tSplitRect.top + cDP.Height - 2
Else
tSplitRect.left = cDP.left + 1 + cDP.Size - 2 - m_lSplitWidth
tSplitRect.top = cDP.top + 1
tSplitRect.right = tSplitRect.left + m_lSplitWidth
tSplitRect.bottom = tSplitRect.top + cDP.Height - 2
End If
End If
End If
If (mCommandBarColours.Style = eComCtl32) Then
If (m_eStyle = eSplit) Then
UtilDrawSystemStyleButton _
cDP.hWnd, cDP.hdc, _
cDP.left, cDP.top, cDP.Size - m_lSplitWidth, cDP.Height, _
cDP.Enabled, (cDP.MouseOverButton Or cDP.MouseOverSplit Or
cDP.ShowingMenu), _
m_eStyle, False, cDP.Orientation, m_bChecked, ((cDP.MouseDownButton
And cDP.MouseOverButton))
UtilDrawSystemStyleButton _
cDP.hWnd, cDP.hdc, _
cDP.left + cDP.Size - m_lSplitWidth, cDP.top, m_lSplitWidth,
cDP.Height, _
cDP.Enabled, (cDP.MouseOverButton Or cDP.ShowingMenu Or
cDP.MouseOverSplit), _
m_eStyle, True, cDP.Orientation, m_bChecked, ((cDP.MouseDownButton
And cDP.MouseOverButton) Or (cDP.MouseDownSplit And
cDP.MouseDownSplit) Or cDP.ShowingMenu)
Else
UtilDrawSystemStyleButton _
cDP.hWnd, cDP.hdc, _
cDP.left, cDP.top, cDP.Size, cDP.Height, _
cDP.Enabled, (cDP.MouseOverButton Or cDP.ShowingMenu), _
m_eStyle, False, cDP.Orientation, m_bChecked, ((cDP.MouseDownButton
And cDP.MouseOverButton) Or cDP.ShowingMenu)
End If
Else
If Not skipBackground Then
lBackWidth = cDP.Size - 2
lBackHeight = cDP.Height - 2
UtilDrawBackground _
cDP.hdc, _
startColor, endColor, _
cDP.left + 1, cDP.top + 1, lBackWidth, lBackHeight
End If
If (drawBorder) Then
If (m_eStyle = eSplit And drawSplitBorder) Then
UtilDrawBorderRectangle _
cDP.hdc, IIf(cDP.ShowingMenu, MenuBorderColor,
MenuHotBorderColor), _
cDP.left + 1, cDP.top + 1, cDP.Size - 2, cDP.Height - 2,
((cDP.MouseDownButton And cDP.MouseOverButton) Or
cDP.ShowingMenu) Or m_bChecked
UtilDrawBorderRectangle _
cDP.hdc, MenuHotBorderColor, _
tSplitRect.left, tSplitRect.top, _
tSplitRect.right - tSplitRect.left, tSplitRect.bottom -
tSplitRect.top, (cDP.MouseDownSplit And cDP.MouseOverSplit)
Else
UtilDrawBorderRectangle _
cDP.hdc, IIf(cDP.ShowingMenu, MenuBorderColor,
MenuHotBorderColor), _
cDP.left + 1, cDP.top + 1, cDP.Size - 2, cDP.Height - 2,
(cDP.MouseDownButton And cDP.MouseDownButton) Or m_bChecked
End If
End If
If hotSplit Then
UtilDrawBackground _
cDP.hdc, _
ButtonHotBackgroundColorStart, _
ButtonHotBackgroundColorEnd, _
tSplitRect.left + 1, _
tSplitRect.top + 1, _
tSplitRect.right - tSplitRect.left - 2, _
tSplitRect.bottom - tSplitRect.top - 2
End If
End If
If (m_eStyle = eSeparator) Then
Dim lSepX As Long
Dim lSepY As Long
Dim lSepHeight As Long
Dim lSepWidth As Long
If (cDP.Orientation = eLeft) Or (cDP.Orientation = eRight) Then
lSepY = cDP.top + (cDP.Height - 2) \ 2
lSepX = cDP.left + m_lBorderSize
lSepWidth = cDP.Size - m_lBorderSize * 2
lSepHeight = 2
Else
lSepX = cDP.left + (cDP.Size - 2) \ 2
lSepY = cDP.top + m_lBorderSize
lSepHeight = cDP.Height - m_lBorderSize * 2
lSepWidth = 2
End If
If (mCommandBarColours.Style = eComCtl32) Then
UtilDrawSystemStyleButton m_hWnd, cDP.hdc, _
lSepX, lSepY, lSepWidth, lSepHeight, _
False, False, eSeparator, False, _
cDP.Orientation, False, False
Else
hPen = CreatePen(PS_SOLID, 1, DarkColor)
hPenOld = SelectObject(cDP.hdc, hPen)
MoveToEx cDP.hdc, lSepX, lSepY, tJ
If (cDP.Orientation = eLeft) Or (cDP.Orientation = eRight) Then
LineTo cDP.hdc, lSepX + lSepWidth, lSepY
Else
LineTo cDP.hdc, lSepX, lSepY + lSepHeight
End If
SelectObject cDP.hdc, hPenOld
DeleteObject hPen
hPen = CreatePen(PS_SOLID, 1, LightColor)
hPenOld = SelectObject(cDP.hdc, hPen)
MoveToEx cDP.hdc, lSepX + 1, lSepY + 1, tJ
If (cDP.Orientation = eLeft) Or (cDP.Orientation = eRight) Then
LineTo cDP.hdc, lSepX + 1 + lSepWidth, lSepY + 1
Else
LineTo cDP.hdc, lSepX + 1, lSepY + lSepHeight + 1
End If
SelectObject cDP.hdc, hPenOld
DeleteObject hPen
End If
ElseIf ((m_eStyle = ePanel) And (cDP.Orientation = eBottom Or
cDP.Orientation = eTop)) Then
' Ensure the contained control is at the right point
If Not (m_lPtrPanelControl = 0) Then
On Error Resume Next
Dim ctl As Object
Set ctl = ObjectFromPtr(m_lPtrPanelControl)
If Not (ctl.Visible) Then
ctl.Visible = (m_bVisible And Not (cDP.Hidden))
End If
Dim lPanelTop As Long
If (cDP.ButtonPosition = eButtonTextBottom) Then
lPanelTop = cDP.top * Screen.TwipsPerPixelY + (cDP.ToolbarSize *
Screen.TwipsPerPixelY - ctl.Height) / 2
Else
lPanelTop = cDP.top * Screen.TwipsPerPixelY + (cDP.Height *
Screen.TwipsPerPixelY - ctl.Height) / 2
End If
ctl.Move (cDP.left + 1) * Screen.TwipsPerPixelX, lPanelTop, (cDP.Size
- 2) * Screen.TwipsPerPixelX ', cDP.height
On Error GoTo 0
Else
bDefaultDraw = True
End If
Else
bDefaultDraw = True
End If
If (bDefaultDraw) Then
' Draw the icon:
Dim lIconX As Long
Dim lIconY As Long
Dim lIconWidth As Long
If (m_iIconIndex > -1) Or Not (m_oColour = CLR_NONE) Then
If (cDP.Orientation = eLeft) Or (cDP.Orientation = eRight) Then
lIconY = cDP.top + m_lBorderSize
If (m_eStyle = eSplit) Then
lIconX = cDP.left + m_lBorderSize
Else
lIconX = cDP.left + (cDP.Size - cDP.ImageList.IconWidth) \ 2
End If
lIconWidth = cDP.ImageList.IconHeight
Else
If (cDP.ButtonPosition = eButtonTextBottom) And Not (m_bLocked) Then
lIconX = cDP.left + (cDP.Size - cDP.ImageList.IconWidth) \ 2
lIconY = cDP.top + m_lBorderSize
Else
If (cDP.RightToLeft) Then
lIconX = cDP.left + cDP.Size - m_lBorderSize -
cDP.ImageList.IconWidth
Else
lIconX = cDP.left + m_lBorderSize
End If
lIconY = cDP.top + (cDP.Height - cDP.ImageList.IconHeight) \ 2
End If
lIconWidth = cDP.ImageList.IconWidth
End If
If (mCommandBarColours.Style = eComCtl32) Then
If cDP.Enabled And (((cDP.MouseDownButton And cDP.MouseOverButton))
Or m_bChecked Or cDP.ShowingMenu) Then
lIconX = lIconX + 1
lIconY = lIconY + 1
End If
End If
UtilDrawIcon cDP.hdc, cDP.ImageList, _
m_iIconIndex, m_oColour, lIconX, lIconY, _
IIf(cDP.Enabled, eStyle, eIconDIsabled)
Else
If (cDP.RightToLeft) Then
lIconX = cDP.left + cDP.Size - m_lBorderSize
Else
lIconX = cDP.left + m_lBorderSize
End If
lIconWidth = 0
End If
' Draw the text, if desired:
If (m_bShowCaptionInToolbar) Then
Dim lTextX As Long
Dim lTextY As Long
Dim lTextWidth As Long
Dim lTextHeight
If (cDP.Enabled) Or (m_bLocked) Then
If (bHotText) And Not (m_bLocked) Then
lTextColor = ButtonTextHotColor
Else
lTextColor = ButtonTextColor
End If
If (mCommandBarColours.Style = eComCtl32) And (IsXp) Then ' TODO
find a way to remove this hack
If (cDP.MouseDownButton And cDP.MouseOverButton) Then
lTextColor = TranslateColor(vb3DHighlight)
End If
End If
Else
lTextColor = ButtonTextDisabledColor
End If
If (cDP.Orientation = eLeft) Or (cDP.Orientation = eRight) Then
lTextX = cDP.left + m_lBorderSize
lTextY = cDP.top + lIconWidth + 2 + m_lBorderSize
lTextWidth = cDP.Size - m_lBorderSize * 2
lTextHeight = cDP.Height
Else
If (cDP.ButtonPosition = eButtonTextBottom) Then
If (m_eStyle = ePanel And m_iIconIndex < 0) Then
lTextX = cDP.left + 6
lTextY = cDP.top + m_lBorderSize
lTextWidth = cDP.Size - 12
lTextHeight = cDP.ToolbarSize - lTextY - m_lBorderSize
Else
lTextX = cDP.left + 6
lTextWidth = cDP.Size - 12
lTextY = cDP.top + cDP.ImageList.IconHeight + m_lBorderSize +
2
lTextHeight = cDP.Height - lTextY
End If
Else
If (cDP.RightToLeft) Then
lTextX = cDP.left + m_lBorderSize + 2
If (m_eStyle = eSplit) Then
lTextX = lTextX + m_lSplitWidth + 2
End If
Else
lTextX = lIconX + lIconWidth + 2
If (lIconWidth > 0) Then
lTextX = lTextX + 2
End If
End If
lTextY = m_lBorderSize + cDP.top
lTextHeight = cDP.Height - m_lBorderSize * 2
lTextWidth = cDP.Size - lIconWidth - m_lBorderSize * 2 - 2
If (lIconWidth > 0) Then
lTextWidth = lTextWidth - 2
End If
End If
End If
hFontOld = SelectObject(cDP.hdc, cDP.hFont)
UtilDrawText cDP.hdc, m_sCaption, _
lTextX, lTextY, lTextWidth, lTextHeight, _
cDP.Enabled, lTextColor, cDP.Orientation, (cDP.ButtonPosition =
eButtonTextBottom And Not (m_bLocked))
SelectObject cDP.hdc, hFontOld
End If
' If it's a split, or we should draw the dropdown, draw the glyph:
If (hasSplitGlyph) Then
Dim lGlyphColor As Long
If (cDP.Enabled) Then
lGlyphColor = ButtonTextColor
Else
lGlyphColor = ButtonTextDisabledColor
End If
UtilDrawSplitGlyph cDP.hdc, _
tSplitRect.left, tSplitRect.top, _
tSplitRect.right - tSplitRect.left, tSplitRect.bottom -
tSplitRect.top, _
cDP.Enabled, lGlyphColor, IIf(m_eStyle = eSplit, eTop,
cDP.Orientation)
End If
End If
'cDP.MouseOverButton = bMouseOver
'cDP.MouseOverSplit = bMouseOverSplit
cDP.Enabled = bEnabled
End Sub
Friend Sub Draw( _
cDP As cDrawButtonParams _
)
Dim bVisible As Boolean
bVisible = (m_bVisible And Not cDP.Hidden)
If Not (bVisible) Then
If (cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
bVisible = True
End If
End If
If bVisible Then
' We have the size of the item sorted,
' now a matter of drawing it in the
' specified space and style:
If (cDP.SizeStyle = COMMANDBARSIZESTYLEMENU) Or _
(cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
DrawMenuStyle cDP
Else
DrawButtonStyle cDP
End If
Else
If (m_eStyle = ePanel) Then
'
If Not (m_lPtrPanelControl = 0) Then
On Error Resume Next
Dim ctl As Object
Set ctl = ObjectFromPtr(m_lPtrPanelControl)
If (ctl.Visible) Then
ctl.Visible = False
End If
End If
End If
End If
End Sub
Private Function GetMenuSize( _
cSP As cMeasureButtonParams _
) As Long
Dim lSize As Long
Dim hFontOld As Long
Dim tR As RECT
Dim sText As String
If (Me.Style = eSeparator) Then
cSP.Height = 3
Else
If (IconIndex > -1) Or Not (m_oColour = CLR_NONE) Then
If (cSP.Orientation = eLeft Or cSP.Orientation = eRight) Then
lSize = lSize + cSP.IconWidth
Else
lSize = lSize + cSP.IconHeight
End If
End If
hFontOld = SelectObject(cSP.hdc, cSP.hFont)
If (cSP.Height = 0) Then
tR.right = 256
tR.bottom = 256
DrawText cSP.hdc, "Xy", -1, tR, DT_CALCRECT Or DT_LEFT Or DT_SINGLELINE
If (tR.bottom - tR.top < cSP.IconHeight) Then
cSP.Height = cSP.IconHeight
Else
cSP.Height = tR.bottom - tR.top
End If
cSP.Height = cSP.Height + m_lBorderSize * 2
End If
If (Len(m_sCaption) > 0) Then
' Need to consider the width of the text
' and the width of the shortcut text:
sText = m_sCaption & " " & ShortcutText
tR.bottom = cSP.Height
DrawText cSP.hdc, sText, -1, tR, DT_CALCRECT Or DT_LEFT Or
DT_SINGLELINE
lSize = lSize + tR.right - tR.left
End If
SelectObject cSP.hdc, hFontOld
End If
' All menu items have a space for the sub-menu
' glyph regardless of whether they need it or
' not:
If (Len(m_sCaption) > 0) Then
lSize = lSize + m_lMenuGlyphWidth
' Various size parts for the icon border and the space between
' the icon and the text:
lSize = lSize + 32
If (cSP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
' add an extra icon spacing for the visible check
' box:
lSize = lSize + cSP.IconWidth + 2
End If
Else
lSize = lSize + 10
End If
GetMenuSize = lSize
End Function
Private Function GetButtonSize( _
cSP As cMeasureButtonParams, _
ByVal bHidden As Boolean _
) As Long
Dim lSize As Long
Dim lHeight As Long
Dim hFontOld As Long
Dim tR As RECT
Dim sText As String
Dim bDefaultSize As Boolean
If (m_bVisible And Not bHidden) Then
' first, generically there is a border for all buttons
lSize = m_lBorderSize * 2
If (m_eStyle = eSeparator) Then
' nothing more to do
ElseIf (m_eStyle = ePanel) Then
If Not (m_lPtrPanelControl = 0) Then
If (cSP.Orientation = eBottom Or cSP.Orientation = eTop) Then
lSize = lSize + m_lPanelWidth
Else
lSize = 0 ' TODO consider whether to allow showing icon/text
when aligned vertically
End If
Else
bDefaultSize = True
End If
Else
bDefaultSize = True
End If
If (bDefaultSize) Then
If (m_iIconIndex > -1) Or Not (m_oColour = CLR_NONE) Then
If (cSP.Orientation = eLeft Or cSP.Orientation = eRight) Then
lSize = lSize + cSP.IconWidth
Else
lSize = lSize + cSP.IconHeight
End If
End If
hFontOld = SelectObject(cSP.hdc, cSP.hFont)
tR.right = 256
tR.bottom = 256
DrawText cSP.hdc, "Xy", -1, tR, DT_CALCRECT Or DT_LEFT Or DT_SINGLELINE
If (cSP.ButtonPosition = eButtonTextBottom) And _
m_bShowCaptionInToolbar And Len(m_sCaption) > 0 _
And Not (m_eStyle = ePanel) Then ' panels have their text centred
lHeight = lSize + (tR.bottom - tR.top) + 4 ' Height for one item
Else
If (tR.bottom - tR.top < lSize) Then
lHeight = lSize
Else
lHeight = tR.bottom - tR.top + m_lBorderSize * 2
End If
End If
If (m_eStyle = eSplit) And (cSP.Orientation = eLeft Or cSP.Orientation
= eRight) Then
' Add some size for the split:
lHeight = lHeight + m_lSplitWidth
End If
cSP.Height = lHeight
tR.bottom = cSP.Height
If (m_bShowCaptionInToolbar) Then
' We need to consider the size of the text too
DrawText cSP.hdc, m_sCaption, -1, tR, DT_CALCRECT Or DT_LEFT
If (cSP.ButtonPosition = eButtonTextBottom) And Not (m_eStyle =
ePanel) Then
If (tR.right - tR.left + 12 > lSize) Then
lSize = tR.right - tR.left + 12
End If
Else
lSize = lSize + tR.right - tR.left + 4
End If
End If
SelectObject cSP.hdc, hFontOld
If (m_eStyle = eSplit) And Not (cSP.Orientation = eLeft Or
cSP.Orientation = eRight) Then
' We need to add some size for the drop down thingy
lSize = lSize + m_lSplitWidth
ElseIf ((m_lPtrBar <> 0) And (m_bShowDropDownInToolbar)) Then
lSize = lSize + m_lSplitWidth - 4
End If
End If
End If
GetButtonSize = lSize
End Function
Friend Function Size( _
cSP As cMeasureButtonParams, _
ByVal bHidden As Boolean _
) As Long
Dim iIdx As Long
Dim lSize As Long
Dim lHeight As Long
'
'iIdx = CachedSizeIndex(cSP)
If iIdx = 0 Then
'Debug.Print "No cached version found", m_iSizeCacheCount
If (m_bVisible And Not (bHidden)) Or (cSP.SizeStyle =
COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
' time for measurement:
If (cSP.SizeStyle = COMMANDBARSIZESTYLEMENU) Or (cSP.SizeStyle =
COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
lSize = GetMenuSize(cSP)
ElseIf (cSP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR) Or (cSP.SizeStyle
= COMMANDBARSIZESTYLETOOLBARWRAPPABLE) Or (cSP.SizeStyle =
COMMANDBARSIZESTYLETOOLBARMENU) Then
lSize = GetButtonSize(cSP, bHidden)
Else
Debug.Assert "What?" = ""
End If
End If
' Now we have a size we can cache it
'm_iSizeCacheCount = m_iSizeCacheCount + 1
'ReDim Preserve m_cCacheSize(1 To m_iSizeCacheCount) As
cMeasureButtonParams
'Set m_cCacheSize(m_iSizeCacheCount) = New cMeasureButtonParams
'm_cCacheSize(m_iSizeCacheCount).FromMeasureButtonParams cSP
'm_cCacheSize(m_iSizeCacheCount).Size = lSize
'iIdx = m_iSizeCacheCount
Size = lSize
'
Else
Debug.Print "Cached version found at ", iIdx
End If
'Size = m_cCacheSize(iIdx).Size
'
End Function
Private Function CachedSizeIndex( _
cSP As cMeasureButtonParams _
)
Dim i As Long
For i = 1 To m_iSizeCacheCount
If cSP.CompareTo(m_cCacheSize(i)) = 0 Then
CachedSizeIndex = i
Exit For
End If
Next i
End Function
Friend Sub Dispose()
m_lPtrPanelControl = 0
m_lPtrBar = 0
Set m_ptrBars = New Collection
End Sub
Friend Function AltKeyMatches(ByVal vKey As Integer) As Boolean
Dim iPos As Long
Dim sChar As String
Dim iKeyCode As Integer
Dim b() As Byte
iPos = InStr(Caption, "&")
' TODO maybe should check for &&, probably won't happen though
If (iPos > 0) Then
sChar = Mid(Caption, iPos + 1, 1)
If IsNt Then
b = sChar
CopyMemory iKeyCode, b(0), 2
iKeyCode = VkKeyScanW(iKeyCode)
iKeyCode = iKeyCode And &HFF&
Else
b = StrConv(sChar, vbFromUnicode)
iKeyCode = VkKeyScan(b(0)) And &HFF&
End If
AltKeyMatches = (vKey = iKeyCode)
End If
End Function
Friend Function AcceleratorMatches( _
ByVal hWndActiveForm As Long, _
ByVal vKey As Integer, _
ByVal shiftMask As Long, _
ByVal bRecurse As Boolean, _
ctlNotify As vbalCommandBar _
) As cButtonInt
'
If (m_bEnabled) Then
Dim bContinue As Boolean
Dim hWndCtl As Long
If Not (bRecurse) Then
bContinue = CollectionContains(m_colHandles, "H" & hWndActiveForm)
If (bContinue) Then
hWndCtl = m_colHandles.Item("H" & hWndActiveForm)
ControlFromhWnd hWndCtl, ctlNotify
End If
Else
bContinue = True
End If
If (bContinue) Then
If (m_vShortcutKey = vKey) And (m_eShortcutModifiers = shiftMask) Then
Set AcceleratorMatches = Me
' Which control to notify?
Else
' recursively check all of the sub items:
Dim cmdBar As cCommandBarInt
If Not (m_lPtrBar = 0) Then
Set cmdBar = ObjectFromPtr(m_lPtrBar)
Set AcceleratorMatches = cmdBar.AcceleratorMatches( _
hWndActiveForm, vKey, shiftMask, ctlNotify)
End If
End If
End If
End If
'
End Function
Private Function Remeasure()
m_iSizeCacheCount = 0
Erase m_cCacheSize
NotifyUsers CHANGENOTIFICATIONBUTTONSIZECHANGE
End Function
Private Sub Class_Initialize()
m_lPanelWidth = 16
m_lBorderSize = 4
m_lSplitWidth = 11
m_lMenuGlyphWidth = 20
Set m_ptrBars = New Collection
m_bEnabled = True
m_bVisible = True
m_iIconIndex = -1
m_oColour = CLR_NONE
m_eStyle = eNormal
m_eVisibleCheck = OLE_TRISTATE.Gray
Set m_colHandles = New Collection
End Sub
|
|