vbAccelerator - Contents of code file: cButtonInt.cls
VERSION 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 = True
Option Explicit
' 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_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_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_sShortcutKey As String
Private m_eShortcutModifiers As ShiftConstants
Private m_lPtrBar As Long
Private m_hWnd As Long
Private m_cCacheSize() As cMeasureButtonParams
Private m_iSizeCacheCount As Long
' Owning bar collection:
Private m_ptrBars As Collection
Friend Sub Dump(ByVal indent As Long)
Dim vlPtr As Variant
Dim barInt As cCommandBarInt
Debug.Print Space$(indent) & m_sKey & " (" & m_sCaption & ") :Button"
For Each vlPtr In m_ptrBars
Set barInt = ObjectFromPtr(vlPtr)
If Not (barInt Is Nothing) Then
Debug.Print Space$(indent + 1) & "[Owner: " & barInt.Key & "," &
barInt.Title & "]"
End If
Next
If (m_lPtrBar <> 0) Then
Set barInt = ObjectFromPtr(m_lPtrBar)
If Not (barInt Is Nothing) Then
barInt.Dump indent + 1
End If
End If
End Sub
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( _
Orientation As ECommandBarOrientation _
) As Boolean
Dim bCanAction As Boolean
bCanAction = m_bEnabled And m_bVisible And (m_eStyle <> eSeparator)
If (bCanAction) Then
If (m_eStyle = ePanel) Then
If (Orientation = eLeft Or Orientation = eRight) Then
bCanAction = (m_iIconIndex <> -1)
Else
bCanAction = False
End If
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 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 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 String
ShortcutKey = m_sShortcutKey
End Property
Friend Property Let ShortcutKey(ByVal sShortcutKey As String)
m_sShortcutKey = sShortcutKey
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 (m_lPtrBar <> 0) Then
Set Bar = ObjectFromPtr(m_lPtrBar)
End If
End Property
Friend Function SetBar(cmdBar As cCommandBarInt)
If (cmdBar Is Nothing) Then
m_lPtrBar = 0
Else
m_lPtrBar = ObjPtr(cmdBar)
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
If Len(m_sShortcutKey) > 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
sShortcut = sShortcut & m_sShortcutKey
End If
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)
' 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.IconWidth
End If
If (cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
If (cDP.RightToLeft) Then
'lTextXStart = lTextXStart - cDP.IconWidth - 6
Else
lTextXStart = lTextXStart + cDP.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.IconWidth - 4 -
cDP.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.MouseOverButton) Then
' Fill the highlight rectangle:
UtilDrawBackground cDP.hDC, _
MenuHotBackgroundColorStart, MenuHotBackgroundColorEnd, _
cDP.left + 2, cDP.top + 1, cDP.Size - 4, cDP.Height - 1
UtilDrawBorderRectangle cDP.hDC, _
cDP.left + 2, cDP.top + 1, cDP.Size - 4, cDP.Height - 1
checkColorStart = MenuCheckedHotBackgroundColorStart
checkColorEnd = MenuCheckedHotBackgroundColorEnd
End If
' Checked?
If (m_bChecked) Then
If (cDP.RightToLeft) Then
UtilDrawBackground cDP.hDC, _
checkColorStart, checkColorEnd, _
cDP.left + cDP.Size - 4 - cDP.IconWidth - 4, cDP.top + 2,
cDP.IconWidth + 5, cDP.IconHeight + 5
UtilDrawBorderRectangle cDP.hDC, _
cDP.left + cDP.Size - 4 - cDP.IconWidth - 4, cDP.top + 2,
cDP.IconWidth + 5, cDP.IconHeight + 5
Else
UtilDrawBackground cDP.hDC, _
checkColorStart, checkColorEnd, _
cDP.left + 3, cDP.top + 2, cDP.IconWidth + 5, cDP.IconHeight + 5
UtilDrawBorderRectangle cDP.hDC, _
cDP.left + 3, cDP.top + 2, cDP.IconWidth + 5, cDP.IconHeight + 5
End If
End If
' Icon:
If (m_iIconIndex <> -1) Then
If (cDP.RightToLeft) Then
UtilDrawIcon cDP.hDC, cDP.hIml, cDP.ptrVB6Iml, m_iIconIndex, _
cDP.left + cDP.Size - 4 - cDP.IconWidth - 4 + 2, cDP.top +
(cDP.Height - cDP.IconHeight) \ 2, m_bEnabled
Else
UtilDrawIcon cDP.hDC, cDP.hIml, cDP.ptrVB6Iml, m_iIconIndex, _
cDP.left + 5, cDP.top + (cDP.Height - cDP.IconHeight) \ 2,
m_bEnabled
End If
Else
If (m_bChecked) Then
If (cDP.RightToLeft) Then
' Draw the check glyph
UtilDrawCheckGlyph cDP.hDC, _
cDP.left + cDP.Size - 4 - cDP.IconWidth - 4 + 2, cDP.top +
(cDP.Height - cDP.IconHeight) \ 2, _
cDP.IconWidth, cDP.IconHeight, _
m_bEnabled, &H0
Else
' Draw the check glyph
UtilDrawCheckGlyph cDP.hDC, _
cDP.left + 5, cDP.top + (cDP.Height - cDP.IconHeight) \ 2, _
cDP.IconWidth, cDP.IconHeight, _
m_bEnabled, &H0
End If
End If
End If
' Text
Dim lTextColor As Long
If (m_bEnabled) Then
If (cDP.MouseOverButton) 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
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
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 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
bEnabled = cDP.Enabled
cDP.Enabled = (m_bEnabled And cDP.Enabled)
' Backgrounds:
If (cDP.Enabled) Then
If (m_eStyle = eSplit) Then
If (cDP.mouseDownSplit And cDP.mouseOverSplit) Then
drawBorder = True
startColor = GradientColorStart
endColor = GradientColorEnd
ElseIf (cDP.mouseOverSplit) Or (cDP.MouseOverButton) Then
drawBorder = True
drawSplitBorder = True
If (cDP.MouseDownButton) Then
' Draw hot down background:
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
' Overdraw the split with the hot up color:
hotSplit = True
Else
' Background hot for both:
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
End If
ElseIf (cDP.MouseDownButton) Then
drawBorder = True
drawSplitBorder = True
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
Else
startColor = ButtonBackgroundColorStart
endColor = ButtonBackgroundColorEnd
End If
Else
If (cDP.MouseOverButton) Then
drawBorder = True
If (cDP.MouseDownButton) Then
If (m_lPtrBar = 0) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
Else
startColor = GradientColorStart
endColor = GradientColorEnd
End If
Else
If (m_bChecked) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
Else
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
End If
End If
ElseIf (cDP.MouseDownButton) Then
drawBorder = True
If (m_bChecked) Then
startColor = ButtonCheckedHotBackgroundColorStart
endColor = ButtonCheckedHotBackgroundColorEnd
Else
startColor = ButtonHotBackgroundColorStart
endColor = ButtonHotBackgroundColorEnd
End If
Else
If (m_bChecked) Then
drawBorder = True
startColor = ButtonCheckedBackgroundColorStart
endColor = ButtonCheckedBackgroundColorEnd
Else
startColor = ButtonBackgroundColorStart
endColor = ButtonBackgroundColorEnd
End If
End If
End If
Else
skipBackground = True
'startColor = ButtonBackgroundColorStart
'endColor = ButtonBackgroundColorEnd
End If
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
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 (drawBorder) Then
UtilDrawBorderRectangle _
cDP.hDC, cDP.left + 1, cDP.top + 1, cDP.Size - 2, cDP.Height - 2
If (m_eStyle = eSplit) Then
If (drawSplitBorder) Then
UtilDrawBorderRectangle _
cDP.hDC, _
tSplitRect.left, tSplitRect.top, _
tSplitRect.right - tSplitRect.left, tSplitRect.bottom -
tSplitRect.top
End If
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
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
Else
lSepX = cDP.left + (cDP.Size - 2) \ 2
lSepY = cDP.top + m_lBorderSize
lSepHeight = cDP.Height - m_lBorderSize * 2
End If
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
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 = True
End If
Dim lPanelTop As Long
lPanelTop = cDP.top * Screen.TwipsPerPixelY + (cDP.Height *
Screen.TwipsPerPixelY - ctl.Height) / 2
ctl.Move (cDP.left + 1) * Screen.TwipsPerPixelX, lPanelTop, (cDP.Size
- 2) * Screen.TwipsPerPixelX ', cDP.height
On Error GoTo 0
End If
Else
' Draw the icon:
Dim lIconX As Long
Dim lIconY As Long
Dim lIconWIdth As Long
If (m_iIconIndex <> -1) 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.IconWidth) \ 2
End If
lIconWIdth = cDP.IconHeight
Else
If (cDP.RightToLeft) Then
lIconX = cDP.left + cDP.Size - m_lBorderSize - cDP.IconWidth
Else
lIconX = cDP.left + m_lBorderSize
End If
lIconY = cDP.top + (cDP.Height - cDP.IconHeight) \ 2
lIconWIdth = cDP.IconWidth
End If
UtilDrawIcon cDP.hDC, cDP.hIml, cDP.ptrVB6Iml, m_iIconIndex, lIconX,
lIconY, cDP.Enabled
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) Then
lTextColor = ButtonTextColor
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.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
lTextWidth = cDP.Size - lIconWIdth - m_lBorderSize * 2 - 2
If (lIconWIdth > 0) Then
lTextWidth = lTextWidth - 2
End If
lTextHeight = cDP.Height - m_lBorderSize * 2
lTextY = m_lBorderSize
End If
hFontOld = SelectObject(cDP.hDC, cDP.hFont)
UtilDrawText cDP.hDC, m_sCaption, _
lTextX, lTextY, lTextWidth, lTextHeight, _
cDP.Enabled, lTextColor, cDP.Orientation
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.Enabled = bEnabled
End Sub
Friend Sub Draw( _
cDP As cDrawButtonParams _
)
If (m_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 (Me.iconIndex > -1) Then
If (cSP.Orientation = eLeft Or cSP.Orientation = eRight) Then
lSize = lSize + cSP.IconWidth
Else
lSize = lSize + cSP.IconHeight
End If
End If
' Need to consider the width of the text
' and the width of the shortcut text:
sText = m_sCaption & " " & ShortcutText
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
tR.bottom = cSP.Height
DrawText cSP.hDC, m_sCaption, -1, tR, DT_CALCRECT Or DT_LEFT Or
DT_SINGLELINE
SelectObject cSP.hDC, hFontOld
lSize = lSize + tR.right - tR.left
If (Len(ShortcutText) > 0) Then
lSize = lSize + 32
End If
End If
' All menu items have a space for the sub-menu
' glyph regardless of whether they need it or
' not:
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
GetMenuSize = lSize
End Function
Private Function GetButtonSize( _
cSP As cMeasureButtonParams _
) As Long
Dim lSize As Long
Dim lHeight As Long
Dim hFontOld As Long
Dim tR As RECT
Dim sText As String
If (m_bVisible) 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) And (cSP.Orientation = eBottom Or
cSP.Orientation = eTop) Then
lSize = lSize + m_lPanelWidth
Else
If (m_iIconIndex <> -1) Then
If (cSP.Orientation = eLeft Or cSP.Orientation = eRight) Then
lSize = lSize + cSP.IconWidth
Else
lSize = lSize + cSP.IconHeight
End If
ElseIf (m_eStyle = ePanel) Then
GetButtonSize = 0
Exit Function
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 (tR.bottom - tR.top < cSP.IconHeight) Then
lHeight = cSP.IconHeight
Else
lHeight = tR.bottom - tR.top
End If
lHeight = lHeight + m_lBorderSize * 2
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
lSize = lSize + tR.right - tR.left + 4
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 Property Get Size( _
cSP As cMeasureButtonParams _
) As Long
Dim iIdx As Long
Dim lSize As Long
'
iIdx = CachedSizeIndex(cSP)
If iIdx = 0 Then
If (m_bVisible) Then ' invisible items aleways have width = 0
' time for measurement:
If (cSP.SizeStyle = COMMANDBARSIZESTYLEMENU) Or (cSP.SizeStyle =
COMMANDBARSIZESTYLEMENUVISIBLECHECK) Then
lSize = GetMenuSize(cSP)
ElseIf (cSP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR) Or (cSP.SizeStyle
= COMMANDBARSIZESTYLETOOLBARWRAPPABLE) Then
lSize = GetButtonSize(cSP)
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
'
End If
Size = m_cCacheSize(iIdx).Size
'
End Property
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
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_eStyle = eNormal
End Sub
|
|