Question

VB编写的打字程序

谁有VB编写的打字程序的源代码啊,急用!!

Answer 1

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

功能：运行打错字，回退键重要，打对字实现“打勾”，与打错字“打差”统计正确率，速度，图形界面显示键盘图。。。（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

Answer 2

Dim s$, t%
Private Sub Command1_Click()
Dim a%
For i = 1 To 50
a = Int(Rnd * 26 + 65)
s = s + UCase(Chr(a))
Next
Text1 = s
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Form_Load()
Timer1.Interval = 1000
Text1 = "": Text2 = "": Text3 = "": Text4 = ""
End Sub

Private Sub Text2_Click()
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Static p!, sum%, m%
t = t + 1
Text3 = t
m = Len(Text2)
sum = 0
For i = 1 To m
If Mid(Text2, i, 1) = Mid(s, i, 1) Then
sum = sum + 1
p = sum / m
Text4 = p * 100 & "%"
End If
Next
End Sub