急求VB打字练习源代码

Option Explicit

Dim score As Integer

Dim speed As Integer

Dim typetime As String

'初始化字符1

Sub innt1()

'产生随机大写字母、数字及其他符号

zi1.Caption = Chr(Int(Rnd * 43 + 48))

'起初位置

zi1.Left = Int(Rnd * (mm1.Width - zi1.Width))

zi1.Top = mm1.Top - zi1.Height

End Sub

'初始化字符2

Sub innt2()

'产生随机小写字孝册母

zi2.Caption = Chr(Int(Rnd * 26) + 97)

'起初位置

zi2.Left = Int(Rnd * (mm1.Width - zi2.Width))

zi2.Top = mm1.Top - zi2.Height

End Sub

'开始

Private Sub Command1_Click()

'输巧轿宏入时间

typetime = InputBox("请输入打字时间（单位为秒）：", "设置时间")

If IsNumeric(typetime) Then

Label5.Caption = typetime

Else

Exit Sub

End If

'调用子过程

innt1

innt2

'设置默认的下落速度

HScroll1.Value = 50

'开始下落

Timer1.Enabled = True

Timer2.Enabled = True

Command1.Enabled = False

Label3.Caption = 0

'设置时间为2分钟

End Sub

'打字

Private Sub HScroll1_KeyPress(KeyAscii As Integer)

'若打中字符1

If Chr(KeyAscii) = zi1.Caption Then

'重新初始化

innt1

'分数累加

score = score + 1

'显示分数

Label3.Caption = score

End If

'若打中字符2

If Chr(KeyAscii) = zi2.Caption Then

innt2

score = score + 1

Label3.Caption = score

End If

End Sub

'初始帆备化设置

Private Sub Form_Load()

Randomize

Timer1.Enabled = False

Timer2.Enabled = False

zi1.AutoSize = True

zi2.AutoSize = True

HScroll1.Max = 300

HScroll1.Min = 10

End Sub

'改变速度

Private Sub HScroll1_Change()

speed = HScroll1.Value

End Sub

'字符下落

Private Sub Timer1_Timer()

'字符1下落

zi1.Top = zi1.Top + speed

If zi1.Top >mm1.Height Then

innt1

End If

'字符2下落

zi2.Top = zi2.Top + speed

If zi2.Top >mm1.Height Then

innt2

End If

End Sub

'控制打字时间

Private Sub Timer2_Timer()

'减时

Label5.Caption = Val(Label5.Caption) - 1

'若时间到

If Val(Label5.Caption) <= 0 Then

'停止字符下落

Timer1.Enabled = False

zi1.Caption = ""

zi2.Caption = ""

'分析分数

Select Case score

Case Is <60

MsgBox vbCrLf + "你真菜!努力吧!"

Case Is >= 60

MsgBox vbCrLf + "恩~！还可以有进步!"

Case Is >= 100

MsgBox vbCrLf + "哈```满分!"

Case Is >150

MsgBox vbCrLf + "好厉害啊`!"

End Select

Command1.Enabled = True

Timer1.Enabled = False

Timer2.Enabled = False

End If

End Sub

我有，当年自己写的一个得兄森过<省二等奖><市一等奖>的作品!

功能：运行打错字，回退键重羡让亩要，打对字实现“打勾”，与打错字“打差”统计正确率，速度，图形界面显示键盘图。。。（2万行左右代码）

Private Sub Text1_Change(Index As Integer)

On Error GoTo text1changewrong:

' Print Mid(Label1(myord Mod 7).Caption, begin + 1, myend - begin + 1)

MouseSetfocusOrAutoSetfocus = False '把是否用标点text1(0)标记变为不是(false)

Text1(Index).IMEMode = 9 '用于改变输入法状态

backyn = False '让退格可以用

Label3.Caption = "myend"滑颂 &Str(myend)

Label4.Caption = "begin" &Str(begin)

If key = 1 Then '如果k=1 '清空文本框

For i = 0 To 6

Text1(i).Text = ""

Text1(i).Enabled = False

Label2(i).Caption = ""

Next i

Text1(0).Enabled = True

key = 0

'此处应变题(出题, 待作:...........)

End If

If delete = 0 Then

myend = Text1(myord Mod 7).SelStart + 1

Else

myend = myend - 1

begin = begin - 1

End If

If myend - begin <>0 Then

tmstr$ = Mid(Label1(myord Mod 7).Caption, begin, myend - begin)

dtstr$ = Mid(Text1(myord Mod 7).Text, begin, myend - begin)

If tmstr = " " And dtstr = " " Then

Label2(myord Mod 7).Caption = Label2(myord Mod 7).Caption &" "

yorn(Text1(Index).SelStart) = 2

' GoTo kung:

'这里下

Else

If tmstr$ = dtstr$ Then

Label2(myord Mod 7).Caption = Label2(myord Mod 7).Caption + "√"

y = y + 1 '对的加一个

Label5.Caption = "正确：" &Str(y) &" 个字"

yorn(Text1(Index).SelStart) = 1

Else

Label2(myord Mod 7).Caption = Label2(myord Mod 7).Caption + "×"

n = n + 1 '错的加一个

Label6.Caption = "错误：" &Str(n) &"个字"

yorn(Text1(Index).SelStart) = 0

End If

End If

End If

If y >= 1 Then '除数不可为0

Label7.Caption = "正确率：" &left(Str((y / (y + n)) * 100), 5) &"%" '在label7上显示[正确率]

Correctness = left(Str((y / (y + n)) * 100), 5) '用于写文件时用的

Else

Label7.Caption = "正确率：" &0# &"%" '在label7上显示[正确率]

Correctness = 0# '用于写文件时用的

End If

If Text1(myord Mod 7).SelStart >= Len(RTrim(Label1(myord Mod 7).Caption)) Then

If Text1((Index + 1) Mod 7).Visible = False Then

MsgBox "正确:" &Str(y) &"个 " &Label7.Caption &Chr(13) &Chr(10) &"错误:" &Str(n) &"个" &Label8.Caption, 64, "测试报告"

Close #1

'Form2.Show

Unload Me

Exit Sub

'水有文单

End If

Text1(myord Mod 7).SelStart = 1

myord = myord + 1

If myord Mod 7 = 0 Then

key = 1 '用key=1 表示要清空所有文本框

For m = 0 To 6

Text1(m).Enabled = True

Next m

End If

begin = 1

delete = 0

Label2(myord Mod 7).Caption = ""

For u = 0 To 6

Text1(u).Enabled = False

Next u

Text1(myord Mod 7).Enabled = True

If Text1(myord Mod 7).Visible = True Then Text1(myord Mod 7).SetFocus

Text1(myord Mod 7).Text = ""

End If

'*******************************此段用于locked文本框*******

If myord Mod 7 <>0 Then Text1(myord Mod 7 - 1).Enabled = False

'***************************************************

begin = myend

Exit Sub

text1changewrong:

MsgBox "系统出错,将要关闭！", 32, "系统提示"

Unload Me

End Sub

Private Sub Text1_GotFocus(Index As Integer)

Dim tuige As Integer '用于保存text、label 应退的格数

If MouseSetfocusOrAutoSetfocus = True Then Exit Sub

Text1(Index).IMEMode = 9 '用于改变输入法状态

If Text1(Index).Text <>"" Then backyn = True '未验证

myord = Index

If Text1(myord Mod 7).Text = "" Then

begin = 1

myend = 0

Else

begin = Len(Text1(myord Mod 7).Text)

myend = Len(Text1(myord Mod 7).Text) + 1

Label2(myord Mod 7).Caption = left(Label2(myord Mod 7).Caption, Len(Text1(myord Mod 7).Text))

End If

If Index = 0 Then

If callkey = 0 Then

getnum = 0 '如果form1是刚打开，则从list1的第一行开始读数据

y = 0

n = 0

End If

callkey = callkey + 1

If callkey Mod 2 <>0 Then

For i = 0 To 6

mytxt = List1.List(getnum)

getnum = getnum + 1

If Not (getnum >List1.ListCount) Then

'a: ' Line Input #1, mytxt

'If Not (Len(Trim(mytxt)) >= 1) Then GoTo a:

If Len(mytxt) >37 Then mytxt = left(mytxt, 37)

'Label1(i).Left = Label1(i).Left + (Len(mytxt) - Len(LTrim(mytxt))) * (50 / 3)

'Label2(i).Left = Label1(i).Left + (Len(mytxt) - Len(LTrim(mytxt))) * (50 / 3)

'Text1(i).Left = Text1(i).Left + (Len(mytxt) - Len(LTrim(mytxt))) * (50 / 3)

Text1(i).left = 550 '每次都让label的位置还原

Label1(i).left = 600 '每次都让label的位置还原

Label2(i).left = 600 '每次都让label的位置还原

Label1(i).Caption = RTrim(mytxt) '"共和国中华人民共和国中华人民共和国中华人民共和国中华人民共和国韦"

tuige = (Len(RTrim(mytxt)) - Len(Trim(mytxt))) * Int(7695 / 37)

Label1(i).Caption = Trim(Label1(i).Caption) '"共和国中华人民共和国中华人民共和国中华人民共和国中华人民共和国韦"

Text1(i).left = Text1(i).left + tuige '退

Label1(i).left = Label1(i).left + tuige '退

Label2(i).left = Label2(i).left + tuige '退

Text1(i).Text = ""

Label2(i).Caption = ""

Text1(i).MaxLength = Len(Trim(Label1(i).Caption))

Text1(i).Width = Label1(i).Width + 100

Label1(i).Visible = True

Label2(i).Visible = True

Text1(i).Visible = True

Else

'Label1(i - 1).Visible = False

' Label2(i - 1).Visible = False

' Text1(i - 1).Visible = False

Exit For

End If

Next i

End If

End If

ReDim yorn(Len(Label1(Index).Caption)) As Integer

End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

'Text1(Index).IMEMode = 1

If KeyCode = 37 Or KeyCode = 39 Or KeyCode = 38 Or KeyCode = 40 Or KeyCode = 35 Or KeyCode = 36 Or KeyCode = 46 Then KeyCode = 0

If backyn = True And KeyCode = 8 Then KeyAscii = 0: Exit Sub: backyn = False

If KeyCode = 8 And Text1(myord Mod 7).SelStart <>0 Then

If yorn(Text1(Index).SelStart) = 1 Then y = y - 1: Label5.Caption = "正确：" &Str(y) &" 个字" 'Else n = n - 1: Label6.Caption = "错误：" &Str(n) &"个字" '用于减少对与错的量(y\n)

If yorn(Text1(Index).SelStart) = 0 Then n = n - 1: Label6.Caption = "错误：" &Str(n) &" 个字"

delete = 1

Label2(myord Mod 7).Caption = left(Label2(myord Mod 7).Caption, Len(Label2(myord Mod 7).Caption) - 1)

Text1(myord Mod 7).SelStart = myend - 1 'jjjjjjjjjjjjjjjjjjjj

Else

a:

delete = 0

End If

End Sub

。。。其它代码不公开，但本人愿意提供关键处代码，以代参考，或者思路问题进行回答！请加本人的QQ：599299169

---