I *REALLY* don't like the maskededitbox. So I rolled my own.
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:
Code:
' 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:
Code:
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
