打字系统的设计与实现本工程以一个比较实用的例子，主要用来实现对打字速度、打字准确率进行评测，并给出适当的成绩，是一个用于测试打字的应用程序。通过本系统，可以了解如何使用Visual Basic来开发一个比较完整的应用程序。但限于篇幅，有一些功能没有实现，如用户管理，系统配置以及登录、启动屏幕（Splash Screen）等。本工程将使用VB的多种控件，如文件对话框控件、时间控件、SSTab控件、状态栏以及通用控件等。本系统可以完成以下任务：
以随机抽取文本方式或指定具体文本文件的方式，来获得打字测试的内容。但文件不能超过4096字节（而且，最多是前300个字有效）。
用户可以设置各种系统参数。如考试时间设定、字数设置。
打字速度、准确率、成绩的测试。
图1-1、1-2显示的是程序运行后的外观

图1-2 运行时的“系统设置”界面

图1-2 运行时的“打字测试”界面首先，现在窗体上添加各种控件，如图1-3、1-4设计屏幕，然后添加程序代码。在图1-3的“打字测试”设计界面窗体中，其控件、主要属性、控件说明（一些次要属性如Height、Width除非特别，否则将不特别说明，读者可以根据具体情况来设定）如下：
控件名称
主要控件属性名称
属性值
功能说明
Form1
Caption
打字测试系统
BorderStyle
3 – Fixed Dialog
StartUpPosition
2-屏幕中心
CommonDialog
名称
dbFile
Timer
名称
Timer1
用于时间限定和倒计时显示
Interval
1000
名称
Timer2
用于在状态栏中显示时间和日期
Interval
500
SSTab
Caption
打字测试
ForeColor
&H00FF0000&(蓝色)
TabOrientation
1 - ssTabOrientationBottom
Label
名称
lblTime
显示倒计时计时器
BackColor
浅蓝
BorderStyle
1 – Fixed Single
Caption
10:00
名称
lblGetText
存放测试内容，顺序置后
BorderStyle
1 – Fixed Single
WordWrap
True
名称
lblWrite
指示打入字符的进度，顺序在lblGetText的前面。
BackStyle
0 – Transpare(透明)
BorderStyle
1 – Fixed Single
ForeColor
&H00FF0000&(蓝色)
名称
lblError
指示出打错的文本，打对的用空格填充
BadkStyle
0 – Transpare(透明)
BorderStyle
1 – Fixed Single
ForeColor
&H000000FF&（红色）
名称
lblInfo
用来显示打字速度以及准确率等
BorderStyle
1 – Fixed Single
TextBox
名称
txtGetText
用来输入字符（汉字）
Enabled
False
MultiLine
True
CommandButton
名称
cmdStart
开始测试按钮
Caption
开始
名称
Command1
以打开文件方式选取测试内容
Caption
指定文件
名称
CmdExit
退出系统
Caption
退出
StatusBar
名称
StatusBar1
状态栏，显示时间
注：其中，lblGetText、lblWrite、lblError在设计时应该在风格、位置和大小上一致，运行时也须一致（见相关代码）。这里相互错开，主要是要大家清楚界面的设计。

图1-3“打字测试”设计界面
在图1-4的“系统设置”设计界面窗体中，其控件、主要属性、控件说明如下：
控件名称
主要控件属性名称
属性值
功能说明
SSTab
Caption
系统设置
ForeColor
&H00FF0000&(蓝色)
ComboBox
名称
cmbSetTime
设定测试时间，其值见代码
Text
10
Frame
名称
Frame1
Caption
测试时间设置
OptionButton
名称
Option1
这是控件数组，用于指定测试内容选择
Label
名称
lblTip
在“设置说明”框架内，进行各项说明

图1-4,系统设置”设置界面
本系统采用的主要原理：
系统初始化：完成系统的各项初始化。
Private Sub Form_Load()
‘使得目标文字的各项标签的位置、大小一直
lblError.Left = lblGetText.Left
lblError.Top = lblGetText.Top
lblError.Height = lblGetText.Height
lblError.Width = lblGetText.Width
lblWrite.Left = lblGetText.Left
lblWrite.Top = lblGetText.Top
lblWrite.Height = lblGetText.Height
lblWrite.Width = lblGetText.Width
lblWrite.Font.Size = lblGetText.Font.Size
‘初始化倒计时电子钟
nSecond = 60
nTime = 10 * 60
nOk = 0
nSorry = 0
‘初始化时间设置选项的下拉列表框
cmbSetTime.AddItem "30",Index = 1
cmbSetTime.AddItem "20",Index = 2
cmbSetTime.AddItem "15",Index = 3
cmbSetTime.AddItem "10",Index = 4
cmbSetTime.AddItem "5",Index = 5
SSTab1.Tab = 0 '使第一个选项卡
StatusBar1.Panels(1).Width = 2000‘指定第一个状态栏的宽度
txtGetText.MaxLength = Val(txtWord.Text)
‘初始化随即抽取内容，读者可自行拟定，限于篇幅，这里只举几例
txtTarget(1) = "茶叶做为世界性的饮料，…，又兼解酒之功能也。”"
txtTarget(2) = "我国唐以来文风大盛，…，不使与异味的的物品相混杂。"
txtTarget(3) = "酒量与饭量一样不能定义，…死即生0.6—0.7%。"
txtTarget(4) = "钓鱼，是一项高雅的文体活动，…，精力充沛。"
txtTarget(5) = "事实上，所谓增进食欲的颜色，…,每种色彩。”"
End Sub
测试内容的选定：
随机文本的抽取：为了简化程序，我们将要选取的内容放到字符串数组中，然后取得系统的时间（秒），将其作为种子，经过取模，来获得测试内容字符串。其代码如下：
Private Sub Option1_Click(Index As Integer)
Dim nSelText As Integer
nSelText = (Second(Now()) Mod 5) + 1‘根据系统时间，选取测试内容
If Index = 0 Then
Command1.Enabled = True ‘使“指定文件”按钮有效
Else
Command1.Enabled = False‘使“指定文件”按钮无效
‘其中，txtTarget数组已经在Form1_Load中定义。
lblGetText.Caption = txtTarget(nSelText)‘选取测试内容
End If
End Sub
‘进行功能说明
Private Sub Option1_GotFocus(Index As Integer)
lblTip.Caption = "通过选择，来确定进行测试的内容。其中：指定文件是指可以通过文件对话框来选择需要的问件；" & _
"而随机抽取是指随机选择固定的段落进行测试。"
End Sub
指定文本的获取：这里，我们使用了文件对话框，来取得磁盘上的指定文件。然后将文件的内容读出来，放到指定的标签中，作为测试内容。其代码如下：
Private Sub Command1_Click()
Dim txtGet,cTemp As String
Dim i,j As Integer
dbFile.ShowOpen‘用文件对话框打开文档
If Trim(dbFile.FileName) <> "" Then
Open dbFile.FileName For Input As #1
End If
On Error GoTo ErrorEnd‘若发生打开文本错误，进行出错处理
Input #1,txtGet‘获取文本中的内容
lblGetText.Caption = ""
Do While Not EOF(1)
For i = 1 To Len(txtGet)
cTemp = Mid(txtGet,i,1)‘遍历文本中的每个字
'过滤空格，包括全角和半角的空格
If (cTemp <> " " And cTemp <> "") Then lblGetText = lblGetText + cTemp
End If
Next i
Input #1,txtGet
Loop
lblGetText = Trim(lblGetText)
Close 1‘关闭文件
Exit Sub
ErrorEnd:‘文件打开错误处理代码
Dim Msg,Style,Title,Response
Msg = "文件打开错误，请注意！" ' 定义信息。
Style = vbOKOnly ' 定义按钮。
Title = "提示信息" ' 定义标题。
Response = MsgBox(Msg,Style,Title)
End Sub
字的录入与判断字的录入：文字的录入是在“打字测试”选项卡下部区域实现的。考虑到应该禁止使用系统的粘贴功能，本应用程序禁止了鼠标的右键功能、以及Ctrl+V组合键。其中，txtGetText_Change()函数用来完成成绩的测定、速度的测定，以及各种输入的判断；txtGetText_KeyDown()函数完成对Ctrl健的屏蔽，即禁止使用粘贴功能；txtGetText_MouseDown()函数完成对鼠标右键的屏蔽。具体代码如下：
Private Sub txtGetText_Change()
Dim i As Byte
Dim nTextLen,nLblLen As Integer
Dim cTemp As String
Dim nScore As Double
lblError.Caption = ""
txtGetText.MaxLength = 500 ‘避免输入太长，引起错误
nTextLen = Len(txtGetText)
‘判断是否超长，如果超长，直接截取
If nTextLen >= Val(txtWord.Text) Then
txtGetText.Text = Trim(Right(txtGetText.Text,Val(txtWord.Text)))
txtGetText.MaxLength = Val(txtWord.Text)
nTextLen = Len(txtGetText)
MsgBox "已完成打印字数！！，若无错误可以退出！！"
End If
If nTextLen >= 0 Then
nSorry = 0
Rem 实现对输入文档的验证
For i = 1 To nTextLen
cTemp = Mid(lblGetText.Caption,i,1)
If (cTemp = Mid(txtGetText.Text,i,1)) Then
lblError.Caption = lblError.Caption + cTemp
Else
nSorry = nSorry + 1‘统计打错的字数
If AscW(cTemp) >= 256 Or AscW(cTemp) < 0 Then
lblError.Caption = lblError.Caption + ""‘全角空格
Else ‘半角空格
lblError.Caption = lblError.Caption + Chr(32)
End If
End If
Next i
'指示打印进度
lblWrite.Caption = Mid(lblGetText.Caption,1,nTextLen)
End If
‘计算分数
nScore = (Len(lblWrite.Caption) - nSorry) * 100 / Val(txtWord.Text)
If nTextLen > 0 Then
lblInfo.Caption = "输入了：" & nTextLen & "字 " & "出错率：" & Round(nSorry / nTextLen * 100) & "%" & "成绩：" & nScore
strEndInfo = "成 绩：" & Round(nScore,1) & Chr(13) & "输入了：" & nTextLen & "字 " & Chr(13) & "出错率：" & Round(nSorry / nTextLen * 100) & "%" & Chr(13) & "速 度," & (Len(lblWrite.Caption) - nSorry) & " "
Else
lblInfo.Caption = "输入了：" & nTextLen & "字 " & "出错率：" & 0
End If
End Sub
Private Sub txtGetText_KeyDown(KeyCode As Integer,Shift As Integer)
'屏蔽Ctrl+V键，即，不许进行粘贴
If Shift = 2 Then
MsgBox "禁止使用粘贴"
End If
End Sub
Private Sub txtGetText_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single)
Dim Msg,Style,Title,Response
Msg = "禁止右键，请注意！" ' 定义信息。
Style = vbOKOnly ' 定义按钮。
Title = "提示信息" ' 定义标题。
If Button = vbRightButton Then
Response = MsgBox(Msg,Style,Title)
End If
End Sub
Timer控件的使用时间的设定：主要完成对倒计时的设定，即测试时间的设置。并完成倒计时电子钟的显示。
Private Sub Timer1_Timer()
Dim X,Y As Integer
Dim cx,xy As String
Dim nScore As Double
Dim strOk As String
nTime = nTime - 1
nSecond = nSecond - 1
If nSecond = 0 Then
Y = nSecond
nSecond = 59
Else
Y = nSecond
End If
X = Int(nTime / 60)
If X < 10 Then
cx = "0" & X‘如果是单位数如1、2等，在前面补0成01、02等
Else
cx = X
End If
If Y < 10 Then
cy = "0" & Y
Else
cy = Y
End If
If X = 0 And Y = 0 Then‘时间到则计算出各成绩项
Timer1.Enabled = False
txtGetText.Enabled = False
nScore = Round((Len(txtGetText.Text) - nSorry) / nTime)
strOk = IIf(nScore > Val(txtSpeed.Text),"速度合格！","速度不合格！")
strEndInfo = strEndInfo & nScore & "字/分" & strOk
lblTime.Caption = cx & "," & cy
MsgBox strEndInfo
End If
lblTime.Caption = cx & "," & cy‘显示倒计时电子钟
End Sub
时间日期的显示：在状态栏的第一个Panel中填入系统时间/
Private Sub Timer2_Timer()
StatusBar1.Panels(1).Text = Now()
End Sub
系统的开始和退出开始：指定开始之后，系统的各个选项等就不能更改，只能进行打字，或退出。
Private Sub cmdStart_Click()
Dim Msg,Style,Title,Response
Dim tempColor,tempSize
Msg = "目标文档为空，请选择文档内容。" ' 定义信息。
Style = vbOKOnly ' 定义按钮。
Title = "提示信息" ' 定义标题。
‘如果选择的内容为空，进行提示
If Len(Trim(lblGetText.Caption)) = 0 Then
tempColor = lblGetText.ForeColor
tempSize = lblGetText.Font.Size
lblGetText.ForeColor = RGB(255,0,0)
lblGetText.Font.Size = 25
lblGetText.Caption = "请在此处填入目标文档！"
Response = MsgBox(Msg,Style,Title)
lblGetText.ForeColor = tempColor
lblGetText.Font.Size = tempSize
lblGetText.Caption = ""
Else
Timer1.Enabled = True
cmdStart.Enabled = False
txtGetText.Enabled = True
txtGetText.BackColor = RGB(255,255,255)
SSTab1.Tab = 0 '选择第一个选项卡
txtGetText.SetFocus
Command1.Enabled = False
'SSTab1.Enabled = False
SSTab1.TabEnabled(1) = False
End If
End Sub
退出：限于篇幅，本系统退出是直接进行退出的，没有对用户以及用户环境进行保存。读者可以使用数据库或者文件方式实现。
Private Sub cmdExit_Click()
End
End Sub
系统设置的设定：完成系统环境的各项设置，具体如下：
系统倒计时电子钟的设置
Private Sub cmbSetTime_Change()
lblTime.Caption = Trim(cmbSetTime.Text) & "," & "00"
nTime = Val(Trim(cmbSetTime.Text)) * 60
txtGetText.MaxLength = Val(txtWord.Text)
End Sub
Private Sub cmbSetTime_Click()
lblTime.Caption = Trim(cmbSetTime.Text) & "," & "00"
nTime = Val(Trim(cmbSetTime.Text)) * 60
txtWord.Text = CStr(Val(Trim(cmbSetTime.Text)) * Val(Trim(txtSpeed.Text)))
If Val(Trim(txtWord.Text)) > 300 Then
txtWord.Text = "300"
End If
If Val(Trim(txtWord.Text)) < 100 Then
txtWord.Text = "100"
End If
End Sub
‘说明信息
Private Sub cmbSetTime_GotFocus()
lblTip.Caption = "指定进行测试的时间。"
End Sub
‘只能输入数字，否则不予反应
Private Sub cmbSetTime_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9" Then
KeyAscii = 0
End If
End Sub
‘如果设置不当，恢复值为10
Private Sub cmbSetTime_LostFocus()
If Len(Trim(cmbSetTime.Text)) = 0 Then
cmbSetTime.Text = 10
End If
End Sub
打字速度标准的设置
Private Sub txtSpeed_Change()
txtWord.Text = CStr(Val(Trim(cmbSetTime.Text)) * Val(Trim(txtSpeed.Text)))
If Val(Trim(txtWord.Text)) > 300 Then‘大于300则指定为300
txtWord.Text = "300"
End If
If Val(Trim(txtWord.Text)) < 100 Then
txtWord.Text = "100"‘小于100则指定为100
End If
txtGetText.MaxLength = Val(txtWord.Text)‘指定输入最大值
End Sub
‘限制只能输入数字
Private Sub txtSpeed_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9" Then
KeyAscii = 0
End If
End Sub
‘如果速度设置不当，恢复速度为30
Private Sub txtSpeed_LostFocus()
If Len(Trim(txtSpeed.Text)) = 0 Then
txtSpeed.Text = 30
End If
End Sub
设置需要进行测试的字数
Private Sub txtWord_Change()
txtGetText.MaxLength = Val(txtWord.Text)
End Sub