⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 selectquestions.frm

📁 it is a quiz application
💻 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 + -