VB icon

Adv TextBox

Email
Submitted on: 2/15/2015 1:04:00 AM
By: Shoaib Mahmood (from psc cd)  
Level: Beginner
User Rating: By 4 Users
Compatibility: VB 6.0
Views: 2901
 
     This is new Text Box. You can Select Propertics and Select Char, Decimal , Email Type of Data Esally. You add a ActiveX control; In a New Project Window . Add text Box on your Form . and Copy this code and Paste Code View. and in the end u create OCX from File Menu. after creating OCX u can Use Very esally.

 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Adv TextBox
' Description:This is new Text Box. You can Select Propertics and Select Char, Decimal , Email Type of Data Esally. You add a ActiveX control; In a New Project Window . Add text Box on your Form . and Copy this code and Paste Code View. and in the end u create OCX from File Menu. after creating OCX u can Use Very esally.
' By: Shoaib Mahmood (from psc cd)
'**************************************

Enum DTypes
MyChar = 0
MyInt = 1
MyMix = 2
MyDecimal = 3
MyPhone = 4
MyEmail = 5
MyNone = 6
MyIntChar = 7
End Enum
'Default Property Values:
Const m_def_DataType = 0
Event Change() 'MappingInfo=Text1,Text1,-1,Change
'Property Variables:
Dim m_DataType As Integer
Private Sub Text1_GotFocus()
Text1.SelStart = 0: Text1.SelLength = Len(Text1)
'Command1.Visible = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If m_DataType = 0 Then
If Not IsChar(KeyAscii) Then KeyAscii = 0
ElseIf m_DataType = 1 Then
If Not IsInt(KeyAscii) Then KeyAscii = 0
ElseIf m_DataType = 2 Then
If Not IsMix(KeyAscii) Then KeyAscii = 0
ElseIf m_DataType = 3 Then
If IsDecimal(KeyAscii) Then
If Not IsProperDecimal(Text1 + Chr(KeyAscii)) Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
ElseIf m_DataType = 4 Then
If Not IsPhone(KeyAscii) Then KeyAscii = 0
ElseIf m_DataType = 5 Then
If Not IsEmail(KeyAscii) Then KeyAscii = 0
ElseIf m_DataType = 6 Then
'Do Nothing
ElseIf m_DataType = 7 Then
If Not IsIntChar(KeyAscii) Then KeyAscii = 0
End If
End Sub
'Private Sub Text1_LostFocus()
'Command1.Visible = False
'End Sub
'Private Sub UserControl_KeyPress(KeyAscii As Integer)
'If KeyAscii = 13 Then
'SendKeys vbTab
'End If
'End Sub
Private Sub UserControl_Resize()
Text1.Width = UserControl.Width
UserControl.Height = Text1.Height
Command1.Top = Text1.Top + 10
Command1.Left = Text1.Width - 390
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_DataType = m_def_DataType
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
Text1.MaxLength = PropBag.ReadProperty("MaxLength", 0)
Text1.Text = PropBag.ReadProperty("Text", "")
m_DataType = PropBag.ReadProperty("DataType", m_def_DataType)
Text1.PasswordChar = PropBag.ReadProperty("PasswordChar", "")
Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
'Text1.Alignment = PropBag.ReadProperty("Alignment", 0)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("MaxLength", Text1.MaxLength, 0)
Call PropBag.WriteProperty("Text", Text1.Text, "")
Call PropBag.WriteProperty("DataType", m_DataType, m_def_DataType)
Call PropBag.WriteProperty("PasswordChar", Text1.PasswordChar, "")
Call PropBag.WriteProperty("BackColor", Text1.BackColor, &H80000005)
'Call PropBag.WriteProperty("Alignment", Text1.Alignment, 0)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,MaxLength
Public Property Get MaxLength() As Long
MaxLength = Text1.MaxLength
End Property
Public Property Let MaxLength(ByVal New_MaxLength As Long)
Text1.MaxLength() = New_MaxLength
PropertyChanged "MaxLength"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,Text
Public Property Get Text() As String
Text = Text1.Text
End Property
Public Property Let Text(ByVal New_Text As String)
Text1.Text() = New_Text
PropertyChanged "Text"
End Property
''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MemberInfo=7,3,0,0
Public Property Get DataType() As DTypes
DataType = m_DataType
End Property
Public Property Let DataType(ByVal New_DataType As DTypes)
m_DataType = New_DataType
PropertyChanged "DataType"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,PasswordChar
Public Property Get PasswordChar() As String
PasswordChar = Text1.PasswordChar
End Property
Public Property Let PasswordChar(ByVal New_PasswordChar As String)
Text1.PasswordChar() = New_PasswordChar
PropertyChanged "PasswordChar"
End Property
Private Sub Text1_Change()
RaiseEvent Change
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
BackColor = Text1.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
Text1.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property
Function IsIntChar(a As Integer) As Boolean
If (a < 97 Or a > 122) And (a < 65 Or a > 90) And (a <> 8) And (a < 48 Or a > 57) Then
IsIntChar = False
Else
IsIntChar = True
End If
End Function
Function IsChar(a As Integer) As Boolean
If (a < 97 Or a > 122) And (a < 65 Or a > 90) And (a <> 8) And (a <> 32) Then
IsChar = False
Else
IsChar = True
End If
End Function
Function IsInt(a As Integer) As Boolean
If (a < 48 Or a > 57) And (a <> 8) Then
IsInt = False
Else
IsInt = True
End If
End Function
Function IsMix(a As Integer) As Boolean
If (a < 97 Or a > 122) And (a < 65 Or a > 90) And (a < 48 Or a > 57) And (a <> 8) And (a <> 32) And (a <> Asc("-")) And (a <> Asc(".")) Then
IsMix = False
Else
IsMix = True
End If
End Function
Function IsPhone(a As Integer) As Boolean
If (a < 48 Or a > 57) And (a <> 8) And (a <> Asc("-")) Then
IsPhone = False
Else
IsPhone = True
End If
End Function
Function IsEmail(a As Integer) As Boolean
If (a < 97 Or a > 122) And (a < 65 Or a > 90) And (a <> 8) And (a < 48 Or a > 57) And a <> Asc("-") And a <> Asc("@") And a <> Asc(".") Then
IsEmail = False
Else
IsEmail = True
End If
End Function
Function IsProperDecimal(No As String) As Boolean
Dim NoLen
Dim DotFlag
DotFlag = 0
NoLen = Len(No)
For i = 1 To NoLen
If Mid(No, i, 1) = "." Then DotFlag = DotFlag + 1
Next i
If DotFlag > 1 Then IsProperDecimal = False Else IsProperDecimal = True
End Function
Function IsDecimal(KeyAscii As Integer) As Boolean
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = Asc(".") Then
IsDecimal = True
Else
IsDecimal = False
End If
End Function


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.