I *REALLY* don't like the maskededitbox. So I rolled my own.

[cafeenman]

It's not nearly as functional but it does what I need it to do without having to deal with mask, format and I don't remember what else. I stopped using them long ago and don't remember all the ways maskededitboxes frustrated the hell out of me in use.

If you have a moment then please try it in something and tell me what you think please.

Also too, I removed my cChanged Class and just air-coded in notepad a Boolean instead. It might not work properly as I haven't tested it that way so if it doesn't work right then I can post the original class with the cchanged class and it should be fine.

Also, I removed all the callstack stuff (I think).

This could stand some improvement. I was having problems populating the textbox without triggering changed events (loading saved data) and landed on having a Value property that doesn't raise a changed event and a NewValue property that does raise the changed event so that's kind of awkward.

You populate existing values using the Value property and you change the value using the NewValue property.

Usage:

' Declarations.

Private WithEvents mw_MaximumFontSize As cNumericTextBox       ' Maximum Font size User may select for Control Fonts (Form Font Settings).

Private Sub Form_Load()

Set MaximumFontSize = New cNumericTextBox

End Sub

Friend Property Set MaximumFontSize(ByRef objNumericTextBox As cNumericTextBox)

On Error GoTo errHandler

Set mw_MaximumFontSize = objNumericTextBox


With MaximumFontSize

  Set .TextBox = txtMaxFontSize
  .Initialize idx_NumericTextBoxType_Decimal, 6, 20, 18, "0.0", 2

End With

Exit Property

errHandler:
Dim nErrorHandlerResult As Long

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, Me.NAME & ".MaximumFontSize(Friend Property Set)")

End Property

cNumericTextBox:

Option Explicit


' Let the Value Property (Default) to populate a Value without raising a Changed Event.

' Let the NewValue Property to change the Value AND raise a Changed Event.

' When the User types in a value it is not set until the User presses the Enter Key or Tabs out of the TextBox.
' A Changed Event will be raised only if the NewValue Property differs from the existing Value Property.

' Example.

' A cNumericTextBox Object is Named 'AmountPaid'.
' Populating a form from a Record:  AmountPaid = $19.95. (Currency symbols are stripped before the value is set).
' No Changed Event is raised because Value is the default property and does not raise events.

' Next, the user Clicks a button that automatically enters the AmountPaid as the Amount Due (in this case that's 29.95).

' Private Sub Button_Click()
'
'   AmountPaid.NewValue = 19.95 ' This sets the Value but DOES NOT raise a Changed Event because the NewValue is the same as the old value.
'   AmountPaid.NewValue = 29.95 ' This sets the value and raises a Changed Event.
'
' End Sub


' // Constants, Types and Enums.

Private Const NAME As String = "cNumericTextbox"


Private Enum GOT_FOCUS ' User option to select text when a TextBox receives focus.

  idx_GotFocus_LastPosition = 0
  idx_GotFocus_FieldBeginning
  idx_GotFocus_FieldEnd
  idx_GotFocus_FieldAll

End Enum

' / Constants, Types and Enums.


' // Objects.


  ' / Controls.

Private WithEvents mw_TextBox As VB.TextBox

  ' / Controls.


' // Objects.


' // Events.

Public Event Changed() ' Event raised when the value of the field changes. Inactive when Changed Object is disabled.

' // Events.


' // Constants, Types and Enums.

Public Enum NUMERIC_TEXTBOX_NUMBER_TYPE

  idx_NumericTextBoxType_Currency = 0
  idx_NumericTextBoxType_Decimal
  idx_NumericTextBoxType_Integer ' In this case, "Integer" means Whole Number, NOT Integer Data Type.  I changed it in my code to reflect that.  E.g.
                                                  ' idx_NumericTextBoxType_Integer was changed to idx_NumericTextBoxType_WholeNumber

End Enum

Private Const DEFAULT_NUMBER_FORMAT As String = "#0.000"

' // Constants, Types and Enums.


' // Properties.

private fChanged as Boolean
Private nDecimalPlaces As Long
Private rMaximumValue As Double
Private rMinimumValue As Double
Private rNewValue As Double
Private sNumberFormat As String
Private nNumberType As NUMERIC_TEXTBOX_NUMBER_TYPE
Private nOnEnterSelection As GOT_FOCUS
Private nValidationFailBackcolor As Long
Private rValue As Double

' // Properties.


Public Property Get Alignment() As Long

Alignment = TextBox.Alignment

End Property
Public Property Let Alignment(ByVal TextAlignment As Long)

TextBox.Alignment = TextAlignment

End Property
Public Property Get BackColor() As Long

BackColor = TextBox.BackColor

End Property
Public Property Let BackColor(ByVal Color As Long)

TextBox.BackColor = Color

End Property
Public Property Get BorderStyle() As Long

BorderStyle = TextBox.BorderStyle

End Property
Public Property Let BorderStyle(ByVal Style As Long)

TextBox.BorderStyle = Style

End Property
Public Property Get Changed() As Boolean

Changed = fChanged

End Property
Private Property Let Changed (ByRef IsChanged As Boolean)

fChanged = IsChanged

RaiseEvent Changed

End Property
Private Function CreateMinMaxValue() As Long

' Returns Error Code.
On Error GoTo errHandler

' Creates the largest and smallest possible values.  Anything outside this range will raise an error.

MaximumValue = 922337203685477#
MinimumValue = -MaximumValue

Exit Function

errHandler:
Dim nErrorHandlerResult As Long

CreateMinMaxValue = Err

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".CreateMinMaxValue(Private Function)")

End Function
Public Property Get DecimalPlaces() As Long

DecimalPlaces = nDecimalPlaces

End Property
Public Property Let DecimalPlaces(ByVal NumberOfDecimals As Long)

nDecimalPlaces = NumberOfDecimals

End Property
Public Property Get Enabled() As Boolean

CallStack.Add NAME & ".Enabled(Public Property Get)"

Enabled = TextBox.Enabled

CallStack.DeleteProcedureCall

End Property
Public Property Let Enabled(ByVal TextBoxEnabled As Boolean)

TextBox.Enabled = TextBoxEnabled

End Property
Public Property Get Font() As StdFont

Set Font = TextBox.Font

End Property
Public Property Set Font(ByRef m_Font As StdFont)

CallStack.Add NAME & ".Font(Public Property Set)"

Set TextBox.Font = m_Font

CallStack.DeleteProcedureCall

End Property
Private Function ForceDecimalNumber(ByRef ctlTextBox As VB.TextBox, ByRef KeyAscii As Integer, ByRef AllowDecimal As Boolean, ByRef AllowMinus As Boolean) As Integer

' Called from mw_TextBox_KeyPress.
' Returns KeyAscii.
' Return of 0 Voids the key input when the key entered isn't valid.

On Error Resume Next

' If it's not a number, decimal or minus sign then void character.
If Not IsNumeric(Chr(KeyAscii)) And (KeyAscii <> 45) And (KeyAscii <> 46) And (KeyAscii <> vbKeyBack) Then Exit Function ' Return 0

' If user entered a decimal and decimals are not allowed then void character.
If (KeyAscii = 46) And (AllowDecimal = False) Then Exit Function ' Return 0

If KeyAscii = 45 Then ' Minus Sign.

  ' If minus signs aren't allowed then void character.
  If AllowMinus = False Then Exit Function ' Return 0

  ' If there is an existing minus sign then void character.
  If InStr(1, ctlTextBox.Text, "-", vbTextCompare) Then Exit Function  ' Return 0

  ' If user attempts to add a minus sign anywhere except the beginning a string then void character.
  If (ctlTextBox.SelStart > 0) Then Exit Function  ' Return 0

End If

' If it's a decimal then make sure it's the only one.
If KeyAscii = 46 Then ' Decimal Point.

  If InStr(1, ctlTextBox.SelText, CHAR_DOT, vbTextCompare) Then ' Replace selected text with decimal point.

    ctlTextBox.SelText = vbNullString

  ElseIf InStr(1, ctlTextBox.Text, CHAR_DOT, vbTextCompare) Then ' Void second decimal point if one already exists.

    Exit Function ' Return 0

  End If

End If

' Do not allow any characters before a Minus Sign.
If Left$(ctlTextBox.Text, 1) = "-" And ctlTextBox.SelStart = 0 Then Exit Function ' Return 0

' Do not allow any characters before a Dollar Sign.
If Left$(ctlTextBox.Text, 1) = "$" And ctlTextBox.SelStart = 0 Then Exit Function ' Return 0

' Our Text ran the gauntlet and survived.  Yay!

ForceDecimalNumber = KeyAscii ' Return KeyAscii

End Function
Public Property Get ForeColor() As Long

ForeColor = TextBox.ForeColor

End Property
Public Property Let ForeColor(ByVal TextBoxForecolor As Long)

TextBox.ForeColor = TextBoxForecolor

End Property
Private Function FormatValue(ByVal Value As Double) As String
Dim s As String
Dim sFormat As String

On Error GoTo errHandler

If mw_TextBox Is Nothing Then Exit Function

s = CStr(Value)

With TextBox

  Select Case NumberType

    Case idx_NumericTextBoxType_Currency

      sFormat = CURRENCY_SYMBOL & "0." & String$(DecimalPlaces, "0")

      .Text = Format$(s, sFormat)

    Case Else

      .Text = Format$(s, NumberFormat)

  End Select

End With

Exit Function


errHandler:
Dim nErrorHandlerResult As Long

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".FormatValue(Private Function)")

End Function
Public Property Get Height() As Long

Height = TextBox.Height

End Property
Public Property Let Height(ByVal TextBoxHeight As Long)

On Error Resume Next

TextBox.Height = TextBoxHeight

End Property
Public Function Initialize(ByVal NumType As NUMERIC_TEXTBOX_NUMBER_TYPE, ByVal MinValue As Double, ByVal MaxValue As Double, ByVal InitValue As Double, _
                           Optional NumFormat As String = vbNullString, Optional ByVal Decimals As Long = 3) As Long

' Returns Error Code.
On Error GoTo errHandler

NumberType = NumType

MinimumValue = MinValue ' Set Minimum and Maximum Values allowed to be entered.
MaximumValue = MaxValue

If NumFormat <> vbNullString Then NumberFormat = NumFormat ' DEFAULT_NUMBER_FORMAT

If NumType = idx_NumericTextBoxType_Decimal Then

  If NumFormat = vbNullString Then

    If Decimals > 0 Then

      NumberFormat = "#0." & String$(Decimals, "0")

    Else ' User specified Decimal Number type but allowed no digits after decimal.

      NumberFormat = "#0"

    End If

  End If

End If

DecimalPlaces = Decimals

Value = InitValue

Exit Function


errHandler:
Dim nErrorHandlerResult As Long

Initialize = Err

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".Initialize(Public Function)")

End Function
Public Property Get Left() As Long

Left = TextBox.Left

End Property
Public Property Let Left(ByVal TextBoxLeft As Long)

TextBox.Left = TextBoxLeft

End Property
Public Property Get Locked() As Boolean

Locked = TextBox.Locked

End Property
Public Property Let Locked(ByVal TextBoxLocked As Boolean)

TextBox.Locked = TextBoxLocked

End Property
Public Property Get MaximumValue() As Double

MaximumValue = rMaximumValue

End Property
Public Property Let MaximumValue(ByVal MaximumValueAllowed As Double)

rMaximumValue = MaximumValueAllowed

End Property
Public Property Get MaxLength() As Long

MaxLength = TextBox.MaxLength

End Property
Public Property Let MaxLength(ByVal TextBoxMaxLength As Long)

TextBox.MaxLength = TextBoxMaxLength

End Property
Public Property Get MinimumValue() As Double

MinimumValue = rMinimumValue

End Property
Public Property Let MinimumValue(ByVal MinimumValueAllowed As Double)

rMinimumValue = MinimumValueAllowed

End Property
Public Property Get MultiLine() As Boolean

MultiLine = TextBox.MultiLine

End Property

Private Property Get NewValue() As Double

NewValue = rNewValue

End Property
Public Property Let NewValue(ByVal Number As Double)
Dim r As Double

r = Value

rNewValue = Validate(Number)

Value = NewValue

If r <> NewValue Then Changed = True

End Property
Public Property Get NumberFormat() As String

NumberFormat = sNumberFormat

End Property
Public Property Let NumberFormat(ByVal TextFormat As String)

sNumberFormat = TextFormat

End Property
Public Property Get NumberType() As NUMERIC_TEXTBOX_NUMBER_TYPE

NumberType = nNumberType

End Property
Public Property Let NumberType(ByVal NumType As NUMERIC_TEXTBOX_NUMBER_TYPE)

nNumberType = NumType

End Property
Public Property Get OnEnterSelection() As GOT_FOCUS

OnEnterSelection = nOnEnterSelection

End Property
Public Property Let OnEnterSelection(ByVal SelectTextOnEntry As GOT_FOCUS)

nOnEnterSelection = SelectTextOnEntry

End Property
Public Property Get PasswordChar() As String

PasswordChar = TextBox.PasswordChar

End Property
Public Property Let PasswordChar(ByVal TextBoxPasswordChar As String)
Dim s As String

s = Trim$(TextBoxPasswordChar)

If s <> vbNullString Then

  s = Left$(s, 1)

End If

TextBox.PasswordChar = s

End Property
Public Property Get RightToLeft() As Boolean

RightToLeft = TextBox.RightToLeft

End Property
Public Property Let RightToLeft(ByVal TextBoxRightToLeft As Boolean)

TextBox.RightToLeft = TextBoxRightToLeft

End Property
Private Function SelectText(ByVal Selection As GOT_FOCUS, Optional SelStart As Long = 0) As Long

' Returns Error Code.
On Error GoTo errHandler

CallStack.Add NAME & ".SelectText(Private Function)"

' Positions carat and selects text per user option.

With TextBox

  Select Case Selection

    Case idx_GotFocus_LastPosition

      ' This is what happens by default. Carat is restored at last position.Selected text is restored as last selected.

    Case idx_GotFocus_FieldBeginning

      .SelStart = SelStart ' Carat is placed at beginning of field. No text is selected.

    Case idx_GotFocus_FieldEnd

      .SelStart = Len(TextBox.Text) ' Carat is placed at end of field. No text is selected.

    Case idx_GotFocus_FieldAll

      .SelStart = SelStart ' All text is selected.

      .SelLength = Len(TextBox.Text) - SelStart

  End Select

End With

Exit Function


errHandler:
Dim nErrorNumber As Long
Dim nErrorHandlerResult As Long
Dim sError As String
Dim Parameters(1) As String

SelectText = Err

nErrorNumber = Err
sError = Error

Parameters(0) = "TextBox.Name = " & TextBox.NAME
Parameters(1) = "Selection = " & CStr(Selection)

nErrorHandlerResult = ErrorHandler(sError, nErrorNumber, ParameterString(Parameters), NAME & ".SelectText(Private Function)")

End Function
Public Property Get TabIndex() As Integer

TabIndex = TextBox.TabIndex

End Property
Public Property Let TabIndex(ByVal Index As Integer)

TextBox.TabIndex = Index

End Property
Public Property Get TabStop() As Boolean

TabStop = TextBox.TabStop

End Property
Public Property Let TabStop(ByVal HasTabStop As Boolean)

TextBox.TabStop = HasTabStop

End Property
Public Property Get Tag() As String

Tag = TextBox.Tag

End Property
Public Property Let Tag(ByVal TextBoxTag As String)

TextBox.Tag = TextBoxTag

End Property
Public Property Get Text() As String

Text = TextBox.Text

End Property
Public Property Let Text(ByVal TextValue As String)

On Error GoTo errHandler

Value = Val(TextValue)

Exit Property


errHandler:
Dim nErrorHandlerResult As Long

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".Text(Public Property Let)")

End Property
Public Property Get TextBox() As VB.TextBox

On Error GoTo errHandler

Set TextBox = mw_TextBox

Exit Property


errHandler:
Dim nErrorHandlerResult As Long

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".TextBox(Public Property Get)")

End Property
Public Property Set TextBox(ByRef ctlTextBox As VB.TextBox)

On Error GoTo errHandler

Set mw_TextBox = ctlTextBox

Exit Property

errHandler:
Dim nErrorHandlerResult As Long

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".TextBox(Public Property Set)")

End Property
Public Property Get ToolTipText() As String

ToolTipText = TextBox.ToolTipText

End Property
Public Property Let ToolTipText(ByVal TextBoxToolTipText As String)

TextBox.ToolTipText = TextBoxToolTipText

End Property
Public Property Get Top() As Long

Top = TextBox.Top

End Property
Public Property Let Top(ByVal TextBoxTop As Long)

Top = TextBoxTop

End Property
Private Function Validate(ByVal Value As Double) As Double
Dim r As Double

On Error GoTo errHandler

r = Value

If r > MaximumValue Then r = MaximumValue
If r < MinimumValue Then r = MinimumValue

Select Case NumberType

  Case idx_NumericTextBoxType_Integer

    Validate = Int(r)

  Case Else

    Validate = r

End Select

Exit Function

errHandler:
Dim nErrorHandlerResult As Long
Dim sError As String
Dim nErr As Long
Dim Parameters(4) As String

sError = Error
nErr = Err

Parameters(0) = "TextBox.Text = " & TextBox.Text
Parameters(1) = "Value = " & CStr(Value)
Parameters(2) = "r = " & CStr(r)
Parameters(3) = "MinimumValue = " & CStr(MinimumValue)
Parameters(4) = "MaximumValue = " & CStr(MaximumValue)

nErrorHandlerResult = ErrorHandler(sError, nErr, ParameterString(Parameters), NAME & ".Validate(Private Function)")

End Function
Public Property Get ValidationFailBackcolor() As Long

ValidationFailBackcolor = nValidationFailBackcolor

End Property
Public Property Let ValidationFailBackcolor(ByVal Color As Long)

nValidationFailBackcolor = Color

End Property
Public Property Get Value() As Double

Value = rValue

End Property
Public Property Let Value(ByVal Number As Double)
Dim f As Boolean

f = fChanged.Enabled = False

rValue = Number

rValue = Validate(Number)

FormatValue rValue

fChanged = f

End Property
Public Property Get Visible() As Boolean

Visible = TextBox.Visible

End Property
Public Property Let Visible(ByVal TextBoxVisible As Boolean)

TextBox.Visible = TextBoxVisible

End Property
Public Property Get Width() As Long

Width = TextBox.Width

End Property
Public Property Let Width(ByVal TextBoxWidth As Long)

TextBox.Width = TextBoxWidth

End Property
Private Sub mw_TextBox_GotFocus()
Dim s As String
Dim f As Boolean

f = fChanged
s = Trim$(TextBox.Text)

s = Replace(s, "$", vbNullString, 1, -1, vbTextCompare)

If Not TextBox.Locked Then TextBox.Text = s

fChanged = f

SelectText OnEnterSelection

End Sub
Private Sub mw_TextBox_KeyPress(KeyAscii As Integer)

' Prevent flickering if Type is Currency.

If NumberType = idx_NumericTextBoxType_Currency Then LockWindowUpdate mw_TextBox.hWnd

Select Case KeyAscii

  Case vbKeyReturn ' Set Value.

    KeyAscii = 0

    mw_TextBox_LostFocus ' On LostFocus the Value is formatted with a Currency symbol.

  Case vbKeyBack

    ' Accept Keystroke as-is.

  Case Else

    KeyAscii = ForceDecimalNumber(TextBox, KeyAscii, NumberType <> idx_NumericTextBoxType_Integer, MinimumValue < 0)

End Select

LockWindowUpdate False

End Sub
Private Sub mw_TextBox_LostFocus()
Dim s As String

On Error GoTo errHandler

s = Replace(TextBox.Text, "$", vbNullString, 1, -1, vbTextCompare)

NewValue = Val(s)

Exit Sub

errHandler:
Dim nErrorHandlerResult As Long

nErrorHandlerResult = ErrorHandler(Error, Err, vbNullString, NAME & ".TextBox_LostFocus(Private Sub)")

End Sub
Private Sub Class_Initialize()

CallStack.Add NAME & ".Class_Initialize(Private Sub)"

CreateMinMaxValue

NumberType = idx_NumericTextBoxType_Decimal
NumberFormat = DEFAULT_NUMBER_FORMAT

ValidationFailBackcolor = &HC0FFC0

OnEnterSelection = idx_GotFocus_FieldAll

End Sub