• <ruby id="5koa6"></ruby>
    <ruby id="5koa6"><option id="5koa6"><thead id="5koa6"></thead></option></ruby>

    <progress id="5koa6"></progress>

  • <strong id="5koa6"></strong>
    • 軟件測試技術
    • 軟件測試博客
    • 軟件測試視頻
    • 開源軟件測試技術
    • 軟件測試論壇
    • 軟件測試沙龍
    • 軟件測試資料下載
    • 軟件測試雜志
    • 軟件測試人才招聘
      暫時沒有公告

    字號: | 推薦給好友 上一篇 | 下一篇

    用VB6.0設計一個打字練習軟件

    發布: 2007-7-14 20:28 | 作者: 佚名    | 來源: 網絡轉載     | 查看: 93次 | 進入軟件測試論壇討論

    領測軟件測試網 秦凱

      記得以前在學校里剛接觸電腦時,首先掌握的是學會打字,那時的操作系統都是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運行它,效果還不錯吧,有興趣的朋友還可以加上一些特殊功能,比如背景音樂,字體顏色或者游戲功能! 

     。▊渥ⅲ罕境绦蛟赩B6.0+WIN2000下調試通過)

    延伸閱讀

    文章來源于領測軟件測試網 http://www.kjueaiud.com/


    關于領測軟件測試網 | 領測軟件測試網合作伙伴 | 廣告服務 | 投稿指南 | 聯系我們 | 網站地圖 | 友情鏈接
    版權所有(C) 2003-2010 TestAge(領測軟件測試網)|領測國際科技(北京)有限公司|軟件測試工程師培訓網 All Rights Reserved
    北京市海淀區中關村南大街9號北京理工科技大廈1402室 京ICP備10010545號-5
    技術支持和業務聯系:info@testage.com.cn 電話:010-51297073

    軟件測試 | 領測國際ISTQBISTQB官網TMMiTMMi認證國際軟件測試工程師認證領測軟件測試網

    老湿亚洲永久精品ww47香蕉图片_日韩欧美中文字幕北美法律_国产AV永久无码天堂影院_久久婷婷综合色丁香五月

  • <ruby id="5koa6"></ruby>
    <ruby id="5koa6"><option id="5koa6"><thead id="5koa6"></thead></option></ruby>

    <progress id="5koa6"></progress>

  • <strong id="5koa6"></strong>