frmmain.frm

This software is used to test some functions of

VERSION 5.00
Begin VB.Form frmmain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Pasted Text Validation"
   ClientHeight    =   3180
   ClientLeft      =   4395
   ClientTop       =   1920
   ClientWidth     =   5835
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3180
   ScaleWidth      =   5835
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdend 
      Cancel          =   -1  'True
      Caption         =   "End"
      Height          =   375
      Left            =   4560
      TabIndex        =   10
      Top             =   1440
      Width           =   1215
   End
   Begin VB.CheckBox chkAllow 
      Caption         =   "Allow ony characters x, y,  z and space"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   3615
   End
   Begin VB.TextBox txtreturn 
      Height          =   285
      Left            =   840
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   1680
      Width           =   2535
   End
   Begin VB.TextBox txtcheck 
      Height          =   285
      Left            =   840
      TabIndex        =   0
      Text            =   "   d ya x fzr"
      Top             =   1320
      Width           =   2535
   End
   Begin VB.Label Label2 
      Caption         =   "http://www.vbgood.com"
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   3360
      TabIndex        =   12
      Top             =   2760
      Width           =   2175
   End
   Begin VB.Label Label1 
      Caption         =   "VB爱好者乐园  转"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   3360
      TabIndex        =   11
      Top             =   2400
      Width           =   2055
   End
   Begin VB.Label lblinfo1 
      AutoSize        =   -1  'True
      Caption         =   "For more demonstration Visual Basic Projects, please visit:"
      Height          =   195
      Left            =   120
      TabIndex        =   9
      Top             =   2040
      Width           =   4080
   End
   Begin VB.Label lblurl 
      AutoSize        =   -1  'True
      Caption         =   "http://www.vb-world.net"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   120
      TabIndex        =   8
      Top             =   2400
      Width           =   1740
   End
   Begin VB.Label lblemail 
      AutoSize        =   -1  'True
      Caption         =   "[e-mail]"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   120
      TabIndex        =   7
      Top             =   2880
      Width           =   1335
   End
   Begin VB.Label lblinfo2 
      AutoSize        =   -1  'True
      Caption         =   "To contact us, please send email to:"
      Height          =   195
      Left            =   120
      TabIndex        =   6
      Top             =   2640
      Width           =   2565
   End
   Begin VB.Label lblinfo 
      Caption         =   "Use a ParamArray of allowed or not-allowed characters to restrict input even when user pastes text into a box."
      Height          =   615
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   4695
   End
   Begin VB.Label lblreturn 
      Caption         =   "Return:"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   4
      Top             =   1680
      Width           =   735
   End
   Begin VB.Label lblcheck 
      Caption         =   "Check:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   3
      Top             =   1320
      Width           =   735
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub chkAllow_Click()
txtcheck_Change
End Sub

Private Sub cmdend_Click()
End
End Sub

Private Sub Form_Load()
txtcheck_Change
lblemail = email
lblurl = URL
End Sub

Private Sub Label2_Click()
gotoweb1
End Sub

Private Sub lblemail_Click()
sendemail
End Sub

Private Sub lblurl_Click()
gotoweb
End Sub

Private Sub txtcheck_Change()

txtreturn = CheckForCharacters(txtcheck, chkAllow.Value = vbChecked, "x", "y", "z", " ")

End Sub


Public Function CheckForCharacters(sText As String, bAllow As Boolean, ParamArray chars() As Variant)
Dim curchar As Variant
Dim iAt As Integer, iComplete As Integer, iCounter As Integer
Dim bOKToKeep As Boolean
sText = Trim$(sText)
If Len(sText) = 0 Then Exit Function

Select Case bAllow
  Case True   'allow only the characters in ParamArray
    iAt = 1
    iComplete = Len(sText)
    iCounter = 0
    Do
      bOKToKeep = False
      For Each curchar In chars
        If Mid$(sText, iAt, 1) = curchar Then
          bOKToKeep = True
          Exit For
        End If
      Next
      If bOKToKeep = False Then
        If iAt = 1 Then
          sText = Right$(sText, Len(sText) - 1)
        Else
          sText = Left$(sText, iAt - 1) & Right$(sText, Len(sText) - iAt)
        End If
        Else
        iAt = iAt + 1
      End If
      iCounter = iCounter + 1
    Loop Until iCounter = iComplete
  
  Case False  'allow all but the characters in ParamArray
  For Each curchar In chars
    Do Until InStr(1, sText, curchar) = 0
      iAt = InStr(1, sText, curchar)
      If iAt <> 0 Then
        If iAt = 1 Then
          sText = Right$(sText, Len(sText) - 1)
        Else
          sText = Left$(sText, iAt - 1) & Right$(sText, Len(sText) - iAt)
        End If
      End If
    Loop
  Next
End Select

CheckForCharacters = sText

End Function