'Advance Text Box.
'It can act like a numeric text box, currency box, or email box.
'
'As EMail Box.
'-------------
'It Will not Allow the the non email characters and allow only the small case letters
'underscore, dot (.), @ in the text box.
'It Will Not Allow Two Consecutive @,. (like @@, .., @. , __)
'It Will Allow only a letter as the first character.
'Add Much more checking.
'if you set the check
'
'
'----------------------------------------------------------------
Option Strict On
#Region " Import Statements"
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System
Imports System.Drawing
#End Region
Public Class AdvTextBox
Inherits TextBox
#Region " Component Designer generated code "
Public Sub New(ByVal Container As System.ComponentModel.IContainer)
MyClass.New()
'Required for Windows.Forms Class Composition Designer support
Container.Add(Me)
End Sub
Public Sub New()
MyBase.New()
'This call is required by the Component Designer.
InitializeComponent()
'Add any initialization after the InitializeComponent() call
End Sub
'Component overrides dispose to clean up the component list.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Required by the Component Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Component Designer
'It can be modified using the Component Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
components = New System.ComponentModel.Container()
End Sub
#End Region
#Region " Class Variables"
Enum TextBoxType As Byte
DefaultBox = 0
NumericBox = 1
CurrencyBox = 2
EMailBox = 4
PhoneBox = 5
MailIDBox = 6
EMail_IDBox = 7
End Enum
Private _TextBoxType As TextBoxType = TextBoxType.DefaultBox
Private _ValidateData As Boolean = False
Private _WarningBackColor As Color = Color.Yellow
Private _BackColor As Color = Me.BackColor
Private _ValidFlag As Boolean = True
'Flat Text Box Used Variables.
Public Const WM_PAINT As Integer = &HF
Private mblnHighlight As Boolean = True
Private mclrHighlight As Color = SystemColors.Highlight
Private mclrBorder As Color = SystemColors.ControlDark
#End Region
#Region " DLL Declaration "
'This DLL Imports are needed for to make Flat Text Box.
<StructLayout(LayoutKind.Sequential)> _
Public Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<DllImport("User32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("User32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function GetWindowDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("User32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef rect As RECT) As Boolean
End Function
#End Region
#Region " Flat Textbox Code"
Protected Overrides Sub OnMouseEnter(ByVal e As System.EventArgs)
MyBase.OnMouseEnter(e)
If mblnHighlight Then Invalidate()
End Sub
Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs)
MyBase.OnMouseLeave(e)
If mblnHighlight Then Invalidate()
End Sub
Protected Overrides Sub OnLostFocus(ByVal e As System.EventArgs)
MyBase.OnLostFocus(e)
If mblnHighlight Then Invalidate()
End Sub
Protected Overrides Sub OnGotFocus(ByVal e As System.EventArgs)
MyBase.OnGotFocus(e)
If mblnHighlight Then Invalidate()
End Sub
Protected Overrides Sub OnBackColorChanged(ByVal e As System.EventArgs)
MyBase.OnBackColorChanged(e)
If mblnHighlight Then Invalidate()
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg <> WM_PAINT Then Return
Dim wrec As RECT
GetWindowRect(Handle, wrec)
Dim recF As New RectangleF(0.0F, 0.0F, wrec.Right - wrec.Left, wrec.Bottom - wrec.Top)
Dim hDc As IntPtr = GetWindowDC(Handle)
With Graphics.FromHdc(hDc)
Dim pen As Pen
Dim blnHighlight As Boolean = Not DesignMode AndAlso mblnHighlight AndAlso (Focused OrElse ClientRectangle.Contains(PointToClient(MousePositi on)))
If Me.ReadOnly OrElse Not Enabled Then
.FillRectangle(SystemBrushes.Window, recF)
If Text <> String.Empty Then
Dim sf As New StringFormat()
If Not Multiline AndAlso AutoSize Then sf.LineAlignment = StringAlignment.Center
Select Case TextAlign
Case HorizontalAlignment.Center
sf.Alignment = StringAlignment.Center
Case HorizontalAlignment.Right
sf.Alignment = StringAlignment.Far
End Select
Dim strText As String
If Multiline OrElse PasswordChar = Char.MinValue Then
strText = Text
Else
strText = New String(PasswordChar, Text.Length)
End If
If Me.ReadOnly AndAlso Enabled Then
Dim brush As New SolidBrush(ForeColor)
.DrawString(strText, Font, brush, recF, sf)
brush.Dispose()
If blnHighlight Then
pen = New Pen(mclrHighlight)
Else
pen = New Pen(mclrBorder)
End If
Else
.DrawString(strText, Font, SystemBrushes.ControlDark, recF, sf)
pen = New Pen(mclrBorder)
End If
sf.Dispose()
Else
pen = New Pen(mclrBorder)
End If
Else
pen = New Pen(SystemBrushes.Window)
.DrawRectangle(pen, 1.0F, 1.0F, recF.Width - 3.0F, recF.Height - 3.0F)
pen.Dispose()
If blnHighlight Then
pen = New Pen(mclrHighlight)
Else
pen = New Pen(mclrBorder)
End If
End If
.DrawRectangle(pen, 0.0F, 0.0F, recF.Width - 1.0F, recF.Height - 1.0F)
pen.Dispose()
.Dispose()
End With
ReleaseDC(Handle, hDc)
End Sub
<DefaultValue(True), Category("Behavior"), Description("Indicates whether the control will have its border highlighted " & _
"when it receives focus or the mouse pointer enters its client rectangle. The default value is True.")> _
Public Property HighlightBorder() As Boolean
Get
Return mblnHighlight
End Get
Set(ByVal Value As Boolean)
If Value = mblnHighlight Then Return
mblnHighlight = Value
If Not DesignMode Then Invalidate()
End Set
End Property
<Category("Appearance"), Description("The color of the control's border when it receives focus or the mouse pointer enters its client rectangle.")> _
Public Property HighlightColor() As Color
Get
Return mclrHighlight
End Get
Set(ByVal Value As Color)
If Value.Equals(mclrHighlight) Then Return
mclrHighlight = Value
If Not DesignMode AndAlso mblnHighlight Then Invalidate()
End Set
End Property
<EditorBrowsable(EditorBrowsableState.Never)> _
Public Function ShouldSerializeHighlightColor() As Boolean
Return Not mclrHighlight.Equals(SystemColors.Highlight)
End Function
<Category("Appearance"), Description("The color of the control's border.")> _
Public Property BorderColor() As Color
Get
Return mclrBorder
End Get
Set(ByVal Value As Color)
If Value.Equals(mclrBorder) Then Return
mclrBorder = Value
Invalidate()
End Set
End Property
<EditorBrowsable(EditorBrowsableState.Never)> _
Public Function ShouldSerializeBorderColor() As Boolean
Return Not mclrBorder.Equals(SystemColors.ControlDark)
End Function
<Browsable(False)> _
Public Shadows ReadOnly Property BorderStyle() As BorderStyle
Get
Return MyBase.BorderStyle
End Get
End Property
#End Region
#Region " Class Properties"
<DefaultValue(TextBoxType.DefaultBox), _
Description("Enter The Type of the Textbox")> _
Public Property TextBoxFormat() As TextBoxType
Get
Return _TextBoxType
End Get
Set(ByVal Value As TextBoxType)
_TextBoxType = Value
End Set
End Property
<DefaultValue(False), _
Description("Select whether validate the entered data")> _
Public Property ValidateData() As Boolean
Get
Return _ValidateData
End Get
Set(ByVal Value As Boolean)
_ValidateData = Value
End Set
End Property
<Description("Change the Color of the background when a wrong entry is made")> _
Public Property WrongDataBackColor() As Color
Get
Return _WarningBackColor
End Get
Set(ByVal Value As Color)
_WarningBackColor = Value
End Set
End Property
<Description("Data Status , whether it is valid or not")> _
Public ReadOnly Property DataValid() As Boolean
Get
Return _ValidFlag
End Get
End Property
#End Region
#Region " Class Procudures "
Private Sub AdvTextBox_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Leave
If _ValidateData Then
If _TextBoxType = TextBoxType.EMailBox Then
If Not isEMailData(Me.Text) Then
MessageBox.Show("Wrong EMail Data, Check It.", "Wrong EMail", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Me.Focus()
End If
End If
End If
Select Case _TextBoxType
Case TextBoxType.DefaultBox
'Do Nothing Act Like a general text box
Case TextBoxType.NumericBox
Case TextBoxType.CurrencyBox
Me.Text = Format(Val(Me.Text), "0.00")
Case TextBoxType.EMailBox
_ValidFlag = isEMailData(Me.Text)
If _ValidFlag Then
Me.BackColor = _BackColor
Else
Me.BackColor = _WarningBackColor
End If
Case TextBoxType.EMail_IDBox
If InStr(Me.Text, "@") > 0 Then
_ValidFlag = isEMailData(Me.Text)
If _ValidFlag Then
Me.BackColor = _BackColor
Else
Me.BackColor = _WarningBackColor
End If
End If
End Select
End Sub
Private Sub AdvTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
Select Case _TextBoxType
Case TextBoxType.DefaultBox
'Do Nothing Act Like a general text box
Case TextBoxType.NumericBox
e.Handled = AcceptNumber(Asc(e.KeyChar), Me.Text)
Case TextBoxType.CurrencyBox
e.Handled = AcceptCurrency(Asc(e.KeyChar), Me)
Case TextBoxType.EMailBox, TextBoxType.EMail_IDBox
e.Handled = CheckEmailCharacter(Asc(e.KeyChar), Me)
Case TextBoxType.PhoneBox
e.Handled = CheckPhoneCharacter(Asc(e.KeyChar))
Case TextBoxType.MailIDBox
e.Handled = CheckEmailIDCharacter(Asc(e.KeyChar), Me)
End Select
End Sub
Private Sub AdvTextBox_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.TextChanged
If Me.Text.Length = 0 Then
Me.BackColor = _BackColor
_ValidFlag = True
End If
End Sub
Private Function CheckEmailIDCharacter(ByVal asciiValue As Integer, ByRef txtBox As TextBox) As Boolean
'1 - Allow only the Lower case Character, underscore and one "@" , "." character in the Email fields.
'2 - All other characters are cancelled
'3 - Alphabet are automatically to lower case if entered in upper case
'48 - 57 are the ascii value of numbers(0-9)
'97-122 are the ascii value of lower case alphabet (a-z)
'46 ascii value of "."
'95 ascii value of "_"
'64 ascii value of "@"
'8 ascii value of Back space key
'Allow the digits, small alphabet letters, back space and underscore.
If (asciiValue >= 48 And asciiValue <= 57) Or asciiValue = 8 Or _
(asciiValue >= 97 And asciiValue <= 122) Then
'Allow these characters.
'ElseIf asciiValue >= 65 And asciiValue <= 90 Then
' asciiValue = asciiValue + 32
ElseIf asciiValue = 46 Then '46 - Aschii Value of "."
'If the user entering the "." as the first character then cancel it.
If Me.SelectionStart = 0 Then
Beep()
Return True
End If
'Do not Allow two consecutive "." Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = ".") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = ".") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = ".") Then
Return True
End If
End If
ElseIf asciiValue = 95 Then '95 - is the Ascii Value of ("_") Underscore
'If the user entering the "_" as the first character then cancel it.
If Me.SelectionStart = 0 Then
Beep()
Return True
End If
'Do not Allow consecutive "_" and "@" Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = "@") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = "@") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = "@") Then
Return True
End If
End If
'Do not Allow two consecutive "_" Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = "_") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = "_") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = "_") Then
Return True
End If
End If
Else
Beep()
Return True
End If
'If the Character entered is a valid character depending on the position then
'Return False. False allow to accept the character.
Return False
End Function
Private Function CheckPhoneCharacter(ByVal KeyAscii As Integer) As Boolean
CheckPhoneCharacter = True
Select Case Chr(KeyAscii)
Case "("c, ")"c, "/"c, ","c, "+"c, "-"c, " "c, "#"c
Return False
Case Else
Return AcceptNumber(KeyAscii, "")
End Select
End Function
Private Function AcceptNumber(ByVal KeyAscii As Integer, ByVal strText As String) As Boolean
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
Return True
End If
Return False
End Function
'This Function Accept the ascii value and existing text of the text field and check whether
'the key pressed is accepted in the currency field. If not then it will return true else the
'false.
Private Function AcceptCurrency(ByVal KeyAscii As Integer, ByRef txtBox As TextBox) As Boolean
If (KeyAscii > 48 And KeyAscii <= 57) Then
Return False
ElseIf KeyAscii = 48 Then ' 48 is the ascii value of 0
If Me.SelectionStart = 0 Then
Beep()
Return True
End If
Return False
ElseIf KeyAscii = 8 Then
Return False
ElseIf KeyAscii = 46 Then
''If the user entering the "." as the first character then cancel it.
'If Me.SelectionStart = 0 Then
' Beep()
' Return True
'End If
If InStr(1, txtBox.Text, ".") > 0 Then
Beep()
Return True
End If
Else
Beep()
Return True
End If
Return False
End Function
'Allow the characters that are acceptable in a email fields.
Private Function CheckEmailCharacter(ByVal asciiValue As Integer, ByRef txtBox As TextBox) As Boolean
'1 - Allow only the Lower case Character, underscore and one "@" , "." character in the Email fields.
'2 - All other characters are cancelled
'3 - Alphabet are automatically to lower case if entered in upper case
'48 - 57 are the ascii value of numbers(0-9)
'97-122 are the ascii value of lower case alphabet (a-z)
'46 ascii value of "."
'95 ascii value of "_"
'64 ascii value of "@"
'8 ascii value of Back space key
'Allow the digits, small alphabet letters, back space and underscore.
If (asciiValue >= 48 And asciiValue <= 57) Or asciiValue = 8 Or _
(asciiValue >= 97 And asciiValue <= 122) Then
'Allow these characters.
'ElseIf asciiValue >= 65 And asciiValue <= 90 Then
' asciiValue = asciiValue + 32
ElseIf asciiValue = 64 Then ' 64 - Ascii value of "@"
'If the user entering the "@" as first character, then cancel it.
If Me.SelectionStart = 0 Then
Beep()
Return True
End If
'Do not Allow two consecutive "." Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = ".") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = ".") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = ".") Then
Return True
End If
End If
'If There is already a "@" character present in the text box then don't allow
'to enter another "@" Character.
If InStr(1, txtBox.Text, "@") > 0 Then
Beep()
Return True
End If
ElseIf asciiValue = 46 Then '46 - Aschii Value of "."
'If the user entering the "." as the first character then cancel it.
If Me.SelectionStart = 0 Then
Beep()
Return True
End If
'Do not Allow consecutive "." and "@" Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = "@") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = "@") Then
Return True
End If
If Me.SelectionLength > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = "@") Then
Return True
End If
End If
'Do not Allow two consecutive "." Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = ".") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = ".") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = ".") Then
Return True
End If
End If
ElseIf asciiValue = 95 Then '95 - is the Ascii Value of ("_") Underscore
'If the user entering the "_" as the first character then cancel it.
If Me.SelectionStart = 0 Then
Beep()
Return True
End If
'Do not Allow consecutive "_" and "@" Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = "@") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = "@") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = "@") Then
Return True
End If
End If
'Do not Allow two consecutive "_" Characterss.
If (Mid(Me.Text, Me.SelectionStart + 1, 1) = "_") Or _
(Mid(Me.Text, Me.SelectionStart, 1) = "_") Then
Return True
End If
If Me.SelectionStart > 1 Then
If (Mid(Me.Text, Me.SelectionStart - 1, 1) = "_") Then
Return True
End If
End If
Else
Beep()
Return True
End If
'If the Character entered is a valid character depending on the position then
'Return False. False allow to accept the character.
Return False
End Function
'Check the passed string is a valid email string
'Return true if the string is a valid email
'else returns false
Private Function isEMailData(ByVal strData As String) As Boolean
isEMailData = False
If strData.Length > 0 Then
'Last Character should not be either <.>, <_>, <@>
Select Case Mid(strData, strData.Length, 1)
Case ".", "@", "_"
Return False
End Select
'If There is no @ or No . character then Return False
If InStr(1, strData, "@") <= 0 Or InStr(1, strData, ".") <= 0 Then
Beep()
'Do nothing because the isEMail value is set to false in the first statement
ElseIf InStr(InStr(1, strData, "@"), strData, ".") <= 0 Then ''After @ ther should be atleast one <.>
'Do Nothing (Not a valid Email)
ElseIf Mid(strData, InStrRev(strData, ".")).Length <= 2 Or Mid(strData, InStrRev(strData, ".")).Length > 4 Then
'If there is not 2,3 characters after the last . of the email then the mail
'is not a valid mail.
Return False
Else
'check the <@> and <.> character must not be first character
If InStr(1, strData, "@") > 1 And InStr(1, strData, ".") > 1 Then
Return True
Else
Dim intX As Integer = InStr(1, strData, "@")
If InStr(intX, strData, "@") = 0 Then
Return True
End If
End If
End If
Else 'If there is no data then return true
Return True
End If
End Function
#End Region
End Class
how i use this text box in my proj
user control
