📄 form1.frm
字号:
If ab > ndsz Then GoTo 10
Else
If ab > ndsz Or ab < ndsz / 2.5 Then GoTo 10
End If
Label1 = a(0) & "+" & a(1) & "="
If Check1.Value = 1 Then
qh = 1
Else
qh = 0
End If
End Sub
Private Sub add2() '加法连算
10 a(0) = Val(Format(Rnd * ndsz, "0"))
If a(0) = 0 Then GoTo 10
a(1) = Val(Format(Rnd * ndsz, "0"))
If a(1) = 0 Then GoTo 10
a(2) = Val(Format(Rnd * ndsz, "0"))
If a(1) = 0 Then GoTo 10
ab = a(0) + a(1) + a(2)
If ndsz = 10 Then
If ab > ndsz Then GoTo 10
Else
If ab > ndsz Or ab < ndsz / 2.5 Then GoTo 10
End If
Label1 = a(0) & "+" & a(1) & "+" & a(2) & "="
End Sub
Private Sub sub1() '减法1
12 a(0) = Val(Format(Rnd * ndsz, "0"))
If ndsz = 10 Then
If a(0) = 0 Then GoTo 12
Else
If a(0) = 0 Or a(0) < ndsz / 2.5 Then GoTo 12
End If
13 a(1) = Val(Format(Rnd * a(0), "0"))
If a(1) = 0 Then GoTo 13
ab = a(0) - a(1)
Label1 = a(0) & "-" & a(1) & "="
If Check1.Value = 1 Then
qh = 1
Else
qh = 0
End If
End Sub
Private Sub sub2() '减法连算
12 a(0) = Val(Format(Rnd * ndsz, "0"))
If ndsz = 10 Then
If a(0) = 0 Then GoTo 12
Else
If a(0) = 0 Or a(0) < ndsz / 2 Then GoTo 12
End If
13 a(1) = Val(Format(Rnd * a(0), "0"))
If a(1) = 0 Then GoTo 13
14 a(2) = Val(Format(Rnd * a(0), "0"))
If a(2) = 0 Then GoTo 14
ab = a(0) - a(1) - a(2)
If ab < 0 Then GoTo 13
Label1 = a(0) & "-" & a(1) & "-" & a(2) & "="
End Sub
Private Sub mul2() '乘法连算
14 a(0) = Val(Format(Rnd * ndsz, "0"))
If a(0) = 0 Then GoTo 14
15 a(1) = Val(Format(Rnd * ndsz, "0"))
If a(1) = 0 Then GoTo 15
a(2) = Val(Format(Rnd * ndsz, "0"))
If a(2) = 0 Then GoTo 15
ab = a(0) * a(1) * a(2)
If ndsz = 10 Then
If ab > ndsz Then GoTo 14
Else
If ab > ndsz Or ab < ndsz / 2.5 Then GoTo 14
End If
Label1 = a(0) & "×" & a(1) & "×" & a(2) & "="
End Sub
Private Sub mul1() '乘法1
14 a(0) = Val(Format(Rnd * ndsz, "0"))
If a(0) = 0 Or a(0) > 9 Then GoTo 14
15 a(1) = Val(Format(Rnd * ndsz, "0"))
If a(1) = 0 Or a(1) > 9 Then GoTo 15
ab = a(0) * a(1)
'If ndsz = 10 Then
If ab > ndsz Then GoTo 14
'Else
'If ab > ndsz Or ab < ndsz / 2.5 Then GoTo 14
'End If
Label1 = a(0) & "×" & a(1) & "="
End Sub
Private Sub div1() '除法1
14 a(0) = Val(Format(Rnd * ndsz, "0"))
If a(0) = 0 Or a(0) > 9 Then GoTo 14
15 a(1) = Val(Format(Rnd * ndsz, "0"))
If a(1) = 0 Or a(1) > 9 Then GoTo 15
ab = a(0) * a(1)
If ab > ndsz Then GoTo 14
aa = ab
ab = aa / a(0)
Label1 = aa & "÷" & a(0) & "="
End Sub
Private Sub div2() '除法连算
14 a(0) = Val(Format(Rnd * ndsz, "0"))
If a(0) = 0 Then GoTo 14
15 a(1) = Val(Format(Rnd * ndsz, "0"))
If a(1) = 0 Then GoTo 15
a(2) = Val(Format(Rnd * ndsz, "0"))
If a(2) = 0 Then GoTo 15
ab = a(0) * a(1) * a(2)
If ndsz = 10 Then
If ab > ndsz Then GoTo 14
Else
If ab > ndsz Or ab < ndsz / 2.5 Then GoTo 14
End If
aa = ab
ab = aa / a(0) / a(2)
Label1 = aa & "÷" & a(0) & "÷" & a(2) & "="
End Sub
Private Sub Command2_Click()
'结束
If sjsz = 0 And Val(Label2) > 0 Then
xs
Else
Label5.FontSize = 12
Label5 = "测验被终止！"
Label1 = ""
Text1 = ""
Timer1.Enabled = False
Label6.Width = 0 '进度条清零
Label9 = "00:00"
Label2 = 0
Label3 = 0
End If
Command1.Caption = "开始"
Command2.Enabled = False
End Sub
Private Sub xs()
'限时时间到或结束总结
If Len(Text4) = 0 Then
nval = InputBox("请输入您的大名。", "提示")
If nval <> "" Then
Text4 = nval
End If
End If
Label5.FontSize = 12
Label5 = Format(Date, "yyyy-mm-dd") & " " & Format(Time, "hh:mm") & " > " & Label8(0) & Label8(1) & Label8(2) & Label8(3) & " <" & Text4 & "> " & " 共答" & Label2 & "题，答错" & Label3 & "题，正确率是" & Format((Val(Label2) - Val(Label3)) / Label2 * 100, "0.##") & "%。"
Label1 = ""
Text1 = ""
Text3 = Text3 & Label5 & vbCrLf
Command1.Caption = "开始"
Command2.Enabled = False
End Sub
Private Sub Command3_Click()
'清空历史记录
Text3 = ""
Open "text.txt" For Output As 1
Write #1, Text3
Close
End Sub
Private Sub Command4_Click(Index As Integer)
Shape2.Width = 2000
If Index = 0 Then
Open "试卷.txt" For Output As 1
Print #1, vbTab & vbTab & Combo1 & Combo2 & Combo3 & "试卷"
For i = 1 To 25
For X = 1 To 4
Ct
If Len(Label1) < 9 Then
For z = 1 To 9 - Len(Label1)
Label1 = " " & Label1
Next z
End If
Print #1, Label1; vbTab; ' 不换行
Shape2.Width = Shape2.Width - 20
Next X
Print #1, ""
Next i
Close
MsgBox "已经在本程序的所在目录下，建立了一个有100道试题的" & vbCrLf & _
" 名为'试卷.txt'的文本文件，。请用其它文本编辑软件," & vbCrLf & _
"如写字板、word等打开编辑，谢谢！", , "输出试卷"
Else
nval = MsgBox("确实要打印<" & Combo1 & Combo2 & Combo3 & "试卷>" & "吗？", vbYesNo + vbQuestion, "错误")
If nval = vbYes Then
With Printer
.DrawStyle = 0
.DrawWidth = 2
.ScaleMode = 6
'打印标题
.CurrentX = 65
.CurrentY = 20
.Font.Size = 20
Printer.Print Combo1 & Combo2 & Combo3 & "试卷"
.Font.Size = 14
For i = 1 To 25
For X = 1 To 4
Ct
If Len(Label1) < 9 Then
For z = 1 To 9 - Len(Label1)
Label1 = " " & Label1
Next z
End If
.CurrentX = -20 + 40 * X
.CurrentY = 30 + i * 9
Printer.Print Label1
Shape2.Width = Shape2.Width - 20
Next X
Printer.Print ""
Next i
Printer.EndDoc
End With
End If
End If
End Sub
Private Sub Command5_Click()
'保存设置
ns = Combo1
tx1 = Combo2
tx2 = Combo3
js = Combo4
Open "sz.dat" For Random As #1
Put #1, , ns
Put #1, , tx1
Put #1, , tx2
Put #1, , js
Close
Command5.Enabled = False
End Sub
Private Sub Command6_Click(Index As Integer)
If Index = 10 Then
Text1 = ""
ElseIf Index = 11 Then
If Len(Text1) > 0 And Len(Label1) > 0 Then
Te '判断
End If
Else
Text1 = Text1 & Command6(Index).Caption
End If
End Sub
Private Sub Command7_Click()
'历史记录
Open "text.txt" For Output As 1
Write #1, Text3
Close
Command7.Enabled = False
End Sub
Private Sub Form_Load()
On Error Resume Next
Randomize
Open "sz.dat" For Random As #1
Get #1, , ns
Get #1, , tx1
Get #1, , tx2
Get #1, , js
Close
Open "text.txt" For Input As 1
Input #1, tx3
Close
Text3 = tx3
Combo1 = ns
Combo2 = tx1
Combo3 = tx2
Combo4 = js
Combo1_Click
Combo2_Click
Combo3_Click
Combo4_Click
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'退出前保存历史记录
Open "text.txt" For Output As 1
Write #1, Text3
Close
End Sub
Private Sub Label13_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label13.FontUnderline = True
Label13.ForeColor = &HC00000
End Sub
Private Sub Label13_Click()
Shell "NotePad.EXE " & App.Path & "\试卷.txt", vbNormalFocus
End Sub
Private Sub SSTab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label13.FontUnderline = False
Label13.ForeColor = &H0&
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
'记录键盘号
Select Case KeyCode
Case 96
ind = 0
Case 97
ind = 1
Case 98
ind = 2
Case 99
ind = 3
Case 100
ind = 4
Case 101
ind = 5
Case 102
ind = 6
Case 103
ind = 7
Case 104
ind = 8
Case 105
ind = 9
Case 48
ind = 0
Case 49
ind = 1
Case 50
ind = 2
Case 51
ind = 3
Case 52
ind = 4
Case 53
ind = 5
Case 54
ind = 6
Case 55
ind = 7
Case 56
ind = 8
Case 57
ind = 9
Case 110
ind = 10
Case 13
ind = 11
End Select
Command6(ind).BackColor = &H80000016
End Sub
Private Sub Te()
'判断答案正确与否
Label2 = Label2 + 1
If qh = 1 Then
adc = ""
For i = 1 To Len(Text1)
adc = Mid(Text1, i, 1) & adc
Next i
adc = Val(adc)
Else
adc = Val(Text1)
End If
If adc = ab Then
fh = " √"
Else
Label3 = Label3 + 1
fh = " ×"
End If
Text2 = Text2 & Label1 & adc & fh & vbCrLf
Label5.FontSize = 32
Label5 = Label1 & adc & fh
Text1 = ""
Ct '出题
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Len(Text1) > 0 And Len(Label1) > 0 Then
Te '判断
End If
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 110 Then Text1 = ""
Command6(ind).BackColor = &H8000000F
End Sub
Private Sub Text3_Change()
Command7.Enabled = True
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
If sjsz > 0 Then
ss = ss - 1
If mm = 0 And ss = 0 Then
Timer1.Enabled = False
If Val(Label2) > 0 Then xs
End If
If ss = -1 And mm > 0 Then mm = mm - 1: ss = 59
s = IIf(ss < 10, "0" & ss, "" & ss)
m = IIf(mm < 10, "0" & mm, "" & mm)
t = m & ":" & s
Label9 = t
Label6.Width = Label6.Width + labelw
Else
ss = ss + 1
If ss = 60 Then mm = mm + 1: ss = 0
s = IIf(ss < 10, "0" & ss, "" & ss)
m = IIf(mm < 10, "0" & mm, "" & mm)
t = m & ":" & s
Label9 = t
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -