'如果没有读完,则继续读
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
至此,你就拥有了一个属于自己的打字小软件了。按F5运行它,效果还不错吧,有兴趣的朋友还可以加上一些特殊功能,比如背景音乐,字体颜色或者游戏功能。下面是作者的打字小软件运行后的图示:

(备注:本程序在VB6.0 WIN2000下调试通过)
文章整理:西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!




