📄 selectquestions.frm
字号:
VERSION 5.00
Begin VB.Form frmselect
BorderStyle = 1 'Fixed Single
Caption = "Select / Delete Questions"
ClientHeight = 6195
ClientLeft = 45
ClientTop = 330
ClientWidth = 7455
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6195
ScaleWidth = 7455
Begin VB.CommandButton Command3
Caption = "Delete"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3360
TabIndex = 6
Top = 5520
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "Close"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4920
TabIndex = 5
Top = 5520
Width = 1335
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 285
Left = 6480
Locked = -1 'True
TabIndex = 4
Text = "0"
Top = 480
Width = 375
End
Begin VB.CommandButton Command1
Caption = "Select"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1800
TabIndex = 2
Top = 5520
Width = 1335
End
Begin VB.ListBox List1
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4380
Left = 360
MultiSelect = 2 'Extended
TabIndex = 0
Top = 840
Width = 6735
End
Begin VB.Label Label2
Caption = "Selected"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5640
TabIndex = 3
Top = 480
Width = 975
End
Begin VB.Label Label1
Caption = "Select / Delete Questions "
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 1
Top = 240
Width = 3375
End
End
Attribute VB_Name = "frmselect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rec As Recordset
Private Sub Command1_Click()
If sel <> 20 Then 'Do not allow question selection if user selectes question not equal to 20
MsgBox " You have selected " + Str(sel) + " Questions.", vbCritical, " Please Select 20 Questions "
Exit Sub
End If
Dim i As Byte
db.Execute "update question set selected = false where selected =true" 'First Unselect all the questions
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
db.Execute "update question set selected = true where qno =" & i + 1 ' Then select desired questions
End If
Next
db.Close
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
If List1.ListCount - sel < 20 Then 'Deleting is not allowed if it does not reult in atleast 20 Questions in Database
MsgBox "You Can Not Delete Questions.", vbCritical, "Minimum 20 Questions Required"
Exit Sub
Else
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
db.Execute "delete * from question where qno=" & i + 1 'Delete desired questions one by one
End If
Next
updateqno 'Changes qno in table to consequend numbers
selagain 'Select first 20 questions
filllist 'Refreshes ListBox from Data
End If
End Sub
Private Sub Form_Load()
Set db = OpenDatabase("quiz.mdb", False, False, ";pwd=ssr2197")
filllist 'Fill List1
End Sub
Function sel() As Byte
Dim sele As Byte
sele = 0
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then sele = sele + 1
Next
sel = sele 'Returnes number of selected question in list
End Function
Private Sub List1_Click()
Text1 = sel 'Displays selected questions
End Sub
Sub updateqno() 'Reorders qno in the table
Dim i As Byte
Set rec = db.OpenRecordset("select * from question ")
rec.Sort = "qno"
rec.MoveFirst
While rec.EOF = False
i = i + 1
db.Execute "update question set qno=" & i & " where qno =" & rec!qno
rec.MoveNext
Wend
End Sub
Sub filllist() 'Fills List1
List1.Clear
Set rec = db.OpenRecordset("select * from question order by qno")
rec.MoveFirst
While rec.EOF = False
List1.AddItem Str(rec!qno) + " " + rec!question
rec.MoveNext
Wend
End Sub
Sub selagain() 'Selects First 20 questions from the table
db.Execute "update question set selected=false where selected = true"
db.Execute "update question set selected=true where qno < 21"
MsgBox "First 20 Questions are Automatically Selected for the quiz" + Chr(10) + "After Deleting some Questions", vbInformation, "Question Selection Changed"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -