在工程菜單-部件菜單中選擇MICROSOFT COMMON DIALOG CONTROL 6.0(SP3)和MICROSOFT WINDOWS COMMON CONTROLS 6.0(SP4)兩項,在工程菜單-引用菜單中選擇MICROSOFT SCRIPTING RUNTIME項,然后保存工程,再在窗體中加入控件(部分),列表如下:
菜單NAME:mnuPracticeCAPTION:Practice子菜單NAME:mnuStartCAPTION:Start Practice NAME:mnuPauseCAPTION:Pause Practice NAME:mnuResumeCAPTION:Resume Practice NAME:mnuCustomCAPTION:Custom Practice NAME:mnuRestartCAPTION:Restart Practice NAME:mnuExitCAPTION:Exit狀態欄NAME:Stautsbar1 文本框NAME:Text1(0)INDEX:0TABSTOP:FALSEVISIBLE:FALSE標簽 NAME:Label1(0) INDEX:0VISIBLE:FALSEBACKSTYLE:0圖片NAME:Picture1TABSTOP:FALSE時鐘NAME:Timer1INTERVAL:1000 ENABLED:FALSE對話框NAME:CommonDialog1 工具欄NAME:Toolbar1 (備注:文本框控件Text1(0)和Label1(0)放入Picture1控件中)
2) 加入如下代碼:
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 + vbInform