网站首页/技术开发列表/内容

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

技术开发2022-07-24阅读
秦凯

  记得以前在学校里刚接触电脑时,首先掌握的是学会打字,那时的操作系统都是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下调试通过)
相关阅读