📄 frmaddfillsubject.frm
字号:
VERSION 5.00
Begin VB.Form FrmAddFillSubject
Caption = "填空题入库"
ClientHeight = 9015
ClientLeft = 60
ClientTop = 345
ClientWidth = 8925
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 9015
ScaleWidth = 8925
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame3
Height = 1725
Left = 855
TabIndex = 12
Top = 4770
Width = 7215
Begin VB.ComboBox Combo2
Height = 300
ItemData = "FrmAddFillSubject.frx":0000
Left = 1485
List = "FrmAddFillSubject.frx":0010
Style = 2 'Dropdown List
TabIndex = 19
Top = 180
Width = 570
End
Begin VB.CommandButton Command5
Caption = "设定"
Height = 330
Left = 2160
TabIndex = 18
Top = 135
Width = 780
End
Begin VB.TextBox Text3
Height = 1140
Left = 90
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 17
Top = 495
Width = 7035
End
Begin VB.CommandButton Command4
Caption = "当前位置插入"
Height = 330
Left = 2970
TabIndex = 16
Top = 135
Width = 1320
End
Begin VB.CommandButton Command2
Caption = "核查题目"
Height = 330
Left = 4320
TabIndex = 13
Top = 135
Width = 1995
End
Begin VB.Label Label7
Caption = "填空位置分隔符："
Height = 285
Left = 90
TabIndex = 15
Top = 180
Width = 1635
End
End
Begin VB.Frame Frame2
Height = 1500
Left = 855
TabIndex = 5
Top = 6525
Width = 7260
Begin VB.CommandButton Command6
Caption = "重新设定"
Enabled = 0 'False
Height = 330
Left = 4005
TabIndex = 20
Top = 990
Width = 1770
End
Begin VB.CommandButton Command3
Caption = "确定"
Enabled = 0 'False
Height = 330
Left = 6075
TabIndex = 10
Top = 990
Width = 1050
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Enabled = 0 'False
Height = 285
Index = 1
Left = 3375
MultiLine = -1 'True
TabIndex = 8
Top = 540
Width = 3840
End
Begin VB.ComboBox Combo1
Enabled = 0 'False
Height = 300
ItemData = "FrmAddFillSubject.frx":0024
Left = 945
List = "FrmAddFillSubject.frx":0026
Style = 2 'Dropdown List
TabIndex = 6
Top = 540
Width = 1635
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "注：*号为空 #号为满"
ForeColor = &H000000FF&
Height = 180
Left = 810
TabIndex = 11
Top = 225
Width = 1710
End
Begin VB.Label Label4
Caption = "答案："
Height = 240
Left = 2745
TabIndex = 9
Top = 585
Width = 645
End
Begin VB.Label Label3
Caption = "填空号："
Height = 240
Left = 135
TabIndex = 7
Top = 585
Width = 780
End
End
Begin VB.CommandButton Command1
Caption = "取消"
Height = 375
Index = 1
Left = 6795
TabIndex = 4
Top = 8235
Width = 1320
End
Begin VB.CommandButton Command1
Caption = "入库"
Height = 375
Index = 0
Left = 5400
TabIndex = 3
Top = 8235
Width = 1320
End
Begin VB.Frame Frame1
Height = 150
Left = 0
TabIndex = 1
Top = 585
Width = 8520
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Enabled = 0 'False
Height = 3795
Index = 0
Left = 900
MultiLine = -1 'True
TabIndex = 0
Text = "FrmAddFillSubject.frx":0028
Top = 945
Width = 7170
End
Begin VB.Label Label6
Caption = "警告：请先设置好填空标记分隔符，请添加是注意使用，必须避免题目中有与分隔符相同的字符"
ForeColor = &H000000FF&
Height = 420
Left = 810
TabIndex = 14
Top = 90
Width = 7395
End
Begin VB.Image Image1
Height = 480
Left = 135
Picture = "FrmAddFillSubject.frx":0040
Top = 0
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "题目："
Height = 180
Index = 0
Left = 270
TabIndex = 2
Top = 990
Width = 540
End
End
Attribute VB_Name = "FrmAddFillSubject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rs As ADODB.Recordset
Dim SubjectTxt() As String '记录题目变量
Dim SubjectResult() As String
Dim ResultNum As Integer
Dim RSign As String
Private Sub Combo1_Click()
Text1(1).Text = SubjectResult(Val(Mid(Combo1.Text, 2)))
End Sub
Private Sub Command1_Click(Index As Integer)
Dim rsq As ADODB.Recordset
Dim qMsg$
Dim SQL$
Dim Result As String
Select Case Index
Case 0
If RSign = Empty Then
MsgBox "请设置标识字符", vbInformation, "Error"
Exit Sub
End If
If Text1(0).Text = Empty Then
MsgBox "请填写完整信息", vbInformation, "提示"
Exit Sub
End If
Result = Empty
Result = CheckResult
If Result = Empty Then: Exit Sub
DBName = ChoiceExerciseDB
SQL = "select * from ChoiceExercise Where Subject= '" & Text1(0).Text & "'"
Set rsq = executeSQL(SQL, qMsg, DBName)
Set rsq = Nothing
If qMsg = "查询正确" Then
MsgBox "已经有此题目", vbInformation, "提示"
Exit Sub
End If
Rs.AddNew
Rs.Fields(0) = Text1(0).Text
Rs.Fields(1) = RSign
Rs.Fields(2) = JiaMi(Result, Rs.RecordCount)
Rs.Fields(4) = ResultNum
Rs.Fields(5) = Rs.RecordCount
Rs.Update
Set Rs = Nothing
If MsgBox("题目添加成功，是否继续添加", vbInformation + vbYesNo, "成功") = vbYes Then
Text1(0).Text = Empty
Text1(0).Enabled = False
Text3.Text = Empty
Command3.Enabled = False
Command6.Enabled = False
RSign = Empty
Command5.Enabled = True
Combo2.Enabled = True
Combo1.Clear
Else
Set Rs = Nothing
Unload Me
End If
Case 1
Me.Hide
End Select
End Sub
Private Sub Command2_Click()
If RSign = Empty Then
MsgBox "请设置标识字符", vbInformation, "Error"
Exit Sub
End If
Text3.Text = "<题目浏览>" & vbCrLf
Combo1.Clear
SubjectTxt = Split(CheckSubject(RSign))
For i = LBound(SubjectTxt) To UBound(SubjectTxt) - 1
Text3.Text = Text3.Text & SubjectTxt(i)
If i <> 0 Then: Combo1.AddItem "*" & i
Next i
If ResultNum = 0 Then
MsgBox "无填空，请设置填空，标记为" & RSign, vbInformation, "Error"
Exit Sub
End If
ReDim SubjectResult(ResultNum) As String
Command6.Enabled = True
Combo1.Enabled = True
Text1(1).Enabled = True
Command3.Enabled = True
Command2.Enabled = False
Text1(0).Enabled = False
Command4.Enabled = False
End Sub
Private Sub Command3_Click()
If Text1(1).Text = Empty Then
Exit Sub
End If
SubjectResult(Val(Mid(Combo1.Text, 2))) = Text1(1).Text
Combo1.List(Combo1.ListIndex) = "#" & Combo1.ListIndex + 1
Text1(1).Text = Empty
End Sub
Private Sub Command4_Click()
If RSign = Empty Then
MsgBox "请设置标识字符", vbInformation, "Error"
Exit Sub
End If
Text1(0).SetFocus
SendKeys RSign
End Sub
Private Sub Command5_Click()
If Combo2.Text = Empty Then
MsgBox "请选择一个标识字符", vbInformation, "Error"
Exit Sub
End If
RSign = Combo2.Text
Combo2.Enabled = False
Command5.Enabled = False
Text1(0).Enabled = True
End Sub
Private Sub Command6_Click()
Command6.Enabled = False
Combo1.Enabled = False
Text1(1).Enabled = False
Command3.Enabled = False
Command2.Enabled = True
Text1(0).Enabled = True
Command4.Enabled = True
End Sub
Private Sub Form_Load()
Dim Msg$
Dim SQL$
DBName = ChoiceExerciseDB
SQL = "select * from FillSubject"
Set Rs = executeSQL(SQL, Msg, DBName)
End Sub
Function CheckSubject(Sign As String) As String
Dim txtCurrentPos As Integer
Dim txtMemo As String
Dim txtSubject As String
Dim txtResult As String
Dim txtNextPos As Integer
txtMemo = Trim(Text1(0).Text)
ResultNum = 0
Do While txtMemo <> Empty
txtCurrentPos = 1
txtNextPos = InStr(txtCurrentPos, txtMemo, Sign)
If txtNextPos = 0 Then
txtSubject = txtSubject & Mid(txtMemo, txtCurrentPos) & " "
Exit Do
End If
txtSubject = txtSubject & Mid(txtMemo, txtCurrentPos, txtNextPos - 1) & "__" & ResultNum + 1 & "__" & " "
ResultNum = ResultNum + 1
txtMemo = Mid(txtMemo, txtNextPos + 1)
Loop
CheckSubject = txtSubject
End Function
Function CheckResult() As String
Dim txtCurrentIndex As Integer
Dim txtResult As String
For txtCurrentIndex = 1 To UBound(SubjectResult)
If SubjectResult(txtCurrentIndex) = Empty Then
MsgBox "答案未设定，请核查", vbInformation, "错误"
Exit Function
End If
txtResult = txtResult & SubjectResult(txtCurrentIndex) & " "
Next txtCurrentIndex
CheckResult = txtResult
End Function
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 1 And KeyAscii = vbKeyReturn Then
Command3_Click
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -