在工程菜单－部件菜单中选择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 "Don't
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
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
