键盘打字程序源代码
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
