www.pudn.com > advtext.zip > AdvText.ctl
VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.UserControl AdvText
ClientHeight = 1125
ClientLeft = 0
ClientTop = 0
ClientWidth = 2340
ScaleHeight = 1125
ScaleWidth = 2340
Begin MSMask.MaskEdBox TxtMas
Height = 375
Left = 240
TabIndex = 0
Top = 120
Width = 1455
_ExtentX = 2566
_ExtentY = 661
_Version = 393216
PromptChar = "_"
End
Begin VB.TextBox Text1
Height = 285
Left = 840
TabIndex = 1
Text = "Text1"
Top = 120
Width = 615
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 500
Left = 480
Top = 120
End
End
Attribute VB_Name = "AdvText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'Event Declarations:
Public Enum Typedata
Numeric = 1
AlphaNumeric = 2
Alpha = 3
TimeDate = 4
End Enum
Private Intmax As Integer
Public Enum TypeWarning
MessageBox = 1
ColorChange = 2
End Enum
Private bconcap As Boolean
Private strindex As String
Private BAllowNull As Boolean
Private enmdatatype As Typedata
Private enumalert As TypeWarning
Event Validate(Cancel As Boolean) 'MappingInfo=TxtMas,TxtMas,-1,Validate
Event ReadProperties(PropBag As PropertyBag) 'MappingInfo=UserControl,UserControl,-1,ReadProperties
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=TxtMas,TxtMas,-1,KeyDown
Event KeyPress(KeyAscii As Integer) 'MappingInfo=TxtMas,TxtMas,-1,KeyPress
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=TxtMas,TxtMas,-1,KeyUp
Event WriteProperties(PropBag As PropertyBag) 'MappingInfo=UserControl,UserControl,-1,WriteProperties
Const m_def_Title = "Error"
Const m_def_Button = 0
Const m_def_Message = "Error in Value Entered"
Const m_def_Text = ""
Dim m_Title As String
Dim m_Button As Integer
Dim m_Message As String
Dim m_Text As String
Private m_CheckIn As String
Private m_LookUp As Boolean
'Default Property Values:
Const m_def_ConvertEnter = 0
'Property Variables:
Dim m_ConvertEnter As Boolean
Private Sub Text1_GotFocus()
SendKeys "{tab}"
End Sub
Private Sub Timer1_Timer()
Static i As Boolean
If enumalert = ColorChange Then
If i = False Then
TxtMas.BackColor = vbRed
i = Not i
Else
TxtMas.BackColor = &H80000005
i = Not i
End If
Else
MsgBox m_Message, m_Button, m_Title
Timer1.Enabled = False
End If
End Sub
Private Sub UserControl_Initialize()
TxtMas.Left = 0
TxtMas.Top = 0
If Not enmdatatype = TimeDate Then
TxtMas.PromptChar = " "
End If
If enmdatatype = TimeDate Then
TxtMas.Mask = "##->???-####"
m_CheckIn = ""
m_LookUp = False
Else
TxtMas.Mask = ""
End If
End Sub
Private Sub UserControl_InitProperties()
BAllowNull = False
BbToData = False
enmdatatype = Numeric
enumalert = ColorChange
m_Text = m_def_Text
m_Title = m_def_Title
m_Button = m_def_Button
m_Message = m_def_Message
' m_DataIndex = m_def_DataIndex
m_ConvertEnter = m_def_ConvertEnter
End Sub
Private Sub UserControl_Resize()
TxtMas.Width = UserControl.Width
TxtMas.Height = UserControl.Height
End Sub
Private Sub TxtMas_Validate(Cancel As Boolean)
RaiseEvent Validate(Cancel)
If m_LookUp = True And Trim(m_CheckIn) <> "" Then
Dim arrtmp() As String
arrtmp = Split(m_CheckIn, ";", , vbTextCompare)
Dim i As Integer
For i = 0 To UBound(arrtmp)
If Trim$(TxtMas.Text) = arrtmp(i) Then
Exit Sub
End If
Next
Cancel = True
Timer1.Enabled = True
Exit Sub
End If
If BAllowNull = False Then
If enmdatatype <> TimeDate Then
If Trim(TxtMas.Text) = "" Then
Cancel = True
Timer1.Enabled = True
End If
Else
If IsDate(TxtMas.Text) = False Then
Cancel = True
Timer1.Enabled = True
End If
End If
End If
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
RaiseEvent ReadProperties(PropBag)
Set TxtMas.Font = PropBag.ReadProperty("Font", Ambient.Font)
TxtMas.ToolTipText = PropBag.ReadProperty("ToolTipText", "")
TxtMas.Enabled = PropBag.ReadProperty("Enabled", True)
TxtMas.MaxLength = PropBag.ReadProperty("MaxLength", 6)
enmdatatype = PropBag.ReadProperty("DataType", 1)
bconcap = PropBag.ReadProperty("ConvertToCapital", False)
BAllowNull = PropBag.ReadProperty("AllowNull", False)
m_Text = PropBag.ReadProperty("Text", m_def_Text)
enumalert = PropBag.ReadProperty("WarningType", 2)
m_Title = PropBag.ReadProperty("Title", m_def_Title)
m_Button = PropBag.ReadProperty("Button", m_def_Button)
m_Message = PropBag.ReadProperty("Message", m_def_Message)
BbToData = PropBag.ReadProperty("BindToData", False)
If enmdatatype = TimeDate Then
TxtMas.Mask = PropBag.ReadProperty("Format", "##->???-####")
Else
TxtMas.Mask = PropBag.ReadProperty("Format", "")
End If
m_DataIndex = PropBag.ReadProperty("DataIndex", "")
m_LookUp = PropBag.ReadProperty("LookUp", False)
m_CheckIn = PropBag.ReadProperty("CheckIn", "")
If m_LookUp = True Then
bconcap = False
End If
m_ConvertEnter = PropBag.ReadProperty("ConvertEnter", m_def_ConvertEnter)
End Sub
Private Sub TxtMas_KeyDown(KeyCode As Integer, Shift As Integer)
Timer1.Enabled = False
TxtMas.BackColor = &H80000005
RaiseEvent KeyDown(KeyCode, Shift)
If m_ConvertEnter = True And KeyCode = 13 Then
Call TxtMas_Validate(False)
If Timer1.Enabled = False Then
Text1.SetFocus
Else
Exit Sub
End If
End If
End Sub
Private Sub TxtMas_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
If bconcap = True And (enmdatatype = Alpha Or enmdatatype = AlphaNumeric) Then
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End If
If enmdatatype = Numeric Then
If KeyAscii < 48 Or KeyAscii > 57 Then
If Not KeyAscii = 8 Then
KeyAscii = 0
Else
KeyAscii = KeyAscii
End If
Else
KeyAscii = KeyAscii
End If
Exit Sub
End If
If enmdatatype = Alpha Then
Select Case KeyAscii
Case 8
KeyAscii = KeyAscii
Case 97 To 122
KeyAscii = KeyAscii
Case 65 To 90
KeyAscii = KeyAscii
Case Else
KeyAscii = 0
End Select
End If
If enmdatatype = AlphaNumeric Or enmdatatype = TimeDate Then
KeyAscii = KeyAscii
End If
End Sub
Private Sub TxtMas_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=TxtMas,TxtMas,-1,Font
Public Property Get Font() As Font
Set Font = TxtMas.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set TxtMas.Font = New_Font
PropertyChanged "Font"
End Property
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
RaiseEvent WriteProperties(PropBag)
Call PropBag.WriteProperty("Font", TxtMas.Font, Ambient.Font)
Call PropBag.WriteProperty("ToolTipText", TxtMas.ToolTipText, "")
Call PropBag.WriteProperty("Enabled", TxtMas.Enabled, True)
Call PropBag.WriteProperty("MaxLength", TxtMas.MaxLength, 6)
Call PropBag.WriteProperty("Datatype", enmdatatype, 1)
Call PropBag.WriteProperty("ConvertToCapital", bconcap, False)
Call PropBag.WriteProperty("BindToData", BbToData, False)
Call PropBag.WriteProperty("AllowNull", BAllowNull, False)
Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
Call PropBag.WriteProperty("WarningType", enumalert, 2)
Call PropBag.WriteProperty("Title", m_Title, m_def_Title)
Call PropBag.WriteProperty("Button", m_Button, m_def_Button)
Call PropBag.WriteProperty("Message", m_Message, m_def_Message)
Call PropBag.WriteProperty("Format", TxtMas.Mask, "")
Call PropBag.WriteProperty("DataSource", m_DataSource, Nothing)
Call PropBag.WriteProperty("DataSource", m_DataSource, Nothing)
Call PropBag.WriteProperty("DataIndex", m_DataIndex, "")
Call PropBag.WriteProperty("LookUp", m_LookUp, False)
Call PropBag.WriteProperty("CheckIn", m_CheckIn, "")
Call PropBag.WriteProperty("ConvertEnter", m_ConvertEnter, m_def_ConvertEnter)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=TxtMas,TxtMas,-1,ToolTipText
Public Property Get ToolTipText() As String
ToolTipText = TxtMas.ToolTipText
End Property
Public Property Let ToolTipText(ByVal New_ToolTipText As String)
TxtMas.ToolTipText() = New_ToolTipText
PropertyChanged "ToolTipText"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=TxtMas,TxtMas,-1,Enabled
Public Property Get Enabled() As Boolean
Enabled = TxtMas.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
TxtMas.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
Public Property Get DataType() As Typedata
Attribute DataType.VB_Description = "Numeric,Date,"
DataType = enmdatatype
End Property
Public Property Let DataType(ByVal vNewValue As Typedata)
enmdatatype = vNewValue
PropertyChanged "DataType"
End Property
Public Property Get WarningType() As TypeWarning
WarningType = enumalert
End Property
Public Property Let WarningType(ByVal vNewValue As TypeWarning)
enumalert = vNewValue
PropertyChanged "WarningType"
End Property
Public Property Get AllowNull() As Boolean
Attribute AllowNull.VB_Description = "Set It To False to Make Text box Entry Manadatory"
AllowNull = BAllowNull
End Property
Public Property Let AllowNull(ByVal vNewValue As Boolean)
BAllowNull = vNewValue
PropertyChanged "AllowNull"
End Property
Public Property Get MaxLength() As Integer
MaxLength = TxtMas.MaxLength
End Property
Public Property Let MaxLength(ByVal New_MaxLength As Integer)
TxtMas.MaxLength() = New_MaxLength
PropertyChanged "MaxLength"
End Property
Public Property Get ConvertToCapital() As Boolean
Attribute ConvertToCapital.VB_Description = "To convert All charcters to Capitals "
ConvertToCapital = bconcap
End Property
Public Property Let ConvertToCapital(ByVal vNewValue As Boolean)
bconcap = vNewValue
PropertyChanged "ConvertToCapital"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get Text() As String
Text = m_Text
End Property
Public Property Let Text(ByVal New_Text As String)
m_Text = New_Text
PropertyChanged "Text"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,Error
Public Property Get Title() As String
Title = m_Title
End Property
Public Property Let Title(ByVal New_Title As String)
m_Title = New_Title
PropertyChanged "Title"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,16
Public Property Get Button() As Integer
Attribute Button.VB_Description = "Number OF buttons displayed in Message Box When Error Occurs"
Button = m_Button
End Property
Public Property Let Button(ByVal New_Button As Integer)
m_Button = New_Button
PropertyChanged "Button"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,0
Public Property Get Message() As String
Message = m_Message
End Property
Public Property Let Message(ByVal New_Message As String)
m_Message = New_Message
PropertyChanged "Message"
End Property
Public Property Get Format() As String
Format = TxtMas.Mask
End Property
Public Property Let Format(ByVal New_Format As String)
TxtMas.Mask() = New_Format
PropertyChanged "Format"
End Property
Public Property Get CheckIn() As String
Attribute CheckIn.VB_Description = "; Seperated Enteries to Checked"
CheckIn = m_CheckIn
End Property
Public Property Let CheckIn(strCheckIn As String)
m_CheckIn = strCheckIn
PropertyChanged "CheckIn"
End Property
Public Property Get LookUp() As Boolean
LookUp = m_LookUp
End Property
Public Property Let LookUp(booLookUp As Boolean)
m_LookUp = booLookUp
PropertyChanged "LookUp"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=14,0,0,0
Public Property Get ConvertEnter() As Boolean
Attribute ConvertEnter.VB_Description = "Set it True To convert enter Key to Tab key"
ConvertEnter = m_ConvertEnter
End Property
Public Property Let ConvertEnter(ByVal New_ConvertEnter As Boolean)
m_ConvertEnter = New_ConvertEnter
PropertyChanged "ConvertEnter"
End Property