VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CTextFormat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private WithEvents txtBox As TextBox
Private mnuContext As Menu
Private m_ErrorColor As Long

Public Sub Init(TextBox As TextBox, Optional ErrorColor As Long = vbRed, Optional ContextMenu As Menu = Nothing)
    Set mnuContext = ContextMenu
    m_ErrorColor = ErrorColor
    Set txtBox = TextBox
End Sub

Public Property Get ErrorColor() As Long
    ErrorColor = m_ErrorColor
End Property

Public Property Let ErrorColor(nNew As Long)
    m_ErrorColor = nNew
End Property

Public Property Set TextBox(txt As TextBox)
    Set txtBox = txt
End Property

Public Property Get TextBox() As TextBox
    Set txtBox = txtBox
End Property

Public Property Set ContextMenu(mnu As Menu)
    Set mnuContext = mnu
End Property

Public Property Get ContextMenu() As Menu
    Set ContextMenu = mnuContext
End Property

Private Sub Class_Initialize()
    m_ErrorColor = vbRed
End Sub

Private Sub txtBox_Change()
    Dim nSelStart As Long, nSelLen As Long
    If Len(txtBox.Text) Then
        If (UCase$(txtBox.Text) Like "[A-Z]" & String(Len(txtBox.Text) - 1, "#")) Then
            If UCase$(txtBox.Text) <> txtBox.Text Then
                nSelStart = txtBox.SelStart
                nSelLen = txtBox.SelLength
                txtBox.Text = UCase$(txtBox.Text)
                txtBox.SelStart = nSelStart
                txtBox.SelLength = nSelLen
            End If
            txtBox.BackColor = vbWindowBackground
        Else
            txtBox.BackColor = m_ErrorColor
        End If
    Else
        txtBox.BackColor = vbWindowBackground
    End If
End Sub

Private Sub txtBox_KeyPress(KeyAscii As Integer)
    Dim nSelLen As Long
    
    nSelLen = txtBox.SelLength
    If txtBox.SelStart = 0 And txtBox.SelLength = 0 Then
        'This will ensure that the first character is replaced if
        'the user has moved the text caret to the beginning of the text
        txtBox.SelLength = 1
    End If
    KeyAscii = Asc(UCase$(Chr$(KeyAscii))) 'capitilize
    Select Case KeyAscii
        Case vbKeyBack
            txtBox.SelLength = nSelLen
        Case vbKeyA To vbKeyZ
            If txtBox.SelStart <> 0 Then
                KeyAscii = 0
                txtBox.SelLength = nSelLen
            Else
                KeyAscii = Asc(UCase$(Chr$(KeyAscii))) 'capitilize
    End If
        Case vbKey0 To vbKey9
            If txtBox.SelStart = 0 Then
                KeyAscii = 0
                txtBox.SelLength = nSelLen
            End If
        Case Else
            KeyAscii = 0
            txtBox.SelLength = nSelLen
    End Select
End Sub

Private Sub txtBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not mnuContext Is Nothing Then
        If Button And vbRightButton Then
            'surpress the default context menu and show our custom menu instead
            txtBox.Enabled = False
            txtBox.Enabled = True
            txtBox.Parent.PopupMenu mnuContext
        End If
    End If
End Sub