ctltextbox.ctl

图书管理系统是针对学校和个人有一定的作用软件

VERSION 5.00
Begin VB.UserControl ctlTextBox 
   ClientHeight    =   1290
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3810
   ScaleHeight     =   1290
   ScaleWidth      =   3810
   ToolboxBitmap   =   "ctlTextBox.ctx":0000
   Begin VB.TextBox Text1 
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1935
   End
End
Attribute VB_Name = "ctlTextBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Dim charAccept As Integer
'charAccept can be for
'0 - Any Character Acceptable
'1 - Only Numbers Allowed
'2 - Only Letters Allowed

Public Property Get charType() As Integer
    charType = charAccept
End Property

Public Property Let charType(ByVal vNewVal As Integer)
    charAccept = vNewVal
End Property

Private Sub usercontrol_readproperties(propbag As PropertyBag)
    charType = propbag.ReadProperty("charType", 0)
End Sub

Private Sub usercontrol_writeproperties(propbag As PropertyBag)
    propbag.WriteProperty "charType", charAccept, 0
End Sub


'######################################################
' To Customize TextBox Effect
'######################################################
Private Sub Text1_GotFocus()   'Effect on Focus
    Text1.BackColor = vbYellow
    Text1.ForeColor = vbBlue
End Sub

Private Sub Text1_LostFocus() 'Effect on Out of Focus
    Text1.BackColor = vbWhite
    Text1.ForeColor = vbBlack
End Sub

'To validate the data entered by user
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyBack Then
        Exit Sub
    End If
    Select Case charAccept
        Case 0 'Any Character
            Exit Sub
        Case 1 'Only Numbers
            If (KeyAscii >= 48 And KeyAscii <= 57) Then
                Exit Sub
            Else
                KeyAscii = 0
                Beep
                MsgBox "Invalid Data Entry", vbExclamation, "Data-Entry Error!"
            End If
        Case 2 'Only Letters
            If (KeyAscii >= 65 And KeyAscii <= 90) Then
                Exit Sub
            ElseIf (KeyAscii >= 97 And KeyAscii <= 122) Then
                Exit Sub
            Else
                KeyAscii = 0
                Beep
                MsgBox "Invalid Data Entry", vbExclamation, "Data-Entry Error!"
            End If
    End Select
End Sub

'######################################################
' Occurs whenever UserControl is Resize
' It makes textbox of same height and width as usercontrol
'######################################################
Private Sub UserControl_Resize()
    Text1.Height = UserControl.ScaleHeight
    Text1.Width = UserControl.ScaleWidth
End Sub


'######################################################
'Making TextBox TEXT Property Persistent
'######################################################
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