一个label,一个textbox
Option Explicit
Dim m_DataType As Integer '0为字符串1为整数2为小数3为货币4为日期
Dim m_Length As Integer
Dim m_Value As String
Dim m_TextBoxLeft As Single
Dim m_TextBoxWidth As Single
Dim m_NotNull As Boolean
Const m_def_DataType = 0
Const m_def_Length = 3
Const m_def_Value = ""
Const m_def_TextBoxLeft = 1045
Const m_def_TextBoxWidth = 360
Const m_def_NotNull = True
Event Change()Public Property Get DataType() As Integer
DataType = m_DataType
End PropertyPublic Property Let DataType(ByVal New_DataType As Integer)
m_DataType = New_DataType
PropertyChanged "DataType"
End PropertyPublic Property Get Length() As Integer
Length = m_Length
End PropertyPublic Property Let Length(ByVal New_Length As Integer)
m_Length = New_Length
PropertyChanged "Length"
mtext.Width() = 105 * Length + 100
PropertyChanged "TextBoxWidth"
UserControl.Width = mtext.Left + mtext.Width
End PropertyPrivate Sub UserControl_GotFocus()
mtext.SetFocus
End SubPrivate Sub UserControl_InitProperties()
Me.Length = 3
Me.NotNull = True
End SubPrivate Sub mtext_Validate(Cancel As Boolean)
Dim m_test As Variant
On Error GoTo Error
If NotNull = True And Trim(Text) = "" Then
MsgBox Caption & "不能为空", , "警告"
Cancel = True
mtext.SetFocus
Exit Sub
End If
Select Case DataType
Case 0
m_test = Text
Case 1
m_test = CInt(Text)
Case 2
m_test = CDbl(Text)
Case 3
m_test = CCur(Text)
Case 4
m_test = CDate(Text)
End Select
Exit Sub
Error: MsgBox Caption & "输入有误", , "警告"
Cancel = True
mtext.SetFocus
End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_DataType = PropBag.ReadProperty("DataType", m_def_DataType)
m_Length = PropBag.ReadProperty("Length", m_def_Length)
mtext.Enabled = PropBag.ReadProperty("Enabled", True)
mtext.Locked = PropBag.ReadProperty("Locked", False)
mtext.Text = PropBag.ReadProperty("Text", "")
mlbl.Caption = PropBag.ReadProperty("Caption", "")
mtext.Left = PropBag.ReadProperty("TextBoxLeft", m_def_TextBoxLeft)
mtext.Width = PropBag.ReadProperty("TextBoxWidth", m_def_TextBoxWidth)
mtext.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
m_Value = PropBag.ReadProperty("Value", m_def_Value)
m_NotNull = PropBag.ReadProperty("NotNull", m_def_NotNull)
End SubPrivate Sub UserControl_Resize()
UserControl.Height = 330
UserControl.Width = mtext.Left + mtext.Width + 20
End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("DataType", m_DataType, m_def_DataType)
Call PropBag.WriteProperty("Length", m_Length, m_def_Length)
Call PropBag.WriteProperty("Enabled", mtext.Enabled, True)
Call PropBag.WriteProperty("Locked", mtext.Locked, False)
Call PropBag.WriteProperty("Text", mtext.Text, "")
Call PropBag.WriteProperty("Caption", mlbl.Caption, "")
Call PropBag.WriteProperty("TextBoxLeft", mtext.Left, m_def_TextBoxLeft)
Call PropBag.WriteProperty("TextBoxWidth", mtext.Width, m_def_TextBoxWidth)
Call PropBag.WriteProperty("BackColor", mtext.BackColor, &H80000005)
Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
Call PropBag.WriteProperty("NotNull", m_NotNull, m_def_NotNull)
End SubPublic Property Get Enabled() As Boolean
Enabled = mtext.Enabled
End PropertyPublic Property Let Enabled(ByVal New_Enabled As Boolean)
mtext.Enabled() = New_Enabled
PropertyChanged "Enabled"
End PropertyPublic Property Get Locked() As Boolean
Locked = mtext.Locked
End PropertyPublic Property Let Locked(ByVal New_Locked As Boolean)
mtext.Locked() = New_Locked
PropertyChanged "Locked"
End PropertyPublic Property Get Text() As String
Text = mtext.Text
End PropertyPublic Property Let Text(ByVal New_Text As String)
mtext.Text() = New_Text
PropertyChanged "Text"
End PropertyPublic Property Get Caption() As String
Caption = mlbl.Caption
End PropertyPublic Property Let Caption(ByVal New_Caption As String)
mlbl.Caption() = New_Caption
PropertyChanged "Caption"
mtext.Left() = mlbl.Left + mlbl.Width + 100
PropertyChanged "TextBoxLeft"
UserControl.Width = mtext.Left + mtext.Width + 20
End PropertyPrivate Property Get TextBoxLeft() As Single
TextBoxLeft = mtext.Left
End PropertyPrivate Property Let TextBoxLeft(ByVal New_TextBoxLeft As Single)
m_TextBoxLeft = New_TextBoxLeft
PropertyChanged "TextBoxLeft"
End PropertyPrivate Property Get TextBoxWidth() As Single
TextBoxWidth = mtext.Width
End PropertyPrivate Property Let TextBoxWidth(ByVal New_TextBoxWidth As Single)
m_TextBoxWidth = New_TextBoxWidth
PropertyChanged "TextBoxWidth"
End PropertyPublic Property Get BackColor() As OLE_COLOR
BackColor = mtext.BackColor
End PropertyPublic Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
mtext.BackColor() = New_BackColor
PropertyChanged "BackColor"
End PropertyPublic Property Get Value() As String
Value = m_Value
End PropertyPublic Property Let Value(ByVal New_Value As String)
m_Value = New_Value
PropertyChanged "Value"
End PropertyPrivate Sub mtext_Change()
RaiseEvent Change
End SubPublic Property Get NotNull() As Boolean
NotNull = m_NotNull
End PropertyPublic Property Let NotNull(ByVal New_NotNull As Boolean)
m_NotNull = New_NotNull
PropertyChanged "NotNull"
End Property
编译后用鼠标点击另一个文本框焦点转换到另一该控件里的时候不响应validate事件除非按下TAB应该怎么办?
Option Explicit
Dim m_DataType As Integer '0为字符串1为整数2为小数3为货币4为日期
Dim m_Length As Integer
Dim m_Value As String
Dim m_TextBoxLeft As Single
Dim m_TextBoxWidth As Single
Dim m_NotNull As Boolean
Const m_def_DataType = 0
Const m_def_Length = 3
Const m_def_Value = ""
Const m_def_TextBoxLeft = 1045
Const m_def_TextBoxWidth = 360
Const m_def_NotNull = True
Event Change()Public Property Get DataType() As Integer
DataType = m_DataType
End PropertyPublic Property Let DataType(ByVal New_DataType As Integer)
m_DataType = New_DataType
PropertyChanged "DataType"
End PropertyPublic Property Get Length() As Integer
Length = m_Length
End PropertyPublic Property Let Length(ByVal New_Length As Integer)
m_Length = New_Length
PropertyChanged "Length"
mtext.Width() = 105 * Length + 100
PropertyChanged "TextBoxWidth"
UserControl.Width = mtext.Left + mtext.Width
End PropertyPrivate Sub UserControl_GotFocus()
mtext.SetFocus
End SubPrivate Sub UserControl_InitProperties()
Me.Length = 3
Me.NotNull = True
End SubPrivate Sub mtext_Validate(Cancel As Boolean)
Dim m_test As Variant
On Error GoTo Error
If NotNull = True And Trim(Text) = "" Then
MsgBox Caption & "不能为空", , "警告"
Cancel = True
mtext.SetFocus
Exit Sub
End If
Select Case DataType
Case 0
m_test = Text
Case 1
m_test = CInt(Text)
Case 2
m_test = CDbl(Text)
Case 3
m_test = CCur(Text)
Case 4
m_test = CDate(Text)
End Select
Exit Sub
Error: MsgBox Caption & "输入有误", , "警告"
Cancel = True
mtext.SetFocus
End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_DataType = PropBag.ReadProperty("DataType", m_def_DataType)
m_Length = PropBag.ReadProperty("Length", m_def_Length)
mtext.Enabled = PropBag.ReadProperty("Enabled", True)
mtext.Locked = PropBag.ReadProperty("Locked", False)
mtext.Text = PropBag.ReadProperty("Text", "")
mlbl.Caption = PropBag.ReadProperty("Caption", "")
mtext.Left = PropBag.ReadProperty("TextBoxLeft", m_def_TextBoxLeft)
mtext.Width = PropBag.ReadProperty("TextBoxWidth", m_def_TextBoxWidth)
mtext.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
m_Value = PropBag.ReadProperty("Value", m_def_Value)
m_NotNull = PropBag.ReadProperty("NotNull", m_def_NotNull)
End SubPrivate Sub UserControl_Resize()
UserControl.Height = 330
UserControl.Width = mtext.Left + mtext.Width + 20
End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("DataType", m_DataType, m_def_DataType)
Call PropBag.WriteProperty("Length", m_Length, m_def_Length)
Call PropBag.WriteProperty("Enabled", mtext.Enabled, True)
Call PropBag.WriteProperty("Locked", mtext.Locked, False)
Call PropBag.WriteProperty("Text", mtext.Text, "")
Call PropBag.WriteProperty("Caption", mlbl.Caption, "")
Call PropBag.WriteProperty("TextBoxLeft", mtext.Left, m_def_TextBoxLeft)
Call PropBag.WriteProperty("TextBoxWidth", mtext.Width, m_def_TextBoxWidth)
Call PropBag.WriteProperty("BackColor", mtext.BackColor, &H80000005)
Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
Call PropBag.WriteProperty("NotNull", m_NotNull, m_def_NotNull)
End SubPublic Property Get Enabled() As Boolean
Enabled = mtext.Enabled
End PropertyPublic Property Let Enabled(ByVal New_Enabled As Boolean)
mtext.Enabled() = New_Enabled
PropertyChanged "Enabled"
End PropertyPublic Property Get Locked() As Boolean
Locked = mtext.Locked
End PropertyPublic Property Let Locked(ByVal New_Locked As Boolean)
mtext.Locked() = New_Locked
PropertyChanged "Locked"
End PropertyPublic Property Get Text() As String
Text = mtext.Text
End PropertyPublic Property Let Text(ByVal New_Text As String)
mtext.Text() = New_Text
PropertyChanged "Text"
End PropertyPublic Property Get Caption() As String
Caption = mlbl.Caption
End PropertyPublic Property Let Caption(ByVal New_Caption As String)
mlbl.Caption() = New_Caption
PropertyChanged "Caption"
mtext.Left() = mlbl.Left + mlbl.Width + 100
PropertyChanged "TextBoxLeft"
UserControl.Width = mtext.Left + mtext.Width + 20
End PropertyPrivate Property Get TextBoxLeft() As Single
TextBoxLeft = mtext.Left
End PropertyPrivate Property Let TextBoxLeft(ByVal New_TextBoxLeft As Single)
m_TextBoxLeft = New_TextBoxLeft
PropertyChanged "TextBoxLeft"
End PropertyPrivate Property Get TextBoxWidth() As Single
TextBoxWidth = mtext.Width
End PropertyPrivate Property Let TextBoxWidth(ByVal New_TextBoxWidth As Single)
m_TextBoxWidth = New_TextBoxWidth
PropertyChanged "TextBoxWidth"
End PropertyPublic Property Get BackColor() As OLE_COLOR
BackColor = mtext.BackColor
End PropertyPublic Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
mtext.BackColor() = New_BackColor
PropertyChanged "BackColor"
End PropertyPublic Property Get Value() As String
Value = m_Value
End PropertyPublic Property Let Value(ByVal New_Value As String)
m_Value = New_Value
PropertyChanged "Value"
End PropertyPrivate Sub mtext_Change()
RaiseEvent Change
End SubPublic Property Get NotNull() As Boolean
NotNull = m_NotNull
End PropertyPublic Property Let NotNull(ByVal New_NotNull As Boolean)
m_NotNull = New_NotNull
PropertyChanged "NotNull"
End Property
编译后用鼠标点击另一个文本框焦点转换到另一该控件里的时候不响应validate事件除非按下TAB应该怎么办?
就是
Private Sub mtext_Validate(Cancel As Boolean)
Dim m_test As Variant
On Error GoTo Error
If NotNull = True And Trim(Text) = "" Then
MsgBox Caption & "不能为空", , "警告"
Cancel = True
mtext.SetFocus
Exit Sub
End If
Select Case DataType
Case 0
m_test = Text
Case 1
m_test = CInt(Text)
Case 2
m_test = CDbl(Text)
Case 3
m_test = CCur(Text)
Case 4
m_test = CDate(Text)
End Select
Exit Sub
Error: MsgBox Caption & "输入有误", , "警告"
Cancel = True
mtext.SetFocus
End Sub这个事件不按TAB不能激发