vbAccelerator - Contents of code file: cFrame.ctl

VERSION 5.00
Begin VB.UserControl ActiveFrame 
   Alignable       =   -1  'True
   BackColor       =   &H80000005&
   CanGetFocus     =   0   'False
   ClientHeight    =   2010
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3645
   ControlContainer=   -1  'True
   ForwardFocus    =   -1  'True
   ScaleHeight     =   2010
   ScaleWidth      =   3645
   ToolboxBitmap   =   "cFrame.ctx":0000
   Begin VB.Timer tmrExit 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   2865
      Top             =   195
   End
End
Attribute VB_Name = "ActiveFrame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'
 ===============================================================================
===
' ActiveFrame Control
'
' Author:   Prasad Khan
' Date:     9 November 1999
'
' Provides an Explorer/IE style frame which you can align to any side of
' your main frame, with a built in toolbar.
'
' Submitted by Prasad Khan
' mailto:KPrasadKhan@hotmail.com
'
' Changes
' SPM    2 Jan 2000
'  * Modified button picture drawing - uses system caption instead
'  * CaptionMode allows control to auto-select system font & size,
'    same as Explorer
'  * CaptionVisible property, just use as a frame :)
'  * CaptionAlign property, align left/right/top/bottom or auto
'  * Set Pane property to child control; this control will then autosize
'    it for you
'  * Added ClipControls property for smoother resizing
'
'
 -------------------------------------------------------------------------------
---
' Featured at vbAccelerator,
' the site for free, advanced VB Source Code:
' http://vbaccelerator.com/
'
'
 ===============================================================================
===

Private Type POINTAPI
   x As Long
   y As Long
End Type
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As
 Long, ByVal y As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As
 Long, ByVal y As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect
 As RECT) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long)
 As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As
 RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As
 Long
'Draw text API constants & declaration
Private Type DRAWTEXTPARAMS
   cbSize As Long
   iTabLength As Long
   iLeftMargin As Long
   iRightMargin As Long
   uiLengthDrawn As Long
End Type
Private Const DT_BOTTOM = &H8
Private Const DT_CENTER = &H1
Private Const DT_SINGLELINE = &H20
Private Const DT_VCENTER = &H4
Private Const DT_CALCRECT = &H400
Private Const DT_END_ELLIPSIS = &H8000&
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 Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC
 As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As
 Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT,
 ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Const BDR_INNER = &HC
Private Const BDR_OUTER = &H3
Private Const BDR_RAISED = &H5
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKEN = &HA
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_SUNKENOUTER = &H2
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long,
 ByVal yPoint As Long) As Long

' Border flags
Private Const BF_LEFT As Long = &H1
Private Const BF_TOP As Long = &H2
Private Const BF_RIGHT As Long = &H4
Private Const BF_BOTTOM As Long = &H8
Private Const BF_RECT As Long = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Private Const BF_SOFT As Long = &H1000      ' For softer buttons

Private Const WM_PAINT = &HF
Private Const WM_DESTROY = &H2
Private Const WM_ERASEBKGND = &H14

Private Enum BStates
   vbFlat = 1
   vbRaised = 2
   vbSunken = 3
End Enum

'Default Property Values:
Private Const m_def_Caption = "Active Frame"
Private Const m_Border = 2
Private Const m_HdrSpace = 3

Public Enum ECAFCaptionModeConstants
   ecafSystem
   ecafUser
End Enum

'Property Variables:
Private m_sCaption As String
Private m_eCaptionAlign As AlignConstants
Private m_eActualCapAlign As AlignConstants
Private m_eCaptionMode As ECAFCaptionModeConstants
Private m_bCaptionVisible As Boolean
Private m_lTitleSize As Long

' Current button state:
Private m_State As BStates

'Variable for storing close button location
Private m_tCaption As RECT
Private m_tClient As RECT
Private m_tButton As RECT

' Variable for storing painting condition:
Private m_Painting As Boolean
Private m_Resized As Boolean

Private m_cNCM As cNCMetrics

Private m_lPtr As Long

'Event Declarations:
Public Event Resized()
Attribute Resized.VB_Description = " Occurs when a form is first displayed or
 the size of an object changes."
Public Event QueryUnload()
Attribute QueryUnload.VB_Description = "Occurrs when close button on frame is
 clicked."

Public Property Let Pane(ByRef ctlThis As Object)
   pSetPane ctlThis
End Property
Public Property Set Pane(ByRef ctlThis As Object)
   pSetPane ctlThis
End Property
Private Sub pSetPane(ByRef ctlThis As Object)
Dim o As Object
   If pbFindObject(o) Then
      On Error Resume Next
      o.Visible = False
   End If
   On Error GoTo 0
   If TypeOf ctlThis Is Control Then
      ctlThis.Visible = True
      Set ctlThis.Container = UserControl.Extender
      
      m_lPtr = ObjPtr(ctlThis)
   Else
      Err.Raise 5, App.EXEName
   End If
End Sub
Public Property Get Pane() As Object
   If Not (m_lPtr = 0) Then
      pbFindObject Pane
   End If
End Property
Private Function pbFindObject(ByRef oThis As Object) As Boolean
Dim ctl As Control
   For Each ctl In UserControl.ContainedControls
      If ObjPtr(ctl) = m_lPtr Then
         Set oThis = ctl
         pbFindObject = True
      End If
   Next
End Function

Public Property Get Caption() As String
Attribute Caption.VB_Description = "Returns/sets the text displayed in an
 object's title bar or below an object's icon."
Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Appearance"
   Caption = m_sCaption
End Property
Public Property Let Caption(ByVal vValue As String)
   m_sCaption = vValue
   SetAccelerator
   m_State = -1
   RePaint
   PropertyChanged "Caption"
End Property
Public Property Get CaptionAlign() As AlignConstants
   CaptionAlign = m_eCaptionAlign
End Property
Public Property Let CaptionAlign(ByVal eAlign As AlignConstants)
   m_eCaptionAlign = eAlign
   UserControl_Resize
   PropertyChanged "CaptionAlign"
End Property
Public Property Get CaptionMode() As ECAFCaptionModeConstants
   CaptionMode = m_eCaptionMode
End Property
Public Property Let CaptionMode(ByVal eMode As ECAFCaptionModeConstants)
   m_eCaptionMode = eMode
   UserControl_Resize
   PropertyChanged "CaptionMode"
End Property
Public Property Get CaptionVisible() As Boolean
   CaptionVisible = m_bCaptionVisible
End Property
Public Property Let CaptionVisible(ByVal bState As Boolean)
   m_bCaptionVisible = bState
   UserControl_Resize
   PropertyChanged "CaptionVisible"
End Property
Public Property Get ClientLeft() As Long
Attribute ClientLeft.VB_Description = "Returns left coordinate of the internal
 area of control."
   ClientLeft = UserControl.ScaleX(m_tClient.Left + (m_Border * -1 * (Not
    (m_bCaptionVisible) Or (m_eActualCapAlign = vbAlignTop Or m_eActualCapAlign
    = vbAlignBottom))), vbPixels, UserControl.ScaleMode)
End Property
Public Property Let ClientLeft(ByVal vValue As Long)
   If Ambient.UserMode = False Then Err.Raise 382
   If Ambient.UserMode Then Err.Raise 393
End Property

Public Property Get ClientTop() As Long
Attribute ClientTop.VB_Description = "Returns top coordinate of the internal
 area of control."
   ClientTop = UserControl.ScaleY(m_tClient.Top + (m_Border * -1 * (Not
    (m_bCaptionVisible) Or Not (m_eActualCapAlign = vbAlignTop))), vbPixels,
    UserControl.ScaleMode)
End Property

Public Property Let ClientTop(ByVal vValue As Long)
   If Ambient.UserMode = False Then Err.Raise 382
   If Ambient.UserMode Then Err.Raise 393
End Property

Public Property Get ClientWidth() As Long
Attribute ClientWidth.VB_Description = "Returns width of internal area of the
 control."
   ClientWidth = UserControl.ScaleX(m_tClient.Right - m_tClient.Left -
    m_Border, vbPixels, UserControl.ScaleMode) - ClientLeft
End Property

Public Property Let ClientWidth(ByVal vValue As Long)
   If Ambient.UserMode = False Then Err.Raise 382
   If Ambient.UserMode Then Err.Raise 393
End Property

Public Property Get ClientHeight() As Long
Attribute ClientHeight.VB_Description = "Returns the internal height of
 control."
   ClientHeight = UserControl.ScaleY(m_tClient.Bottom - (m_Border * -1 * Not
    (m_eActualCapAlign = vbAlignBottom)), vbPixels, UserControl.ScaleMode) -
    ClientTop
End Property

Public Property Let ClientHeight(ByVal vValue As Long)
   If Ambient.UserMode = False Then Err.Raise 382
   If Ambient.UserMode Then Err.Raise 393
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines
 whether an object can respond to user-generated events."
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Misc"
   Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal vValue As Boolean)
   UserControl.Enabled() = vValue
   m_State = -1
   Call RePaint
   PropertyChanged "Enabled"
End Property

Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Attribute Font.VB_UserMemId = -512
   Set Font = UserControl.Font
End Property

Public Property Let Font(ByVal vValue As Font)
   Set UserControl.Font = vValue
   m_State = -1
   Call RePaint
   PropertyChanged "Font"
End Property

Public Property Set Font(ByVal vValue As Font)
   Set UserControl.Font = vValue
   m_State = -1
   Call RePaint
   PropertyChanged "Font"
End Property

Public Property Get BackColor() As OLE_COLOR
   BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal oColor As OLE_COLOR)
   UserControl.BackColor = oColor
   Refresh
   PropertyChanged "BackColor"
End Property

Public Sub About()
Attribute About.VB_Description = "Displays information about control."
Attribute About.VB_UserMemId = -552
   MsgBox "ActiveFrame Control" & vbCrLf & vbCrLf & App.LegalCopyright & vbCrLf
    & vbCrLf & "Contact Details: KPrashadKhan@hotmail.com", vbInformation
End Sub

Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
   UserControl.Refresh
End Sub

Private Sub tmrExit_Timer()
   Dim ptMouse As POINTAPI

   GetCursorPos ptMouse
   If WindowFromPoint(ptMouse.x, ptMouse.y) <> UserControl.hwnd Then
      tmrExit.Enabled = False
      PaintButton vbFlat
   End If
End Sub

Private Sub UserControl_Initialize()
   Set m_cNCM = New cNCMetrics
   m_bCaptionVisible = True
   #If DEBUGMODE Then
      Debug.Print "Initilize"
   #End If
End Sub

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
   Set Font = Ambient.Font
   m_sCaption = m_def_Caption
   #If DEBUGMODE Then
      Debug.Print "InitProperties"
   #End If
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   If Not Ambient.UserMode Then Exit Sub
   x = x \ Screen.TwipsPerPixelX
   y = y \ Screen.TwipsPerPixelY
   If x >= m_tButton.Left And x <= m_tButton.Right And y >= m_tButton.Top And y
    <= m_tButton.Bottom Then
      If Button = vbLeftButton Then
         PaintButton vbSunken
      Else
         PaintButton vbFlat
      End If
   End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   If Not Ambient.UserMode Then Exit Sub
   x = x \ Screen.TwipsPerPixelX
   y = y \ Screen.TwipsPerPixelY
   If x < m_tButton.Left Or x > m_tButton.Right Or y < m_tButton.Top Or y >
    m_tButton.Bottom Then
      PaintButton vbFlat
   Else
      tmrExit.Enabled = True
      If Button = vbLeftButton Then
         PaintButton vbSunken
      Else
         PaintButton vbRaised
      End If
   End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   If Not Ambient.UserMode Then Exit Sub
   x = x \ Screen.TwipsPerPixelX
   y = y \ Screen.TwipsPerPixelY
   If x >= m_tButton.Left And x <= m_tButton.Right And y >= m_tButton.Top And y
    <= m_tButton.Bottom Then
      If Button = vbLeftButton Then
         PaintButton vbRaised
         RaiseEvent QueryUnload
      Else
         PaintButton vbFlat
      End If
   End If
End Sub

Private Sub UserControl_Paint()
   m_State = -1
   RePaint
   #If DEBUGMODE Then
      Debug.Print "Paint"
   #End If
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   With PropBag
      UserControl.Enabled = .ReadProperty("Enabled", True)
      Dim sFnt As New StdFont
      Set UserControl.Font = .ReadProperty("Font", sFnt)
      m_sCaption = .ReadProperty("Caption", m_def_Caption)
      m_eCaptionMode = .ReadProperty("CaptionMode", ecafSystem)
      m_eCaptionAlign = .ReadProperty("CaptionAlign", vbAlignNone)
      m_bCaptionVisible = .ReadProperty("CaptionVisible", True)
      UserControl.BackColor = .ReadProperty("BackColor", vbWindowBackground)
   End With
   m_State = -1
   #If DEBUGMODE Then
         Debug.Print "ReadProperties"
   #End If
End Sub

Private Sub UserControl_Resize()
On Error Resume Next

Dim tR As RECT

   #If DEBUGMODE Then
      Debug.Print "Resize"
   #End If
      
   ' Get the system metrics for the titlebar if the CaptionMode is set to
    ecafSystem:
   m_cNCM.GetMetrics
   If m_eCaptionMode = ecafSystem Then
      m_lTitleSize = m_cNCM.CaptionHeight + 1
      Set UserControl.Font = m_cNCM.Font(UserControl.hDC, MenuFont)
   Else
      m_lTitleSize = UserControl.TextHeight("Hg") \ Screen.TwipsPerPixelX + 4
   End If
   
   ' Evaluate default caption alignment if necessary:
   If m_eCaptionAlign = vbAlignNone Then
      ' Use default based on control alignment:
      Select Case UserControl.Extender.Align
      Case vbAlignLeft, vbAlignRight, vbAlignNone
         ' At top
         m_eActualCapAlign = vbAlignTop
      Case vbAlignTop, vbAlignBottom
         ' Opposite side to scrollbars, depends on RTL property
         If UserControl.RightToLeft Then
            m_eActualCapAlign = vbAlignRight
         Else
            m_eActualCapAlign = vbAlignLeft
         End If
      End Select
   Else
      m_eActualCapAlign = m_eCaptionAlign
   End If
      
   ' Work out the client size, adjusting for the caption position:
   GetClientRect UserControl.hwnd, tR
   LSet m_tClient = tR
   If m_bCaptionVisible Then
      LSet m_tCaption = tR
      Select Case m_eActualCapAlign
      Case vbAlignTop, vbAlignBottom
         ' Determine the title position:
         If m_eActualCapAlign = vbAlignTop Then
            m_tCaption.Bottom = m_tCaption.Top + m_lTitleSize + m_Border * 2
            m_tClient.Top = m_tCaption.Bottom
         Else
            m_tClient.Bottom = m_tClient.Bottom - (m_lTitleSize + m_Border * 2)
            m_tCaption.Top = m_tClient.Bottom
         End If
         ' Button position:
         LSet m_tButton = m_tCaption
         InflateRect m_tButton, -(m_Border + 1), -(m_Border + 1)
         OffsetRect m_tButton, -1, 0
         m_tButton.Bottom = m_tButton.Bottom - 1
         m_tButton.Left = m_tButton.Right - (m_tButton.Bottom - m_tButton.Top +
          3)
      Case vbAlignLeft, vbAlignRight
         ' Determine the title position:
         If m_eActualCapAlign = vbAlignLeft Then
            m_tCaption.Right = m_tCaption.Left + m_lTitleSize + m_Border * 2
            m_tClient.Left = m_tCaption.Right
         Else
            m_tClient.Right = m_tClient.Right - (m_lTitleSize + m_Border * 2)
            m_tCaption.Left = m_tClient.Right
         End If
         ' Button position:
         LSet m_tButton = m_tCaption
         InflateRect m_tButton, -(m_Border + 1), -(m_Border + 1)
         m_tButton.Bottom = m_tButton.Top + (m_tButton.Right - m_tButton.Left)
      End Select
   Else
      m_tCaption.Top = -100
      m_tCaption.Left = -100
      m_tCaption.Bottom = -100
      m_tCaption.Right = -100
      LSet m_tButton = m_tCaption
   End If
   
   m_State = -1
   m_Resized = True
   
   Dim oThis As Object
   If pbFindObject(oThis) Then
      On Error Resume Next
      oThis.Move ClientLeft, ClientTop, ClientWidth, ClientHeight
      RePaint
   Else
      UserControl.Refresh
   End If
   
End Sub

Private Sub UserControl_Show()
   UserControl_Resize
End Sub

Private Sub UserControl_Terminate()
   Set m_cNCM = Nothing
   #If DEBUGMODE Then
      Debug.Print "Terminate"
   #End If
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   With PropBag
      .WriteProperty "Enabled", UserControl.Enabled, True
      Dim sFnt As New StdFont
      .WriteProperty "Font", Font, sFnt
      .WriteProperty "Caption", m_sCaption, m_def_Caption
      .WriteProperty "CaptionMode", m_eCaptionMode, ecafSystem
      .WriteProperty "CaptionAlign", m_eCaptionAlign, vbAlignNone
      .WriteProperty "CaptionVisible", m_bCaptionVisible, True
      .WriteProperty "BackColor", UserControl.BackColor, vbWindowBackground
   End With
   #If DEBUGMODE Then
      Debug.Print "WriteProperties"
   #End If
End Sub

Private Sub PaintBorder()
Dim tR As RECT
Dim hBr As Long
Dim oJunk As Control
   GetClientRect UserControl.hwnd, tR
   hBr = GetSysColorBrush(vbButtonFace And &H1F&)
   If m_bCaptionVisible Then
      FillRect UserControl.hDC, m_tCaption, hBr
      DrawEdge UserControl.hDC, m_tCaption, EDGE_ETCHED, BF_RECT
   End If
   DrawEdge UserControl.hDC, tR, EDGE_ETCHED, BF_RECT
End Sub

Private Sub PaintButton(ByVal vState As BStates)
Dim tmpPic As StdPicture
Dim tR As RECT
Dim tUR As RECT
Dim RColor As Long
Dim SColor As Long
Dim lColor As Long
Dim hBr As Long
      
   If vState = m_State Then Exit Sub
   
   LSet tUR = m_tButton
   tUR.Left = tUR.Left * Screen.TwipsPerPixelX
   tUR.Right = tUR.Right * Screen.TwipsPerPixelX
   tUR.Top = tUR.Top * Screen.TwipsPerPixelY
   tUR.Bottom = tUR.Bottom * Screen.TwipsPerPixelY
   
   If vState = vbSunken Then
   '   Set tmpPic = LoadResPicture(102, vbResBitmap)
      RColor = vbButtonShadow
      SColor = vb3DHighlight
   Else
   '   Set tmpPic = LoadResPicture(101, vbResBitmap)
      RColor = vb3DHighlight
      SColor = vbButtonShadow
   End If

   'Calculate new position for button
   hBr = GetSysColorBrush(vbButtonFace And &H1F&)
   FillRect UserControl.hDC, m_tButton, hBr
   DeleteObject hBr
   
   Dim sFnt As New StdFont, sFntOld As StdFont
   Dim lSize As Long
   
   Set sFntOld = UserControl.Font
   sFnt.Name = "Marlett"
   lSize = UserControl.Font.Size - 1
   If lSize < 7 Then lSize = 7
   sFnt.Size = lSize
   Set UserControl.Font = sFnt
      
   LSet tR = m_tButton
   InflateRect tR, -1, -1
   OffsetRect tR, 1, 1
   If vState = vbSunken Then
      OffsetRect tR, 1, 1
   End If

   If Ambient.UserMode Then
      If UserControl.Enabled Then
         DrawText UserControl.hDC, "r", -1, tR, DT_CENTER Or DT_SINGLELINE Or
          DT_VCENTER
      Else
         lColor = UserControl.ForeColor
         UserControl.ForeColor = vb3DHighlight
         OffsetRect tR, 1, 1
         DrawText UserControl.hDC, "r", -1, tR, DT_CENTER Or DT_SINGLELINE Or
          DT_VCENTER
         UserControl.ForeColor = vbButtonShadow
         OffsetRect tR, -1, -1
         DrawText UserControl.hDC, "r", -1, tR, DT_CENTER Or DT_SINGLELINE Or
          DT_VCENTER
         UserControl.ForeColor = lColor
      End If
            
      If vState = vbFlat Then
         UserControl.Line (tUR.Left, tUR.Top)-(tUR.Right, tUR.Bottom),
          vbButtonFace, B
      Else
         UserControl.Line (tUR.Left, tUR.Top)-(tUR.Right, tUR.Top), RColor
         UserControl.Line (tUR.Left, tUR.Top)-(tUR.Left, tUR.Bottom), RColor
         UserControl.Line (tUR.Right, tUR.Bottom)-(tUR.Left, tUR.Bottom), SColor
         UserControl.Line (tUR.Right, tUR.Bottom)-(tUR.Right, tUR.Top), SColor
      End If
   Else
      DrawText UserControl.hDC, "r", -1, tR, DT_CENTER Or DT_SINGLELINE Or
       DT_VCENTER
   End If
   
   Set UserControl.Font = sFntOld
   m_State = vState
   
End Sub

Private Sub PaintCaption()
Dim tParm As DRAWTEXTPARAMS
Dim tRect As RECT
   
   If Not (m_eActualCapAlign = vbAlignLeft Or m_eActualCapAlign = vbAlignRight)
    Then
      'Draw the caption
      tParm.cbSize = Len(tParm)
      tParm.iLeftMargin = 0
      tParm.iRightMargin = 0
      tParm.iTabLength = 4
         
      LSet tRect = m_tCaption
      InflateRect tRect, -m_Border - 1, -m_Border - 1
      OffsetRect tRect, 3, 0
      If Ambient.UserMode Then
         If UserControl.Enabled Then
            DrawTextEx UserControl.hDC, m_sCaption, -1, tRect, _
                              DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS,
                               tParm
         Else
            UserControl.ForeColor = vb3DHighlight
            DrawTextEx UserControl.hDC, m_sCaption, -1, tRect, _
                                    DT_SINGLELINE Or DT_VCENTER Or
                                     DT_END_ELLIPSIS, tParm
            UserControl.ForeColor = vbButtonShadow
            tRect.Left = tRect.Left - 1
            tRect.Top = tRect.Top - 1
            DrawTextEx UserControl.hDC, m_sCaption, -1, tRect, _
                                    DT_SINGLELINE Or DT_VCENTER Or
                                     DT_END_ELLIPSIS, tParm
            UserControl.ForeColor = vbButtonText
         End If
      Else
         DrawTextEx UserControl.hDC, m_sCaption, -1, tRect, _
                        DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS, tParm
      End If
   End If
End Sub

Private Sub RePaint()
   If Not m_Painting Then
      m_Painting = True
      PaintBorder
      PaintCaption
      PaintButton vbFlat
      m_Painting = False
   End If
   If m_Resized Then
      m_Resized = False
      RaiseEvent Resized
   End If
End Sub

Private Sub SetAccelerator()
Dim iPos As Integer
   iPos = InStr(1, m_sCaption, "&")
   If iPos > 0 And iPos < Len(m_sCaption) Then
      UserControl.AccessKeys = Mid(m_sCaption, iPos + 1, 1)
   Else
      UserControl.AccessKeys = ""
   End If
End Sub