Đăng Nhập

Vui lòng khai báo chính xác tên truy cập và mật khẩu!

Quên mật khẩu?

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

Share
    Admin

    Giới tính : Nam

    Đến từ : TPHCM

    Ngày Tham gia : 03/04/2011

    Tổng số bài gửi : 2292

    #1

     on Tue Sep 20, 2011 9:07 pm

    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
    [Click để xem tài sản / chữ kí của Admin]