用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 |
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 + "articlea.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下調試通過）