Tạo chương trình trắc nghiệm có tính thời gian bằng Access

thời gian bằng Access
Đó hỏi: Em đang làm chương trình trắc nghiệm bằng Access. Chương trình sẽ lấy ngẫu nhiên 20 câu hỏi từ 2 bảng chứa ngân hàng câu hỏi, mỗi bảng lấy 10 câu. Thời gian trả lời mỗi câu là 30 giây. Xin e-CHÍP hướng dẫn cách lấy ngẫu nhiên 20 câu trắc nghiệm từ ngân hàng câu hỏi và cách tạo form giống như phần thi trắc nghiệm lái xe trên máy tính, có hiển thị thời gian cho mỗi câu.
Đây trả lời: Về việc chọn ngẫu nhiên số câu hỏi trong chương trình thi trắc nghiệm, bạn có thể xem bài viết trên tuần tin e-CHÍP số 345: [You must be registered and logged in to see this link.]
Ví dụ sau đây trình bày cách tạo form giống như phần thi trắc nghiệm luật giao thông (hình 1). Khác với form trong bài viết nêu trên, ở đây mọi control trên form đều là label (lblCauSo để hiển thị số thứ tự câu hỏi; lblNoiDung để hiển thị nội dung câu hỏi; lblTraLoi1, lblTraLoi2, lblTraLoi3, lblTraLoi4 để hiển thị 4 đáp án được quyền chọn; lblTGConLai để hiển thị thời gian tính lùi; lblDonViTG để hiển thị đơn vị đo thời gian), chỉ có các ô trả lời thuộc loại text box (txtTraLoiCau1, txtTraLoiCau2, txtTraLoiCau3,... để người sử dụng gõ đáp án). Tên các control như trong hình. Form này cũng sử dụng query qryDeThiVaKetQua làm Record Source.
Giống như chương trình trắc nghiệm luật giao thông, ta thiết kế đơn giản: thí sinh chỉ cần dùng hai phím mũi tên đi lên, đi xuống để chọn câu hỏi; 4 phím số 1, 2, 3, 4 để chọn đáp án đúng; phím ESC để chấm dứt bài thi, tính điểm.
Mỗi lần form được mở sẽ có 3 câu hỏi ngẫu nhiên (nhiều câu hỏi hơn thì làm tương tự) được lọc ra, khi con trỏ nằm ở ô text box tương ứng với câu nào thì nội dung câu hỏi đó được hiển thị. Bạn gõ đoạn mã 1 vào form.
Hình 1: Form trắc nghiệm




Đoạn mã 1
Dim nTGianLamBai As Byte, rs As Recordset
Private Sub ChonDe()
Dim db As Database, tbDeThi As Recordset, tbNganHang As Recordset
Dim rsTamThoi As Recordset
Dim nSoLuongCau As Byte, I As Byte, sSQL As String
Dim nTongSoCauTrongNH As Long, nSoNgauNhien As Long
nSoLuongCau = 3 ' Ví dụ với 3 câu
Set db = CurrentDb
Set tbNganHang = db.OpenRecordset("NganHangCauHoi")
tbNganHang.MoveFirst
If tbNganHang.EOF Then
MsgBox "Không có câu hỏi trong ngân hàng dữ liệu đề thi !"
tbNganHang.Close
db.Close
Exit Sub
End If
'------------------------------------------------------------
' Tạo bộ đề cho bảng DeThiVaKetQua
'------------------------------------------------------------
' Xóa đề thi trước đó
sSQL = "DELETE * FROM DeThiVaKetQua;"
db.Execute sSQL
sSQL = "SELECT Max(SoThuTu) AS TongSoCauHoi FROM NganHangCauHoi"
Set rsTamThoi = db.OpenRecordset(sSQL)
rsTamThoi.MoveFirst
nTongSoCauTrongNH = rsTamThoi!TongSoCauHoi
rsTamThoi.Close
Set tbDeThi = db.OpenRecordset("DeThiVaKetQua")
' Đề mới
tbNganHang.Index = "SoThuTu"
For I = 1 To nSoLuongCau
Do While True
nSoNgauNhien = Int((nTongSoCauTrongNH * Rnd) + 1)
tbNganHang.Seek "=", nSoNgauNhien
If Not tbNganHang.NoMatch Then
If Not tbNganHang!DaDuocChon Then
tbDeThi.AddNew
tbDeThi!SoThuTu = I
tbDeThi!NoiDung = tbNganHang!NoiDung
tbDeThi!TraLoi1 = tbNganHang!TraLoi1
tbDeThi!TraLoi2 = tbNganHang!TraLoi2
tbDeThi!TraLoi3 = tbNganHang!TraLoi3
tbDeThi!TraLoi4 = tbNganHang!TraLoi4
tbDeThi!DapAnDung = tbNganHang!DapAnDung
tbDeThi!DapAnDuocChon = 0
tbDeThi!Diem = 0
tbDeThi.Update
tbNganHang.Edit
tbNganHang!DaDuocChon = True
tbNganHang.Update
Exit Do
End If
End If
Loop
Next
tbDeThi.Close
'----------------------------------------------------------------------------------
' Đánh dấu chưa được chọn đối với các câu còn lại
'----------------------------------------------------------------------------------
tbNganHang.Close
sSQL = "UPDATE NganHangCauHoi SET DaDuocChon = False WHERE DaDuocChon = True"
db.Execute (sSQL)
db.Close
'-----------------------------------------------------------------
' Hiển thị đề trên biểu mẫu
'-----------------------------------------------------------------
Me.Requery
End Sub

Private Sub KetQua()
Dim nTongDiem As Byte, db As Database, sSQL As String, rsKetQua As Recordset
Set db = CurrentDb
sSQL = "SELECT SUM(Diem) As TongDiem FROM DeThiVaKetQua"
Set rsKetQua = db.OpenRecordset(sSQL)
rsKetQua.MoveFirst
nTongDiem = rsKetQua!TongDiem
MsgBox "Tổng số điểm đạt được là: " & nTongDiem, vbInformation, Me.Caption
Set rsKetQua = Nothing
Set db = Nothing
Set rs = Nothing
End Sub
Private Sub Form_Current()
lblCauSo.Caption = Str(Me.SoThuTu)
lblNoiDung.Caption = Me.NoiDung
lblTraLoi1.Caption = "1) " & Me.TraLoi1
lblTraLoi2.Caption = "2) " & Me.TraLoi2
lblTraLoi3.Caption = IIf(IsNull(Me.TraLoi3), "", "3) " & Me.TraLoi3)
lblTraLoi4.Caption = IIf(IsNull(Me.TraLoi4), "", "4) " & Me.TraLoi4)
grpTraLoi = Me.DapAnDuocChon
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode >= 97 And KeyCode <= 100 Then ' Các phím số 1 đến số 4
SendKeys "{ENTER}"
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 27 ' Phím ESC
Call KetQua
DoCmd.Close
End Select
End Sub
Private Sub Form_Load()
Set rs = Me.Recordset
Call ChonDe ' Tạo đề thi
nTGianLamBai = 10 ' 10 phút, 20 câu, mỗi câu 30 giây
lblTGConLai.Caption = Trim(Str(nTGianLamBai))
Me.TimerInterval = 60000 ' 60 giây, tương đương chu kỳ 1 phút
End Sub
Private Sub Form_Timer()
nTGianLamBai = nTGianLamBai - 1
lblTGConLai.Caption = Trim(Str(nTGianLamBai))
If lblDonViTG.Caption = "giây" Then
If nTGianLamBai = 0 Then
Me.TimerInterval = 0
Call KetQua
DoCmd.Close
End If
Else ' phút
If nTGianLamBai = 1 Then
nTGianLamBai = 60 ' Số giây còn lại
lblTGConLai.Caption = Trim(Str(nTGianLamBai))
lblDonViTG.Caption = "giây"
Me.TimerInterval = 1000 ' 1 giây, tương đương chu kỳ 1 giây
End If
End If
End Sub
Private Sub txtTraLoiCau1_GotFocus()
rs.FindFirst "SoThuTu=1"
End Sub
Private Sub txtTraLoiCau1_AfterUpdate()
If Not IsNull(txtTraLoiCau1) Then
Me.DapAnDuocChon = txtTraLoiCau1 ' Lưu lại kết quả nếu cần
Me.Diem = IIf(Me.DapAnDuocChon = Me.DapAnDung, 1, 0)
End If
End Sub
Private Sub txtTraLoiCau2_GotFocus()
rs.FindFirst "SoThuTu=2"
End Sub
Private Sub txtTraLoiCau2_AfterUpdate()
If Not IsNull(txtTraLoiCau2) Then
Me.DapAnDuocChon = txtTraLoiCau2 ' Lưu lại kết quả nếu cần
Me.Diem = IIf(Me.DapAnDuocChon = Me.DapAnDung, 1, 0)
End If
End Sub
Private Sub txtTraLoiCau3_GotFocus()
rs.FindFirst "SoThuTu=3"
End Sub
Private Sub txtTraLoiCau3_AfterUpdate()
If Not IsNull(txtTraLoiCau3) Then
Me.DapAnDuocChon = txtTraLoiCau3 ' Lưu lại kết quả nếu cần
Me.Diem = IIf(Me.DapAnDuocChon = Me.DapAnDung, 1, 0)
End If
End Sub