tepedform.frm

一个简单的打字练习东东

     char_len = char_len + 1
     If char_ke <> 32 Then
     rignt_char = rignt_char + 1
     Label5.Caption = Str(rignt_char)
     current_char = current_char + 1
     Label7.Caption = Str(current_char)
     End If
     Picture1.SetFocus
       
  Else
 
     
     RichTextBox1(Index).SelStart = char_len - 1
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbRed
     char_len = char_len + 1
     
     Picture1.SetFocus
     If char_ke <> 32 Then '空格不记录当前字符数
      current_char = current_char + 1
     Label7.Caption = Str(current_char)
     End If
     End If
Case 2
    If (Mid(RichTextBox1(Index).Text, char_len, 1) = _
     Mid(Label1(Index).Caption, char_len, 1)) Then '正确字符
     RichTextBox1(Index).SelStart = char_len - 1
   
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbBlue
     char_len = char_len + 1
     If char_ke <> 32 Then
     rignt_char = rignt_char + 1
     Label5.Caption = Str(rignt_char)
      current_char = current_char + 1
      Label7.Caption = Str(current_char)
     End If
     Picture1.SetFocus
       
  Else
 
     
     RichTextBox1(Index).SelStart = char_len - 1
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbRed
     char_len = char_len + 1
     Picture1.SetFocus
      If char_ke <> 32 Then '空格不记录当前字符数
      current_char = current_char + 1
      Label7.Caption = Str(current_char)
     End If
     End If
Case 3
If (Mid(RichTextBox1(Index).Text, char_len, 1) = _
     Mid(Label1(Index).Caption, char_len, 1)) Then '正确字符
     RichTextBox1(Index).SelStart = char_len - 1
   
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbBlue
     char_len = char_len + 1
     If char_ke <> 32 Then
     rignt_char = rignt_char + 1
     Label5.Caption = Str(rignt_char)
       current_char = current_char + 1
      Label7.Caption = Str(current_char)
     End If
     Picture1.SetFocus
       
  Else
 
     
     RichTextBox1(Index).SelStart = char_len - 1
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbRed
     char_len = char_len + 1
     Picture1.SetFocus
      If char_ke <> 32 Then '空格不记录当前字符数
      current_char = current_char + 1
      Label7.Caption = Str(current_char)
     End If
     End If
Case 4
If (Mid(RichTextBox1(Index).Text, char_len, 1) = _
     Mid(Label1(Index).Caption, char_len, 1)) Then '正确字符
     RichTextBox1(Index).SelStart = char_len - 1
   
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbBlue
     char_len = char_len + 1
     If char_ke <> 32 Then
     rignt_char = rignt_char + 1
     Label5.Caption = Str(rignt_char)
      current_char = current_char + 1
      Label7.Caption = Str(current_char)
     End If
     Picture1.SetFocus
       
  Else
 
     
     RichTextBox1(Index).SelStart = char_len - 1
     RichTextBox1(Index).SelLength = 1
     RichTextBox1(Index).SelColor = vbRed
     char_len = char_len + 1
     Picture1.SetFocus
      If char_ke <> 32 Then '空格不记录当前字符数
      current_char = current_char + 1
      Label7.Caption = Str(current_char)
     End If
     End If
End Select

RichTextBox1(Index).SetFocus
RichTextBox1(Index).SelStart = RichTextBox1(Index).SelStart + 1


If (Len(RichTextBox1(Index).Text) = Len(Label1(Index).Caption)) Then
 Debug.Print Index + 1
 RichTextBox1(Index + 1).SetFocus
End If
End Sub



Private Sub RichTextBox1_GotFocus(Index As Integer)
'MsgBox Str(RichTextBox1(Index).SelStart)
ScaleMode = 3
 char_len = RichTextBox1(Index).SelStart + 1
 char_total = all_char '计算字符总数
 Label3.Caption = Str(char_total)
 Line1.X1 = Label1(1).Left
 Line1.Y1 = Label1(1).Top - 2
 Line1.X2 = Label1(1).Left + 10
 Line1.Y2 = Label1(1).Top - 2
 
 
End Sub

Private Sub RichTextBox1_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
  If KeyCode = 8 Then KeyCode = 0
  '用户点击Enter计算正确率
  'If KeyCode = vbKeyReturn Then
 ' char_percent = (rignt_char / char_total) * 100
 ' Label7.Caption = Str(char_percent)
 ' End If
  
  
  
  
End Sub

Private Sub RichTextBox1_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
'记录当当前所打字符
Case 1
char_ke = KeyAscii
Case 2
char_ke = KeyAscii
Case 3
char_ke = KeyAscii
Case 4
char_ke = KeyAscii
End Select


End Sub

'练习文章选择
Private Sub select_Click()

selectwzForm.Show


End Sub

'开始打字
Private Sub start_type_Click()
'读如句子

ScaleMode = 3 '以象素为单位

If deforescrapname <> scrapname Then '同一篇不能显示2次
Dim i As Integer
Debug.Print mode
If mode = False Then
Close #1
If Right(App.Path, 1) <> "\" Then
Open App.Path + "\" + scrapname For Input As #1
deforescrapname = scrapname
Debug.Print scrapname
Else
 Open App.Path + scrapname For Input As #1
 deforescrapname = scrapname
End If

'MsgBox "fds"
mode = True
End If
'卸载动态加如的label
If mode_label = True Then
For i = 1 To 5 Step 1
Unload Label1(i)
Unload RichTextBox1(i)
char_total = 0

Next i
mode_label = False
End If
i = 1
Dim jz As String
If mode_label = False Then
Do While Not EOF(1)
If i > 5 Then

Exit Sub
End If

jz = Input$(60, #1)
'加载label
Load Label1(i)
Label1(i).Caption = jz
Label1(i).FontSize = 12
Label1(i).FontBold = True
Label1(i).Width = Picture1.Width
Label1(i).Left = 20 / 15
Label1(i).Top = (1000 * i) / 15
'''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''
Label1(i).Visible = True
Load RichTextBox1(i)
RichTextBox1(i).Font.Size = 12
RichTextBox1(i).Font.Bold = True
RichTextBox1(i).Left = Label1(i).Left - 2
RichTextBox1(i).Top = Label1(i).Top + Label1(i).Height + 1
RichTextBox1(i).Width = Label1(i).Width - 20

RichTextBox1(i).Visible = True
RichTextBox1(1).SetFocus

i = i + 1


'Debug.Print currx, curry
'MsgBox "sdfs"
'Debug.Print i
mode_label = True 'label以动态加在

Loop

End If

Else
MsgBox "同一篇不能显示2次"
End If
 

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key

Case "start"
'读如句子
ScaleMode = 3
If deforescrapname <> scrapname Then '同一篇不能显示2次
Dim i As Integer
Debug.Print mode
If mode = False Then
Close #1
If Right(App.Path, 1) <> "\" Then
Open App.Path + "\" + scrapname For Input As #1
deforescrapname = scrapname
Debug.Print scrapname

Else
 Open App.Path + scrapname For Input As #1
 deforescrapname = scrapname
 
End If
'MsgBox "fds"

mode = True
End If

'卸载动态加如的label
If mode_label = True Then
For i = 1 To 5 Step 1
Unload Label1(i)
Unload RichTextBox1(i)
char_total = 0
Next i
mode_label = False
End If
i = 1
Dim jz As String
If mode_label = False Then
Do While Not EOF(1)
If i > 5 Then

Exit Sub
End If

jz = Input$(60, #1)
'加载label
Load Label1(i)
Label1(i).Caption = jz
Label1(i).FontSize = 12
Label1(i).FontBold = True
Label1(i).Width = Picture1.Width
Label1(i).Left = 20 / 15
Label1(i).Top = (1000 * i) / 15

Label1(i).Visible = True
''''''''''''''''''''''''''''''''''''''''
'char_total = char_total + Len(jz)
' MsgBox Str(char_total)
'Debug.Print char_total
 Label3.Caption = Val(char_total)
''''''''''''''''''''''''''''
Load RichTextBox1(i)
RichTextBox1(i).Font.Size = 12
RichTextBox1(i).Font.Bold = True
RichTextBox1(i).Left = Label1(i).Left
RichTextBox1(i).Top = Label1(i).Top + Label1(i).Height + 1
RichTextBox1(i).Width = Label1(i).Width - 20

RichTextBox1(i).Visible = True
RichTextBox1(1).SetFocus

i = i + 1


'Debug.Print currx, curry
'MsgBox "sdfs"
'Debug.Print i
mode_label = True 'label以动态加在
''要打字的字符总数

Loop
End If
Else
MsgBox "同一篇不能显示2次"
End If


End Select

End Sub