@Arizona
Hi nice to see you around.
@CmdrDuh,
As you probably have realized you can use this code for several Textboxes to limit input....
But Why Write or paste/copy it again and again.....
Write a class to wrap your textboxes, raise events to indicate illegal input (MaxedOut if a value is to high)
allow only one decimal seperator.... if you write such code once in a class module and testit you can use it many times.
The trick is to define a textbox object in the class module and make it point at the textbox on your form.
The code below is an example of a european textbox wrapper to limit input to numbers only (VB 6.0 class)
Option Explicit
'Author: B.J.G.Nieuwhof
'Mail: Info@ driesign.nl
'Usage: AT YOUR OWN RISK, Leaving comments intact and in place.
'Have Fun
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public WithEvents TextBox As TextBox
Event MaxedOut(BouncedValue As Double)
Event DivedUnder(BouncedValue As Double)
Event MaxedPrecision(BouncedValue As Double)
Event DoublePrecision()
Event IllegalCharacter(Character As String)
Event NoValue()
Private m_MaxValue As Double
Private MinValueSet As Boolean
Private m_MinValue As Double
Private MaxValueSet As Boolean
Private m_MaxTemp As Double
Private m_MinTemp As Double
Private LocalDecimalSeparator As Long
Private m_MaxDigits As Integer
Private m_BeepOnError As Boolean
Private m_bRaiseAssignmentErrors As Boolean
Private Sub Class_Terminate()
Set Me.TextBox = Nothing
End Sub
Private Sub Class_Initialize()
LocalDecimalSeparator = Asc(Mid$(Format$(1.5, "0.0"), 2, 1))
m_bRaiseAssignmentErrors = True
End Sub
Private Sub TextBox_KeyPress(KeyAscii As Integer)
Dim SepPos As Long
Dim Txt As String, TmpTxt As String
Dim PlusKey As Double
Dim Ln As Long, SLn As Long, St As Long
SLn = Me.TextBox.SelLength
St = Me.TextBox.SelStart
Ln = Len(Me.TextBox)
If SLn = 0 Then
Txt = Me.TextBox
Else
If St > 0 Then
Txt = Left$(Me.TextBox, St)
End If
If St + SLn < Ln Then
Txt = Txt & Right$(Me.TextBox, Ln - (St + SLn))
End If
End If
If MaxValueSet And MaxValue < 0 And Left$(Txt, 1) <> "-" Then
Txt = "-" & Txt
Me.TextBox = Txt
Me.TextBox.SelStart = 1
St = 1
SLn = 0
If KeyAscii <> 45 And MaxValueSet = True And MaxValue < 0 Then
If IsNumeric(Chr$(KeyAscii)) Then
RaiseEvent MaxedOut(CDbl(Chr$(KeyAscii)))
If m_BeepOnError Then Beep 4000, 50
End If
End If
End If
Select Case KeyAscii
Case 0 To 31
Case 48 To 57
SepPos = InStr(1, Txt, Chr(LocalDecimalSeparator))
If St = Len(Txt) Then
PlusKey = CDbl(Txt & Chr(KeyAscii))
Else
If St > 0 Then
TmpTxt = Left$(Me.TextBox, St) & Chr$(KeyAscii)
End If
If St + SLn < Ln Then
TmpTxt = TmpTxt & Right$(Txt, Ln - (St + SLn))
End If
PlusKey = CDbl(TmpTxt)
End If
If SepPos > 0 And (Len(Txt) - SepPos) >= MaxDigits And St > SepPos Then
RaiseEvent MaxedPrecision(CDbl(Txt & Chr(KeyAscii)))
If m_BeepOnError Then Beep 3000, 50
KeyAscii = 0
ElseIf PlusKey > m_MaxTemp And MaxValueSet Then
RaiseEvent MaxedOut(CDbl(Txt & Chr$(KeyAscii)))
KeyAscii = 0
If m_BeepOnError Then Beep 4000, 50
ElseIf PlusKey < m_MinTemp And MinValueSet Then
KeyAscii = 0
RaiseEvent DivedUnder(CDbl(Txt & Chr(KeyAscii)))
If m_BeepOnError Then Beep 2000, 50
End If
Case LocalDecimalSeparator ' Accept LocalDecimalSign
'reject second decimal char
If m_MaxDigits > 0 Then
If InStr(1, Txt, Chr(LocalDecimalSeparator)) Then
RaiseEvent DoublePrecision
If m_BeepOnError Then
Beep 2000, 25
Beep 3000, 25
End If
KeyAscii = 0
End If
Else
'raising precision event because an attempt was made to create a decimal part without
'digits allowed.
RaiseEvent MaxedPrecision(CDbl(Me.TextBox))
If m_BeepOnError Then
Beep 4000, 30
Beep 4500, 20
End If
KeyAscii = 0
End If
Case 43, 45
'plus and minus
If St > 0 Then
KeyAscii = 0
ElseIf MinValueSet And MinValue >= 0 And KeyAscii = 45 Then
KeyAscii = 0
ElseIf MaxValueSet And MaxValue <= 0 And KeyAscii = 43 Then
KeyAscii = 0
End If
Case Else
KeyAscii = 0 ' Reject anything else.
End Select
End Sub
Public Property Get MaxValue() As Double
MaxValue = m_MaxValue
End Property
Public Property Let MaxValue(ByVal dMaxValue As Double)
If dMaxValue < m_MinValue And MinValueSet Then
m_MinValue = dMaxValue
End If
m_MaxValue = dMaxValue
MaxValueSet = True
If m_MaxValue <= 0 Then
m_MaxTemp = 0
Me.TextBox = m_MaxValue
Me.TextBox.SelStart = 1
Me.TextBox.SelLength = Len(Me.TextBox)
Else
m_MaxTemp = dMaxValue
End If
End Property
Public Property Get MinValue() As Double
MinValue = m_MinValue
End Property
Public Property Let MinValue(ByVal dMinValue As Double)
If dMinValue > m_MaxValue And MaxValueSet Then
m_MaxValue = dMinValue
End If
m_MinValue = dMinValue
MinValueSet = True
If dMinValue >= 0 Then
m_MinTemp = 0
Me.TextBox = dMinValue
Me.TextBox.SelStart = 0
Me.TextBox.SelLength = Len(Me.TextBox)
Else
m_MinTemp = dMinValue
End If
End Property
Public Property Get MaxDigits() As Integer
MaxDigits = m_MaxDigits
End Property
Public Property Let MaxDigits(ByVal MaxDigits As Integer)
m_MaxDigits = MaxDigits
End Property
Public Property Get BeepOnError() As Boolean
BeepOnError = m_BeepOnError
End Property
Public Property Let BeepOnError(ByVal bBeepOnError As Boolean)
m_BeepOnError = bBeepOnError
End Property
Public Property Get Value() As Double
If Len(Me.TextBox & "") = 0 Then ResetEmptyBox
Value = CDbl(Replace(Me.TextBox.Text, LocalDecimalSeparator, "."))
End Property
Public Property Let Value(ByVal dValue As Double)
If dValue < MinValue And MinValueSet Then
RaiseEvent DivedUnder(dValue)
ElseIf dValue > MaxValue And MaxValueSet Then
RaiseEvent MaxedOut(dValue)
Else
Me.TextBox = Replace(CStr(dValue), ".", LocalDecimalSeparator)
End If
End Property
Public Property Get Text() As String
Text = Me.TextBox
End Property
Public Property Let Text(ByVal sText As String)
Dim Txt As String
Dim Val As Double
Dim L As Long
Txt = Replace(sText, LocalDecimalSeparator, ".")
If Not IsNumeric(Txt) Then
RaiseEvent IllegalCharacter(sText)
Exit Property
End If
Txt = Replace(sText, ".", LocalDecimalSeparator)
L = InStr(1, Txt, LocalDecimalSeparator)
If L > 0 Then
L = InStr(L, Txt, LocalDecimalSeparator)
If L > 0 Then
RaiseEvent DoublePrecision
If m_bRaiseCodeInputErrors Then Err.Raise vbObjectError + 10, , "Double Precision sign in assigninng" & vbCrLf & "Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & "):" & sText
Exit Property
End If
If Len(sText) - L > m_MaxDigits Then
RaiseEvent MaxedPrecision(CDbl(sText))
If m_bRaiseAssignmentErrors Then Err.Raise vbObjectError + 11, , "To much digits in assigninng" & vbCrLf & "Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & "):" & sText
Exit Property
End If
End If
Val = CDbl(sText)
If MaxValueSet And Val > MaxValue Then
RaiseEvent MaxedOut(Val)
If m_bRaiseAssignmentErrors Then Err.Raise vbObjectError + 11, , "Overshooting " & MaxValue & " with assingning " & sText & vbCrLf & " Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & ")"
Exit Property
ElseIf MinValueSet And Val < MinValue Then
RaiseEvent DivedUnder(Val)
If m_bRaiseAssignmentErrors Then Err.Raise vbObjectError + 11, , "Undershooting " & MinValue & " with assingning " & sText & vbCrLf & " Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & ")"
Exit Property
Else
Me.TextBox = Txt
End If
End Property
Public Property Get RaiseAssignmentErrors() As Boolean
m_bRaiseAssignmentErrors = m_bRaiseAssignmentErrors
End Property
Public Property Let RaiseAssignmentErrors(ByVal bRaiseCodeInputErrors As Boolean)
m_bRaiseAssignmentErrors = bRaiseCodeInputErrors
End Property
Private Sub TextBox_Validate(Cancel As Boolean)
Dim Val As Double
If Len(Me.TextBox & "") = 0 Then
RaiseEvent NoValue
Cancel = True
If m_BeepOnError Then
Beep 4000, 30
Beep 4900, 20
Beep 4000, 30
End If
ResetEmptyBox
Else
Val = CDbl(Replace(Me.TextBox, LocalDecimalSeparator, "."))
If Val > m_MaxValue And MaxValueSet Then
RaiseEvent MaxedOut(Val)
Cancel = True
ElseIf Val < m_MinValue And MinValueSet Then
RaiseEvent DivedUnder(Val)
Cancel = True
End If
End If
End Sub
Private Function ResetEmptyBox()
If m_MaxValue >= 0 And m_MinValue <= 0 Then
Me.TextBox = "0"
Me.TextBox.SelLength = 1
ElseIf m_MinValue > 0 Then
Me.TextBox = m_MinValue
Me.TextBox.SelLength = Len(Me.TextBox)
Else
If m_MaxValue < 0 Then
Me.TextBox = m_MinValue
Me.TextBox.SelStart = 1
Me.TextBox.SelLength = Len(Me.TextBox) - 1
End If
End If
End Function
Public Property Set Init(TextBoxToWrap As TextBox)
Set Me.TextBox = TextBoxToWrap
End Property
Place the code in a class (named:ClsNumbersOnly)
In a form with a textbox called Text1 use this code for example:Option Explicit
Dim WithEvents Tbox1Wrap As ClsNumbersOnly
Private Sub Form_Load()
Set Tbox1Wrap = New ClsNumbersOnly
Tbox1Wrap.MaxDigits = 2
Tbox1Wrap.MaxValue = 12
Set Tbox1Wrap.Init = Me.Text1
End Sub
Private Sub Tbox1Wrap_MaxedOut(BouncedValue As Double)
'do something with te keystroke if you like to
End Sub
I know this code will probably be a blur to you at the start but try to understand it.... and I will welcome you on your first step on the threshold of Object Ooriented Programming (OOP)
Have Fun.