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

Ví dụ sau đây minh họa chương trình trắc nghiệm mà bạn muốn thể hiện giống như phần thi trắc nghiệm lái xe trên máy tính. Nếu ai chưa thi lấy bằng lái xe rồi thì cần hình dung giao diện như hình 1.

Ý tưởng của việc trắc nghiệm môn luật giao thông trên máy tính là: vì các thí sinh đi thi lấy bằng lái xe không phải ai cũng biết sử dụng máy vi tính, nên chương trình phải được thiết kế sao cho người sử dụng chỉ cần biết sử dụng 2 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; và 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õ các đoạn mã sau đây vào form:

Dim nTGianLamBai As Byte, rs As Recordset

Private Sub ChonDe()

Dim db As Database, tbDeThi As Recordset, _

tbNganHang As Recordset, sTamThoi 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 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, 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, 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ả

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ả

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ả

Me.Diem = IIf(Me.DapAnDuocChon = Me.DapAnDung, 1, 0)

End If

End Sub