Author Topic: Is there a better way to evaluate TextBox Value  (Read 2331 times)

0 Members and 1 Guest are viewing this topic.

Dnereb

  • Guest
Re: Is there a better way to evaluate TextBox Value
« Reply #15 on: May 09, 2007, 05:16:12 PM »
@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)

Code: [Select]
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:
Code: [Select]
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.
« Last Edit: May 09, 2007, 05:23:38 PM by Dnereb »

Bryco

  • Water Moccasin
  • Posts: 1850
Re: Is there a better way to evaluate TextBox Value
« Reply #16 on: May 09, 2007, 05:39:52 PM »
Looks great Berend, but like you say will take a while to digest.

Dnereb

  • Guest
Re: Is there a better way to evaluate TextBox Value
« Reply #17 on: May 09, 2007, 05:51:51 PM »
Yes it will, but if you do it will open up a lot of possibility's and upgrade your coding capabillity's
So I thought I give some good but complex code to challenge Cmdruh (and others).
It's also a step toward using VB or VB.net by scratching the surface of OOP.

BTW nice to see you around as well.

Arizona

  • Guest
Re: Is there a better way to evaluate TextBox Value
« Reply #18 on: May 10, 2007, 07:42:59 AM »
@Arizona

Hi nice to see you around.

Hi Berend!
Good to see you again :-)

Nice code BTW!

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: Is there a better way to evaluate TextBox Value
« Reply #19 on: May 10, 2007, 09:41:50 AM »
Im going to have to look at that for a while, but it makes sense.  See if I can implement it fairly quickly.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Dnereb

  • Guest
Re: Is there a better way to evaluate TextBox Value
« Reply #20 on: May 10, 2007, 09:55:27 AM »
If you get stuck on something just ask and you can mail me if no one reply's.
I'm not a frequent visitor on this forum so after a 48 hour silence.... info @ driesign .nl
without the spaces (added them to avoid mail adres leeching software)

have fun.