📄 frmeditfillsubject.frm
字号:
VERSION 5.00
Begin VB.Form FrmEditFillSubject
Caption = "编辑选择题"
ClientHeight = 8985
ClientLeft = 60
ClientTop = 345
ClientWidth = 9210
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 8985
ScaleWidth = 9210
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Command4
Caption = "当前位置插入"
Height = 330
Left = 2250
TabIndex = 16
Top = 4860
Width = 1320
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 330
Index = 1
Left = 1080
Locked = -1 'True
TabIndex = 14
Top = 4860
Width = 1095
End
Begin VB.TextBox Text2
Height = 375
Index = 0
Left = 1080
TabIndex = 12
Top = 6660
Visible = 0 'False
Width = 1590
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = "F:\My Documents\VB\考试管理系统\服务器\examktl.dll"
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 4275
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "FillSubject"
Top = 8685
Visible = 0 'False
Width = 2175
End
Begin VB.CommandButton Command1
Caption = "返回"
Height = 375
Index = 7
Left = 6885
TabIndex = 10
Top = 8190
Width = 1185
End
Begin VB.CommandButton Command1
Caption = "更新"
Enabled = 0 'False
Height = 375
Index = 6
Left = 5445
TabIndex = 9
Top = 8190
Width = 510
End
Begin VB.CommandButton Command1
Caption = "删除"
Height = 375
Index = 5
Left = 4905
TabIndex = 8
Top = 8190
Width = 510
End
Begin VB.CommandButton Command1
Caption = "编辑"
Height = 375
Index = 4
Left = 4365
TabIndex = 7
Top = 8190
Width = 510
End
Begin VB.CommandButton Command1
Caption = ">>"
Height = 375
Index = 3
Left = 3915
TabIndex = 6
Top = 8190
Width = 420
End
Begin VB.CommandButton Command1
Caption = ">"
Height = 375
Index = 2
Left = 3465
TabIndex = 5
Top = 8190
Width = 420
End
Begin VB.CommandButton Command1
Caption = "<"
Height = 375
Index = 1
Left = 3015
TabIndex = 4
Top = 8190
Width = 420
End
Begin VB.CommandButton Command1
Caption = "<<"
Height = 375
Index = 0
Left = 2565
TabIndex = 3
Top = 8190
Width = 420
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 3795
Index = 0
Left = 1080
MultiLine = -1 'True
TabIndex = 1
Text = "FrmEditFillSubject.frx":0000
Top = 1035
Width = 7170
End
Begin VB.Frame Frame1
Height = 150
Left = 180
TabIndex = 0
Top = 675
Width = 8520
End
Begin VB.Label Label5
Caption = "答案："
Height = 330
Left = 225
TabIndex = 17
Top = 6705
Width = 915
End
Begin VB.Label Label4
Caption = "填空标记："
Height = 375
Left = 225
TabIndex = 15
Top = 4905
Width = 960
End
Begin VB.Label Label3
Caption = "Label3"
Height = 1230
Left = 1080
TabIndex = 13
Top = 5400
Width = 7125
End
Begin VB.Label Label2
Height = 240
Left = 1080
TabIndex = 11
Top = 270
Width = 2805
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "题目："
Height = 180
Index = 0
Left = 450
TabIndex = 2
Top = 1080
Width = 540
End
Begin VB.Image Image1
Height = 480
Left = 315
Picture = "FrmEditFillSubject.frx":0018
Top = 90
Width = 480
End
End
Attribute VB_Name = "FrmEditFillSubject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FristRun As Boolean
Dim ResultNum As Integer
Private Sub Command1_Click(Index As Integer)
'On Error Resume Next
Dim n As Integer
Select Case Index
Case 0
Data1.Recordset.MoveFirst
Case 1
If Data1.Recordset.AbsolutePosition <= 0 Then
MsgBox "已经是第一条记录！", vbInformation, "提示"
Data1.Recordset.MoveFirst
Exit Sub
End If
Data1.Recordset.MovePrevious
Case 2
If Data1.Recordset.AbsolutePosition = Data1.Recordset.RecordCount - 1 Then
MsgBox "已经是最后一条记录！", vbInformation, "提示"
Data1.Recordset.MoveLast
Exit Sub
End If
Data1.Recordset.MoveNext
Case 3
Data1.Recordset.MoveLast
Case 4
Text1(0).Enabled = True
Command1(4).Enabled = False
Command1(6).Enabled = True
Case 5
If MsgBox("确认删除此题目吗?", vbInformation + vbYesNo, "提示") = vbYes Then
Data1.Recordset.Delete
Data1.Recordset.MoveFirst
Else
Exit Sub
End If
Case 6
Call UpdateFillSubject
Command1(6).Enabled = False
Command1(4).Enabled = True
Case 7
If Command1(6).Enabled = True Then
If MsgBox("确认放弃修改?", vbInformation + vbYesNo, "提示") = vbYes Then
Unload Me
Exit Sub
End If
Else
Unload Me
Exit Sub
End If
Exit Sub
End Select
Call ViewRS
End Sub
Private Sub Command4_Click()
If Text1(1) = Empty Then
MsgBox "请设置标识字符", vbInformation, "Error"
Exit Sub
End If
Command4.Enabled = False
Text1(0).SetFocus
SendKeys Text1(1)
End Sub
Private Sub Form_Activate()
If FristRun = True Then
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
Call ViewRS
FristRun = False
End If
End Sub
Private Sub Form_Load()
FristRun = True
Data1.DatabaseName = App.Path & "\" & ChoiceExerciseDB
End Sub
Sub ViewRS()
On Error Resume Next
Dim r() As String
Text1(0).Text = Data1.Recordset.Fields(0)
Text1(1).Text = Data1.Recordset.Fields(1)
Label3.Caption = CheckSubject(Text1(0).Text, Text1(1).Text)
ViewText2 ResultNum
r = Split(JieMi(Data1.Recordset.Fields(2), Data1.Recordset("key")))
For i = 0 To Text2.Count - 1
Text2(i).Text = r(i)
Next i
Label2.Caption = "第 " & Data1.Recordset.AbsolutePosition + 1 & " 题/共 " & Data1.Recordset.RecordCount & " 题"
End Sub
Sub ViewText2(FillNum As Integer)
Dim col As Integer
Dim raw As Integer
col = 0
raw = 0
Text2(0).Text = ""
For i = Text2.Count - 1 To 1 Step -1
Unload Text2(i)
Next i
For i = 0 To FillNum - 1
If i <> 0 Then
Load Text2(i)
End If
If col = 3 Then
col = 0
raw = raw + 1
End If
Text2(i).Left = Text2(0).Left + Text2(0).Width * col
Text2(i).Top = Text2(0).Top + Text2(0).Height * raw
Text2(i).Visible = True
col = col + 1
Next i
End Sub
Function CheckSubject(cMemo As String, 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(cMemo)
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
Sub UpdateFillSubject()
Dim Result As String
For i = 0 To Text2.Count - 1
If Text2(i) = Empty Then
MsgBox "请输入答案", vbInformation, "错误"
Exit Sub
End If
Result = Result & Text2(i).Text & " "
Next i
Data1.Recordset.Edit
Data1.Recordset.Fields(0) = Text1(0).Text
'Data1.Recordset.Fields(1) = RSign
Data1.Recordset.Fields(3) = Null
' Data1.Recordset.Fields(5) = Text3.Text
Data1.Recordset.Fields(2) = JiaMi(Result, Data1.Recordset("key"))
Data1.Recordset.Update
End Sub
Private Sub Text1_LostFocus(Index As Integer)
Dim r() As String
Label3.Caption = CheckSubject(Text1(0).Text, Text1(1).Text)
ViewText2 ResultNum
r = Split(JieMi(Data1.Recordset.Fields(2), Data1.Recordset("key")))
For i = 0 To Text2.Count - 1
Text2(i).Text = r(i)
Next i
Command4.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -