Results 1 to 1 of 1

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

  1. #1

    Thread Starter
    PowerPoster cafeenman's Avatar
    Join Date
    Mar 2002
    Location
    Florida
    Posts
    2,665

    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
    Last edited by cafeenman; Apr 4th, 2024 at 05:45 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width