一个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应该怎么办?

解决方案 »

  1.   

    label的名字是mlbl,textbox的名字是mtext
    就是
    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不能激发
      

  2.   

    如果是未编译的ctl则可以响应,如果是ocx就不行咯