键盘打字程序源代码

1.完成程序界面如下：

  

2.控件列表：

控件对象

控件名称

控件属性

备注

frame

Frame1

 

主要的打字窗口

Label

Lblchar1

 

显示第一个字符

label

Lblchar2

 

显示第二个字符

frame

Frame2

Caption = “成绩”

 

Label

Label1

Caption= “用时”

 

Label

Label2

Caption = “成绩”

 

Label

LblTime

Caption = “”

显示所用的时间

Label

lblScore

Caption = “”

显示成绩

Frame

Frame3

Caption = “控制选项”

 

commandButton

CmdBegin

Caption = “开始练习”

 

commandButton

CmdHold

Caption= “暂停”

 

commandButton

CmdEnd

Caption = “结束练习”

 

Frame

Frame4

Caption = “速度选项”

 

HScrollBar

HScrollSpeed

Min = 20,max = 400

用像素控制下落速度

command

Command1

Caption = “关于程序”

 

Command

Command2

Caption = “退出”

 

Command

Command3

Caption = “全屏”

 

 

3.源代码：

Option Explicit

Dim score As Integer

Dim tim As Integer

Dim min As Integer

Dim left1, left2 As Integer 'char place

Dim speed As Integer

Dim windowmax As Boolean

 

Public hold As Boolean

Private Function init_char()

Dim temp As Integer

 

 temp = Int(Rnd * 93) '字符 33 - 126 包括所有标准键盘的字符键(除控制键)

 temp = temp + 33

   

    init_char = temp

   

End Function

 

Public Sub init()

   

    speed = HScrollSpeed.Value

    Timer2.Interval = 100 '每隔 0.1秒 字符下落一次， 人眼观察不到断点

    Timer1.Interval = 1000 '每隔1秒显示时间

    Timer1.Enabled = False

    Timer2.Enabled = False

    score = 0

    tim = 0

    min = 0

    hold = False

       

    windowmax = False '判断是否最大化窗口

   

   Randomize

   Rnd

    

    CmdBegin.Enabled = True

  

    CmdHold.Enabled = False

    CmdEnd.Enabled = False

   

    LabTime.Caption = min & "分" & tim & "秒"

    LabScore.Caption = score & "分"

    CmdHold.Caption = "暂停"

   lblchar1.Caption = ""

    lblchar2.Caption = ""

    lblchar1.Top = Frame1.Top

    lblchar2.Top = Frame1.Top

 

End Sub

 

Private Sub init_char1()

   lblchar1.Top = 0 '因为控件在 frame 中， 因此不会有超出范围嫌疑

    lblchar1.Caption = Chr(init_char)

   

    Dim widthf As Integer

    widthf = Frame1.Width - 250 '防止字符左边超出边框

    left1 = Frame1.Left + Rnd * (widthf - lblchar1.Width)

    lblchar1.Left = left1

   

   

   

End Sub

Private Sub init_char2()

    lblchar2.Top = 0

     lblchar2.Caption = Chr(init_char)

    

    Dim widthf As Integer

    widthf = Frame1.Width - 250

    left2 = Frame1.Left + Rnd * (widthf - lblchar2.Width)

   

    Dim diff As Integer

    Dim temp As Integer

    temp = lblchar1.Width

    '以下判断是否两个字符重叠 否则给予纠正位置

    diff = (left1 - left2)

    If diff <= 0 Then

      If -diff <= temp Then

        left2 = left2 + temp

       If left2 > (Frame1.Left + widthf - temp) Then

            left2 = left2 - widthf

            left2 = left2 + temp

        End If

      End If

    Else

     If diff < temp Then

        left1 = left1 + temp

        If left1 > (Frame1.Left + widthf - temp) Then

            left1 = left1 - widthf

            left1 = left1 + temp

            End If

        End If

    

     End If

   

    lblchar2.Left = left2

   

  

End Sub

 

 

Private Sub about_Click()

Load frmAbout

frmAbout.Show

End Sub

 

Private Sub CmdBegin_Click()

 CmdBegin.Enabled = False

 CmdEnd.Enabled = True

 CmdHold.Enabled = True

 Call init_char1

 Call init_char2

 

 Timer1.Enabled = True

 Timer2.Enabled = True

End Sub

 

Private Sub CmdBegin_KeyPress(KeyAscii As Integer)

    Call KeyPress(KeyAscii)

End Sub

 

Private Sub CmdEnd_Click()

MsgBox "恭喜你，你的得分是： " & score & Chr(13) & "共用了时间: " & LabTime.Caption, vbOKOnly, "练习结果"

 

Call init

Timer2.Enabled = False

Timer1.Enabled = False

CmdEnd.Enabled = False

 

End Sub

 

Private Sub CmdExit_Click()

Unload Me

Unload Form1

End

End Sub

 

Private Sub KeyPress(KeyAscii As Integer) '为了防止焦点移动，因此在每个控件上都调用

If Chr(KeyAscii) = lblchar1.Caption Then

     lblchar1.Caption = ""

     score = score + 10

     Call init_char1

Else

If Chr(KeyAscii) = lblchar2.Caption Then

    lblchar2.Caption = ""

    score = score + 10

    Call init_char2

End If

 

End If

LabScore.Caption = score & "分"

    

End Sub

 

Private Sub CmdExit_KeyPress(KeyAscii As Integer)

   

If KeyAscii = 13 Then '是否回车,是则终止程序

   Call CmdExit_Click

 End If

 

 Call KeyPress(KeyAscii)

End Sub

Public Sub CmdHold_Click()

If Not hold Then '如果没有暂停

Timer2.Enabled = False

Timer1.Enabled = False

CmdHold.Caption = "继续"

hold = True

 

Else '如果已经暂停

Timer2.Enabled = True

Timer1.Enabled = True

CmdHold.Caption = "暂停"

hold = False

 

CmdExit.SetFocus

End If

 

End Sub

 

Private Sub Command1_Click()

If Not CmdBegin.Enabled And Not hold Then

    Call CmdHold_Click

End If

 

Load frmAbout

frmAbout.Show

 

End Sub

 

Private Sub Command2_Click()

If Not windowmax Then

    Form1.WindowState = 2

    windowmax = True

    Command2.Caption = "还原窗口"

Else

    windowmax = False

    Form1.WindowState = 0

    Command2.Caption = "全屏"

End If

 

CmdExit.SetFocus

End Sub

 

Private Sub Form_KeyPress(KeyAscii As Integer)

    Call KeyPress(KeyAscii)

End Sub

 

Private Sub Form_Load()

    Call init

End Sub

 

Private Sub HScrollSpeed_Change()

    speed = HScrollSpeed.Value

End Sub

 

 

 

Private Sub HScrollSpeed_KeyPress(KeyAscii As Integer)

   

Call KeyPress(KeyAscii) '防止焦点落上, 其实不会

End Sub

 

Private Sub Timer1_Timer()

tim = tim + 1 '用原始办法积累时间

If tim > 59 Then

    min = min + 1

    tim = 0

    End If

  If min > 59 Then

    MsgBox "你已经练习一个小时了！ 练习自动结束，请注意保护眼睛！", vbOKOnly, "很抱歉！"

    Call CmdEnd_Click

    End If

   LabTime.Caption = min & "分" & tim & "秒"

   

End Sub

 

Private Sub Timer2_Timer()

 

        lblchar1.Top = lblchar1.Top + speed '下落speed距离

        lblchar2.Top = lblchar2.Top + speed

 

    Dim bottom As Integer

   

    bottom = Frame1.Top + Frame1.Height - lblchar2.Height / 2

     '测试是否到底

    

    If lblchar1.Top >= bottom Then

        Call init_char1

    End If

    If lblchar2.Top >= bottom Then

        Call init_char2

    End If

End Sub