在工程菜单－部件菜单中选择MICROSOFT COMMON DIALOG CONTROL 6.0(SP3)和MICROSOFT WINDOWS COMMON CONTROLS 6.0(SP4)两项，在工程菜单－引用菜单中选择MICROSOFT SCRIPTING RUNTIME项，然后保存工程，再在窗体中加入控件（部分），列表如下：
菜单
NAME:mnuPractice
CAPTION:Practice
子菜单
NAME:mnuStart
CAPTION:Start Practice
NAME:mnuPause
CAPTION:Pause Practice
NAME:mnuResume
CAPTION:Resume Practice
NAME:mnuCustom
CAPTION:Custom Practice
NAME:mnuRestart
CAPTION:Restart Practice
NAME:mnuExit
CAPTION:Exit
状态栏
NAME:Stautsbar1
文本框
NAME:Text1(0)
INDEX:0TABSTOP:FALSEVISIBLE:FALSE
标签
NAME:Label1(0)
INDEX:0VISIBLE:FALSEBACKSTYLE:0
图片
NAME:Picture1
TABSTOP:FALSE
时钟
NAME:Timer1
INTERVAL:1000 ENABLED:FALSE
对话框
NAME:CommonDialog1
工具栏
NAME:Toolbar1
(备注：文本框控件Text1(0)和Label1(0)放入Picture1控件中)
2） 加入如下代码：
rowcount是练习文本的行数，totalchar是练习文本的总字数 Dim rowcount, totalchar As Integer mode是当前练习状态：start为正在联系,pause中止练习，否则为等待状态 filename为练习文本文件的文件名 Dim mode, filename As String playsec为当前练习所用的秒数 Dim playsec As Long ------------------------------------------ Private Sub Form_Load() Dim i As Integer 调整Picture1控件的位置 Picture1.Top = Toolbar1.Top + Toolbar1.Height + 10 Picture1.Height = Picture2.Top - Picture1.Top 显示当前练习状态 StatusBar1.Panels(1).Text = "Status : Waiting..." End Sub ------------------------------------------ Private Sub Form_Unload(Cancel As Integer) 如果练习文本行数大于0，则将动态生成的输入文本框和标签控件卸载 If rowcount > 0 Then Dim i As Integer For i = 1 To rowcount Unload Label1(i) Unload Text1(i) Next End If End Sub --------------------------------------------------------- Private Sub mnuCustom_Click() 自定义练习内容 On Error GoTo Error_Exit 弹出练习文本文件选择框 CommonDialog1.ShowOpen 如果选择的文件名为空，则退出 If CommonDialog1.filename = "" Then Exit Sub 如果当前练习状态不是等待状态，则停止当前练习 Timer1.Enabled = False playsec = 0 Dim i As Integer For i = 1 To rowcount Unload Label1(i) Unload Text1(i) Next filename = CommonDialog1.filename 开始新的练习，练习文本为用户选择的文本文件 Call mnuStart_Click Exit Sub Error_Exit: Exit Sub End Sub ------------------------------------------ Private Sub mnuExit_Click() 退出程序 Timer1.Enabled = False Unload Me End Sub ------------------------------------------ Private Sub mnuPause_Click() 中止练习 如果当前正在练习， If mode = "start" Then Timer1.Enabled = False mode = "pause" Picture1.Enabled = False StatusBar1.Panels(1).Text = "Status : Pausing..." End If End Sub --------------------------------------------- Private Sub mnuRestart_Click() 重新练习 如果没有开始练习，则退出；否则先卸载动态生成的控件数组， 然后再开始练习 If mode = "" Then Exit Sub Dim i As Integer mode = "" For i = 1 To rowcount Unload Label1(i) Unload Text1(i) Next Call mnuStart_Click End Sub --------------------------------------------- Private Sub mnuResume_Click() 继续练习 如果练习为中止状态，则继续练习 If mode = "pause" Then Timer1.Enabled = True mode = "start" Picture1.Enabled = True StatusBar1.Panels(1).Text = "Status : Starting..." End If End Sub --------------------------------------------- Private Sub mnuStart_Click() 如果当前正在练习，则退出此过程 If mode <> "" Then Exit Sub 申明一个文本流和一个文件系统对象 Dim t As TextStream Dim i As Integer Dim b As FileSystemObject 创建一个文件系统对象 Set b = New FileSystemObject Dim temp As String 如果当前没有练习文本文件，则采用默认的文本文件进行练习 If filename = "" Then filename = App.Path + "\article\a.txt" 读一个文本文件 Set t = b.OpenTextFile(filename, ForReading, False) i = 0: totalchar = 0 如果没有读完，则继续读 Do While Not t.AtEndOfStream temp = Trim(t.ReadLine) 如果当前读的行数据去掉空格后为空，则忽略此行数据 If temp <> "" Then i = i + 1 动态生成控件数组，用于显示练习文本数据和创建输入栏 Load Label1(i) Label1(i).Top = 500 * (i - 1) + i * 5 Label1(i).Left = 20 Label1(i).Caption = temp 如果显示的练习文本长度大于Picture1的长度， 则截掉多余的文本 Do While Label1(i).Width + Label1(i).Left > Picture1.Width Label1(i).Caption = Left(Label1(i), Len(Label1(i).Caption) - 1) Loop
Label1(i).Visible = True Load Text1(i) Text1(i).Top = Label1(i).Top + Label1(i).Height + 20 Text1(i).Left = 20 Text1(i).Width = Picture1.Width - 20 Text1(i).Visible = True Text1(i).Text = "" 把输入焦点定位到第一个输入框中 Text1(1).SetFocus 统计练习文本总字数 totalchar = Len(Label1(i).Caption) + totalchar 如果练习文本的高度大于Picture1的高度，则不再继续从文本文件中读数据而退出 If Picture1.Height - (Text1(i).Top + Text1(i).Height) < 500 Then Exit Do End If Loop 如果文本文件为空，则退出 If i = 0 Then t.Close Exit Sub End If t.Close 练习开始，并且计时开始 rowcount = i playsec = 0 Timer1.Enabled = True mode = "start" StatusBar1.Panels(1).Text = "Status : Starting..." End Sub ------------------------------------------ Private Sub Text1_Change(Index As Integer) If mode = "pause" Then Call mnuResume_Click 如果当前行的打字字数等于当前练习行字数，则跳到下一打字输入行 如果练习完毕，则弹出对话框，让玩家选择是否存储打字速度数据 If LenB(Text1(Index).Text) = LenB(Label1(Index).Caption) Then If Index = rowcount Then Timer1.Enabled = False mode = "" Dim i, j, rightchar As Integer rightchar = 0 统计每一行打字的正确字数 For i = 1 To rowcount For j = 1 To Len(Label1(i).Caption) If Mid(Text1(i).Text, j, 1) = Mid(Label1(i).Caption, j, 1) Then rightchar = rightchar + 1 Next Next If MsgBox("finish task!Correct Percent:" & Int((rightchar / totalchar) * 100) & "%" + vbCrLf + vbCrLf + "Do you want to save this practice result?", vbYesNo + vbInformation, "Hint") = vbYes Then 将打字速度结果存入文本文件中 Open App.Path + "\count.txt" For Append As #1 If playsec = 0 Then Print #1, 0 Else Print #1, CStr(totalchar / playsec) End If Close #1 End If 计时清0 playsec = 0 Else Index = Index + 1 Text1(Index).SetFocus End If End If End Sub ------------------------------------------ Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) 在打字输入框中屏蔽掉方向键和删除键等，以避免玩家误操作 If KeyCode = vbKeyLeft Then KeyCode = 0 If KeyCode = vbKeyRight Then KeyCode = 0 If KeyCode = vbKeyUp Then KeyCode = 0 If KeyCode = vbKeyDown Then KeyCode = 0 If KeyCode = vbKeyDelete Then KeyCode = 0 If KeyCode = vbKeyHome Then KeyCode = 0 If KeyCode = vbKeyEnd Then KeyCode = 0 End Sub ------------------------------------------- Private Sub Text1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) 如果用鼠标点击输入框，则作为作弊行为，重新开始练习 MsgBox "Dont cheat youself,Please studying carefully!" + vbCrLf + vbCrLf + "[Suggestion : This Way is to advantage you]", vbOKOnly + vbInformation, "Warning" Call mnuRestart_Click End Sub ------------------------------------------- Private Sub Timer1_Timer() 计算当前练习所耗时间，以秒为单位 playsec = playsec + 1 StatusBar1.Panels(2).Text = "Seconds Used : " & playsec & "(S)" End Sub
