vbAccelerator - Contents of code file: cSimpleSheetBar.cls

  MultiUse = -1  'True
Attribute VB_Name = "cSimpleSheetBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' rect
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

' Text functions:
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As
 Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal
 wFormat As Long) As Long
    Private Const DT_BOTTOM = &H8
    Private Const DT_CENTER = &H1
    Private Const DT_LEFT = &H0
    Private Const DT_CALCRECT = &H400
    Private Const DT_WORDBREAK = &H10
    Private Const DT_VCENTER = &H4
    Private Const DT_TOP = &H0
    Private Const DT_TABSTOP = &H80
    Private Const DT_SINGLELINE = &H20
    Private Const DT_RIGHT = &H2
    Private Const DT_NOCLIP = &H100
    Private Const DT_INTERNAL = &H1000
    Private Const DT_EXTERNALLEADING = &H200
    Private Const DT_EXPANDTABS = &H40
    Private Const DT_CHARSTREAM = 4
    Private Const DT_NOPREFIX = &H800
    Private Const DT_EDITCONTROL = &H2000&
    Private Const DT_PATH_ELLIPSIS = &H4000&
    Private Const DT_END_ELLIPSIS = &H8000&
    Private Const DT_MODIFYSTRING = &H10000
    Private Const DT_RTLREADING = &H20000
    Private Const DT_WORD_ELLIPSIS = &H40000
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal
 xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long,
 ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw
 As Long, ByVal diFlags As Long) As Long

Private WithEvents m_cMT As cMouseTrack
Attribute m_cMT.VB_VarHelpID = -1

Private Type tSheet
   sText As String
   hIcon As Long
End Type
Private m_tSheet() As tSheet
Private m_iCount As Long

Private m_iButtonHeight As Long

Private m_picThis As PictureBox

Private m_bButtonDown As Boolean
Private m_iButtonDownOn As Long
Private m_iButtonOver As Long

Public Event Click(ByVal iButton As Long)

Public Sub Create(picThis As PictureBox, ByVal lHeight As Long)
   Set m_cMT = New cMouseTrack
   m_cMT.AttachMouseTracking picThis
   Set m_picThis = picThis
   m_iButtonHeight = lHeight
End Sub
Public Sub Destroy()
   If Not m_cMT Is Nothing Then
   End If
   Set m_picThis = Nothing
End Sub

Public Sub Add(ByVal sText As String, ByVal hIcon As Long)
   m_iCount = m_iCount + 1
   ReDim Preserve m_tSheet(1 To m_iCount) As tSheet
   With m_tSheet(m_iCount)
      .sText = sText
      .hIcon = hIcon
   End With
End Sub

Private Sub m_cMT_MouseHover(Button As MouseButtonConstants, Shift As
 ShiftConstants, x As Single, y As Single)
End Sub

Private Sub m_cMT_MouseLeave()
   If m_iButtonOver > -1 Then
      pDrawButtonBorder m_iButtonOver, False, False
      m_iButtonOver = -1
   End If
End Sub

Public Sub MouseDown(Button As Integer, Shift As Integer, x As Single, y As
   m_bButtonDown = True
   m_iButtonDownOn = pInButton(x, y)
   MouseMove Button, Shift, x, y
   If m_iButtonDownOn > 0 Then
      pDrawButtonBorder m_iButtonDownOn, True, True
   End If
End Sub

Public Sub MouseMove(Button As Integer, Shift As Integer, x As Single, y As

Dim iButton As Integer
   If Not m_bButtonDown Then
      If Not m_cMT.Tracking Then
      End If
      iButton = pInButton(x, y)
      If iButton <> m_iButtonOver Then
         If m_iButtonOver > 0 Then
            pDrawButtonBorder m_iButtonOver, False, False
         End If
         If iButton > 0 Then
            pDrawButtonBorder iButton, True, False
         End If
         m_iButtonOver = iButton
      End If
      iButton = pInButton(x, y)
      If m_iButtonDownOn <> iButton Then
         m_iButtonOver = iButton
         If m_iButtonDownOn = m_iButtonOver Then
            pDrawButtonBorder m_iButtonOver, True, True
            pDrawButtonBorder m_iButtonOver, False, False
         End If
      End If
   End If

End Sub

Public Sub MouseUp(Button As Integer, Shift As Integer, x As Single, y As
Dim iButton As Long
   iButton = pInButton(x, y)
   If iButton = m_iButtonDownOn Then
      RaiseEvent Click(iButton)
      pDrawButtonBorder m_iButtonDownOn, False, False
   End If
   m_iButtonDownOn = -1
   m_iButtonOver = -1
   m_bButtonDown = False
End Sub

Private Sub pDrawButtonBorder(ByVal iButton As Long, ByVal bState As Boolean,
 ByVal bPressed As Boolean)
Dim lL As Long, lT As Long
Dim lR As Long, lB As Long
   lL = 0
   lT = m_iButtonHeight * (iButton - 1)
   lR = m_picThis.ScaleWidth - Screen.TwipsPerPixelX
   lB = lT + m_iButtonHeight - Screen.TwipsPerPixelY
   If bState Then
      If bPressed Then
         m_picThis.Line (lL, lT)-(lR, lT), &H0&
         m_picThis.Line -(lR, lB), vb3DHighlight
         m_picThis.Line -(lL, lB), vb3DHighlight
         m_picThis.Line -(lL, lT), &H0&
         m_picThis.Line (lL, lT)-(lR, lT), vb3DHighlight
         m_picThis.Line -(lR, lB), &H0&
         m_picThis.Line -(lL, lB), &H0&
         m_picThis.Line -(lL, lT), vb3DHighlight
      End If
      m_picThis.Line (lL, lT)-(lR, lB), m_picThis.BackColor, B
   End If
End Sub

Private Function pInButton(x As Single, y As Single)
Dim i As Long
Dim lT As Long
   pInButton = -1
   For i = 1 To m_iCount
      If x >= 0 And x <= m_picThis.ScaleWidth Then
         If y >= lT And y < lT + m_iButtonHeight Then
            pInButton = i
            Exit Function
            lT = lT + m_iButtonHeight
         End If
      End If
   Next i
End Function

Public Sub Paint()
Dim iButton As Long
Dim tR As RECT
Dim lhDC As Long
   lhDC = m_picThis.hdc
   For iButton = 1 To m_iCount
      tR.Left = 0
      tR.Top = (m_iButtonHeight * (iButton - 1)) \ Screen.TwipsPerPixelX
      tR.Right = (m_picThis.ScaleWidth \ Screen.TwipsPerPixelX) - 1
      tR.Bottom = tR.Top + (m_iButtonHeight \ Screen.TwipsPerPixelY) - 1
      DrawIconEx lhDC, tR.Left + (tR.Right - tR.Left - 32) \ 2, tR.Top + 2,
       m_tSheet(iButton).hIcon, 32, 32, 0, 0, &H3&
      tR.Top = tR.Top + 26
      DrawText lhDC, m_tSheet(iButton).sText, -1, tR, DT_CENTER Or DT_VCENTER
   Next iButton
End Sub