Return to Revisions

2 of 2

Simplified example a little. Removed TextBoxHandler class. Removed procedures from the IAdvTextBox interface that are used by the factory for initialization.

edited Jun 11, 2020 at 23:20

BZngr

edited Jun 11, 2020 at 23:20

BZngr

1.2k
7
9

The one class is trying to handle multiple types of textboxes. In this specific case it would seem a better approach to create a class for each textbox type. This keeps code specific to each textbox type very isolated, focused, and much more OO. So, how to get there...

Below is an example refactoring that creates two of the classes needed: DecimalDigitTextBox and EmailTextBox. A standard module AdvTextBoxFactory is introduced to hold the common enums and constants. As the name implies, the module also acts as a Factory to create the specific of textbox validator class that is needed. And, most importantly, an IAdvTextBox interface is defined so that each textbox class can look the same for client code. Hope you find this useful.

IAdvTextBox

Public Function Validate() As Boolean
End Function
Public Property Get TextBoxType() As TextBoxTypes
End Property
Public Property Get MaxValue() As Double
End Property
Public Property Let MaxValue(ByVal value As Double)
End Property
Public Property Get MinValue() As Double
End Property
Public Property Let MinValue(ByVal value As Double)
End Property
Public Property Get FixedFormat() As Boolean
End Property
Public Property Let FixedFormat(ByVal value As Boolean)
End Property
Public Property Get ToCase() As DesiredCase
End Property
Public Property Let ToCase(ByVal value As DesiredCase)
End Property
Public Property Get InvalidValueMessage() As String
End Property
Public Property Let InvalidValueMessage(ByVal value As String)
End Property
Public Property Get IsValid() As Boolean
End Property
Public Property Let IsValid(ByVal value As Boolean)
End Property
Public Property Get ShowValidityThrough() As ValidityProperty
End Property
Public Property Let ShowValidityThrough(ByVal value As ValidityProperty)
End Property
Public Property Get ValidColor() As Long
End Property
Public Property Let ValidColor(ByVal value As Long)
End Property
Public Property Get InvalidColor() As Long
End Property
Public Property Let InvalidColor(ByVal value As Long)
End Property
Public Property Get Enlarged() As Boolean
End Property
Public Property Let Enlarged(ByVal value As Boolean)
End Property
Public Property Get AllowedCharacters() As String
End Property
Public Property Let AllowedCharacters(ByVal value As String)
End Property

AdvTextBoxFactory

Option Explicit
Public Type TAdvTextBox
 TextBoxType As TextBoxTypes
 MaxValue As Double
 MinValue As Double
 FixedFormat As Boolean
 ToCase As DesiredCase
 InvalidValueMessage As String
 IsValid As Boolean
 ShowValidityThrough As ValidityProperty
 ValidColor As Long
 InvalidColor As Long
 AllowedCharacters As String
 outputFormat As String
 DecimalSeparator As String
 Enlarged As Boolean
End Type
Public Enum TextBoxTypes
 ShortText = 0
 Notes = 1
 Iban = 10
 ItalianVatNumber = 11
 Email = 12
 WholeNumber = 20
 Decimal1Digit = 21
 Decimal2Digit = 22
 Decimal3Digit = 23
 Decimal4Digit = 24
 Decimal5Digit = 25
 Decimal6Digit = 26
End Enum
Public Enum DesiredCase
 Normal = 0
 UpperCase = 1
 LowerCase = 2
 ProperCase = 3
End Enum
Public Enum ValidityProperty
 NoOne = 0
 vBorders = 1
 vBackColor = 2
 vForeColor = 3
End Enum
' constants
Public Const numbers As String = "0123456789"
Public Const letters As String = "abcdefghijklmnopqrstuvwxyz"
Public Const accented As String = "èéàòì"
Public Const numberPunctuation As String = ",."
Public Const otherPunctuation As String = " !?=_/|-@€+"
Public Const defaultInvalidColor As Long = &H5F5BDD
Public Function Create(ByVal obj As MSForms.TextBox, _
 ByVal txtType As TextBoxTypes) As IAdvTextBox
 
 Dim advTxtBox As IAdvTextBox
 
 Select Case txtType
 Case ShortText
 'TODO
 Case Notes
 'TODO
 Case Iban
 'TODO
 Case ItalianVatNumber
 'TODO
 Case Email
 Dim emTxtBox As EmailTextBox
 Set emTxtBox = New EmailTextBox
 emTxtBox.ConnectToTextBox obj
 Set advTxtBox = emTxtBox
 Case WholeNumber
 'TODO
 Case Decimal1Digit, Decimal2Digit, Decimal3Digit, Decimal4Digit, Decimal5Digit, Decimal6Digit
 Dim ddTextBox As DecimalDigitTextBox
 Set ddTextBox = New DecimalDigitTextBox
 ddTextBox.SetupDecimalDigits txtType
 ddTextBox.ConnectToTextBox obj
 Set advTxtBox = ddTextBox
 Case Else
 'throw an error
 End Select
 
 Select Case advTxtBox.ShowValidityThrough
 Case NoOne, vBackColor
 advTxtBox.ValidColor = obj.BackColor
 Case vBorders
 advTxtBox.ValidColor = obj.BorderColor
 Case vForeColor
 advTxtBox.ValidColor = obj.ForeColor
 End Select
 advTxtBox.InvalidColor = defaultInvalidColor
 Set Create = advTxtBox
End Function

DecimalDigitTextBox

Option Explicit
Private WithEvents txt As MSForms.TextBox
Implements IAdvTextBox
Private this As TAdvTextBox
Private pDecimalDigitsDivisor As Long
Private pAllowEvents As Boolean
Private Sub Class_Initialize()
 pAllowEvents = True
 this.DecimalSeparator = Application.DecimalSeparator
 this.FixedFormat = True
 this.ShowValidityThrough = NoOne
 this.ToCase = Normal
 this.ValidColor = -1
 this.InvalidColor = -1
 
 'factory updates with correct values in SetupDecimalDigits
 this.TextBoxType = Decimal1Digit
 this.outputFormat = "#,##0.0"
 pDecimalDigitsDivisor = 10
End Sub
Public Sub ConnectToTextBox(txtBox As MSForms.TextBox)
 Set txt = txtBox
 
 this.AllowedCharacters = numbers & IIf(this.FixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 txt.text = 0
End Sub
Public Sub SetupDecimalDigits(ByVal txtType As TextBoxTypes)
 this.TextBoxType = txtType
 Select Case txtType
 Case Decimal1Digit
 this.outputFormat = "#,##0.0"
 pDecimalDigitsDivisor = 10
 Case Decimal2Digit
 this.outputFormat = "#,##0.00"
 pDecimalDigitsDivisor = 100
 Case Decimal3Digit
 this.outputFormat = "#,##0.000"
 pDecimalDigitsDivisor = 1000
 Case Decimal4Digit
 this.outputFormat = "#,##0.0000"
 pDecimalDigitsDivisor = 10000
 Case Decimal5Digit
 this.outputFormat = "#,##0.00000"
 pDecimalDigitsDivisor = 100000
 Case Decimal6Digit
 this.outputFormat = "#,##0.000000"
 pDecimalDigitsDivisor = 1000000
 Case Else
 'throw an error
 End Select
End Sub
Private Sub txt_Change()
 
 If Not pAllowEvents Then Exit Sub
 
 pAllowEvents = False
 
 Dim valore As Variant
 valore = Replace(Replace(txt.text, ",", vbNullString), ".", vbNullString)
 
 If valore = vbNullString Then valore = 0
 
 valore = CDbl(valore) / pDecimalDigitsDivisor
 
 txt.text = CStr(valore)
 
 pAllowEvents = True
 
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If KeyAscii = 45 Then
 txt.text = CDbl(txt.text) * -1
 End If
 
 If Not KeyAscii = 8 Then
 If InStr(1, this.AllowedCharacters, Chr(KeyAscii), vbTextCompare) = 0 Then KeyAscii = 0
 End If
End Sub
Private Sub ColorTextBox(validity As Boolean)
 If (Not this.ShowValidityThrough = NoOne) And (Not txt Is Nothing) Then
 
 Dim color As Long
 color = IIf(validity, this.ValidColor, this.InvalidColor)
 
 Select Case this.ShowValidityThrough
 Case vBackColor
 txt.BackColor = color
 Case vBorders
 txt.BorderStyle = fmBorderStyleSingle
 txt.BorderColor = color
 txt.Width = txt.Width + IIf(this.Enlarged, -0.1, 0.1)
 this.Enlarged = Not this.Enlarged
 Case vForeColor
 txt.ForeColor = color
 End Select
 End If
End Sub
Private Function IAdvTextBox_Validate() As Boolean
 ColorTextBox this.IsValid
 If (Not this.IsValid) And (Not this.InvalidValueMessage = vbNullString) Then MsgBox this.InvalidValueMessage, vbInformation, "Invalid value"
 IAdvTextBox_Validate = this.IsValid
End Function
Private Property Get IAdvTextBox_TextBoxType() As TextBoxTypes
 IAdvTextBox_TextBoxType = this.TextBoxType
End Property
Private Property Get IAdvTextBox_MaxValue() As Double
 IAdvTextBox_MaxValue = this.MaxValue
End Property
Private Property Let IAdvTextBox_MaxValue(ByVal value As Double)
 this.MaxValue = value
End Property
Private Property Get IAdvTextBox_MinValue() As Double
 IAdvTextBox_MinValue = this.MinValue
End Property
Private Property Let IAdvTextBox_MinValue(ByVal value As Double)
 this.MinValue = value
End Property
Private Property Get IAdvTextBox_FixedFormat() As Boolean
 IAdvTextBox_FixedFormat = this.FixedFormat
End Property
Private Property Let IAdvTextBox_FixedFormat(ByVal value As Boolean)
 this.FixedFormat = value
End Property
Private Property Get IAdvTextBox_ToCase() As DesiredCase
 IAdvTextBox_ToCase = this.ToCase
End Property
Private Property Let IAdvTextBox_ToCase(ByVal value As DesiredCase)
 this.ToCase = value
End Property
Private Property Get IAdvTextBox_InvalidValueMessage() As String
 IAdvTextBox_InvalidValueMessage = this.InvalidValueMessage
End Property
Private Property Let IAdvTextBox_InvalidValueMessage(ByVal value As String)
 this.InvalidValueMessage = value
End Property
Private Property Get IAdvTextBox_IsValid() As Boolean
 IAdvTextBox_IsValid = this.IsValid
End Property
Private Property Let IAdvTextBox_IsValid(ByVal value As Boolean)
 this.IsValid = value
 ColorTextBox this.IsValid
End Property
Private Property Get IAdvTextBox_ShowValidityThrough() As ValidityProperty
 IAdvTextBox_ShowValidityThrough = this.ShowValidityThrough
End Property
Private Property Let IAdvTextBox_ShowValidityThrough(ByVal value As ValidityProperty)
 this.ShowValidityThrough = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_ValidColor() As Long
 IAdvTextBox_ValidColor = this.ValidColor
End Property
Private Property Let IAdvTextBox_ValidColor(ByVal value As Long)
 this.ValidColor = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_InvalidColor() As Long
 IAdvTextBox_InvalidColor = this.InvalidColor
End Property
Private Property Let IAdvTextBox_InvalidColor(ByVal value As Long)
 this.InvalidColor = value
End Property
Private Property Get IAdvTextBox_Enlarged() As Boolean
 IAdvTextBox_Enlarged = this.Enlarged
End Property
Private Property Let IAdvTextBox_Enlarged(ByVal value As Boolean)
 this.Enlarged = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_AllowedCharacters() As String
 IAdvTextBox_AllowedCharacters = this.AllowedCharacters
End Property
Private Property Let IAdvTextBox_AllowedCharacters(ByVal value As String)
 this.AllowedCharacters = value
End Property

EmailTextBox

Option Explicit
Implements IAdvTextBox
Private WithEvents txt As MSForms.TextBox
Private this As TAdvTextBox
Private pAllowEvents As Boolean
Private Sub Class_Initialize()
 pAllowEvents = True
 this.DecimalSeparator = Application.DecimalSeparator
 this.FixedFormat = True
 this.ShowValidityThrough = NoOne
 this.ToCase = Normal
 this.ValidColor = -1
 this.InvalidColor = -1
 this.TextBoxType = Email
End Sub
Private Function IsValidEmail(ByVal emailAddress As String) As Boolean
 
 IsValidEmail = False
 
 Const emailPattern As String = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
 
 With CreateObject("VBScript.RegExp")
 .Global = True
 .IgnoreCase = True
 .Pattern = emailPattern
 IsValidEmail = .Test(emailAddress)
 End With
 
End Function
Public Sub ConnectToTextBox(txtBox As MSForms.TextBox)
 Set txt = txtBox
End Sub
Private Sub txt_Change()
 
 If Not pAllowEvents Then Exit Sub
 
 pAllowEvents = False
 
 Dim valore As Variant
 valore = txt.text
 
 this.IsValid = IsValidEmail(valore)
 
 valore = LCase(valore)
 
 txt.text = valore
 
 pAllowEvents = True
 
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If Not KeyAscii = 8 Then
 If InStr(1, this.AllowedCharacters, Chr(KeyAscii), vbTextCompare) = 0 Then KeyAscii = 0
 End If
End Sub
Private Sub ColorTextBox(validity As Boolean)
 If (Not this.ShowValidityThrough = NoOne) And (Not txt Is Nothing) Then
 
 Dim color As Long
 color = IIf(validity, this.ValidColor, this.InvalidColor)
 
 Select Case this.ShowValidityThrough
 Case vBackColor
 txt.BackColor = color
 Case vBorders
 txt.BorderStyle = fmBorderStyleSingle
 txt.BorderColor = color
 txt.Width = txt.Width + IIf(this.Enlarged, -0.1, 0.1)
 this.Enlarged = Not this.Enlarged
 Case vForeColor
 txt.ForeColor = color
 End Select
 End If
End Sub
Private Function IAdvTextBox_Validate() As Boolean
 ColorTextBox this.IsValid
 If (Not this.IsValid) And (Not this.InvalidValueMessage = vbNullString) Then MsgBox this.InvalidValueMessage, vbInformation, "Invalid value"
 IAdvTextBox_Validate = this.IsValid
End Function
Private Property Get IAdvTextBox_TextBoxType() As TextBoxTypes
 IAdvTextBox_TextBoxType = this.TextBoxType
End Property
Private Property Get IAdvTextBox_MaxValue() As Double
 IAdvTextBox_MaxValue = this.MaxValue
End Property
Private Property Let IAdvTextBox_MaxValue(ByVal value As Double)
 this.MaxValue = value
End Property
Private Property Get IAdvTextBox_MinValue() As Double
 IAdvTextBox_MinValue = this.MinValue
End Property
Private Property Let IAdvTextBox_MinValue(ByVal value As Double)
 this.MinValue = value
End Property
Private Property Get IAdvTextBox_FixedFormat() As Boolean
 IAdvTextBox_FixedFormat = this.FixedFormat
End Property
Private Property Let IAdvTextBox_FixedFormat(ByVal value As Boolean)
 this.FixedFormat = value
End Property
Private Property Get IAdvTextBox_ToCase() As DesiredCase
 IAdvTextBox_ToCase = this.ToCase
End Property
Private Property Let IAdvTextBox_ToCase(ByVal value As DesiredCase)
 this.ToCase = value
End Property
Private Property Get IAdvTextBox_InvalidValueMessage() As String
 IAdvTextBox_InvalidValueMessage = this.InvalidValueMessage
End Property
Private Property Let IAdvTextBox_InvalidValueMessage(ByVal value As String)
 this.InvalidValueMessage = value
End Property
Private Property Get IAdvTextBox_IsValid() As Boolean
 IAdvTextBox_IsValid = this.IsValid
End Property
Private Property Let IAdvTextBox_IsValid(ByVal value As Boolean)
 this.IsValid = value
 ColorTextBox this.IsValid
End Property
Private Property Get IAdvTextBox_ShowValidityThrough() As ValidityProperty
 IAdvTextBox_ShowValidityThrough = this.ShowValidityThrough
End Property
Private Property Let IAdvTextBox_ShowValidityThrough(ByVal value As ValidityProperty)
 this.ShowValidityThrough = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_ValidColor() As Long
 IAdvTextBox_ValidColor = this.ValidColor
End Property
Private Property Let IAdvTextBox_ValidColor(ByVal value As Long)
 this.ValidColor = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_InvalidColor() As Long
 IAdvTextBox_InvalidColor = this.InvalidColor
End Property
Private Property Let IAdvTextBox_InvalidColor(ByVal value As Long)
 this.InvalidColor = value
End Property
Private Property Get IAdvTextBox_Enlarged() As Boolean
 IAdvTextBox_Enlarged = this.Enlarged
End Property
Private Property Let IAdvTextBox_Enlarged(ByVal value As Boolean)
 this.Enlarged = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_AllowedCharacters() As String
 IAdvTextBox_AllowedCharacters = this.AllowedCharacters
End Property
Private Property Let IAdvTextBox_AllowedCharacters(ByVal value As String)
 this.AllowedCharacters = value
End Property

answered Jun 11, 2020 at 14:38

BZngr

1.2k
7
9

default