用VB6.0设计一个打字练习软件

记得以前在学校里刚接触电脑时，首先掌握的是学会打字，那时的操作系统都是DOS的，界面比较单调，现在进入WINXP时代，所以打字软件也要跟潮流了！所以我用VB6.0写了一个打字小软件，主要步骤如下，供各位VB fans参考：

　　1） 首先新建一EXE工程

　　在工程菜单－部件菜单中选择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

　　至此，你就拥有了一个属于自己的打字小软件了。按F5运行它，效果还不错吧，有兴趣的朋友还可以加上一些特殊功能，比如背景音乐，字体颜色或者游戏功能。下面是作者的打字小软件运行后的图示：

　　

　　（备注：本程序在VB6.0+WIN2000下调试通过）

查看本文来源