Visual basic quiz program
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 2 of 2

Thread: Visual basic quiz program

  1. #1
    Join Date
    Jan 2011
    Posts
    1

    Post Visual basic quiz program

    Hi
    I am working on a quiz in VB6. It loads it's questions from a MS ACCESS database (with ms jet 4), loads every field from the database to a textbox or sort of checkbox (image object and changes the tag value from 0 to 1). Questions are shown as they are in the database, in the same order and folows them . There can be 1 correct answer, 2 or 3 corredt answers (out of 3). The program was working fine, until I came up with the idea to add a "I'll answer it later" button. I think I've tried every method possible with vectors to make it work properly and still, id doesen't.

    I have here the code of the form:


    Option Explicit


    Dim raspuns As Sir_Raspuns
    Dim stare As Boolean
    Dim s(20) As Byte
    Dim a, k As Integer
    Dim x, ss As Integer
    Dim cor, cx As Boolean
    Dim dm As Integer
    Dim xx, xx2 As Integer
    Dim i As Integer
    Dim ramase, corecte, gresite As Integer
    Dim min As Integer
    Dim sec As Integer
    Dim ax As Integer
    Dim at, bt, ct As String
    Dim ptg1, ptg2, ptg3 As Boolean
    Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

    Private Const SND_ASYNC = &H1
    Private Sub Cmd1_Click()
    rs.Edit
    rs!intrebare = txt.Text
    rs.Update
    End Sub

    Private Sub Command1_Click()
    Load MENIU
    MENIU.Show
    Unload c_A
    End Sub


    Private Sub Form_Load()
    stare = True
    cor = False
    corecte = 0
    gresite = 0
    ramase = 20
    ss = 1
    For k = 1 To 20
    s(k) = 2
    Next k
    min = 30
    sec = 0
    minute.Caption = min
    secunde.Caption = sec
    rs.MoveFirst
    i = 1
    If Dir(App.Path & "\imagini\A\1\" & i & "m.jpg") <> "" Then
    Picture1.Picture = LoadPicture(App.Path & "\imagini\A\1\" & i & "m.jpg")
    End If
    rs.MoveFirst

    txt.Text = rs!intrebare
    TextA.Text = rs!TextA
    TextB.Text = rs!TextB
    TextC.Text = rs!TextC

    'c = 0
    Label9.Caption = gresite
    Label7.Caption = corecte
    End Sub

    Private Sub Image1_Click()
    pic3.Tag = 0
    pic3.Picture = pic3_0.Picture
    pic2.Tag = 0
    pic2.Picture = pic2_0.Picture
    pic1.Tag = 0
    pic1.Picture = Pic1_0.Picture
    End Sub

    Private Sub Image2_Click()

    s(i) = 1
    i = i + 1

    If (i >= 20) Then
    rs.MoveFirst
    Do While (s(i) = 2) Or (s(i) = 0)
    i = i + 1
    rs.MoveNext
    Loop

    Else

    rs.MoveNext
    txt.Text = rs!intrebare
    TextA.Text = rs!TextA
    TextB.Text = rs!TextB
    TextC.Text = rs!TextC
    Picture1.Picture = Nothing
    If Dir(App.Path & "\imagini\a\1\" & i & "m.jpg") <> "" Then
    Picture1.Picture = LoadPicture(App.Path & "\imagini\a\1\" & i & "m.jpg")
    End If
    'i = i + 1
    End If
    pic1.Tag = 0: pic2.Tag = 0: pic3.Tag = 0
    ptg1 = False: ptg2 = False: ptg3 = False
    pic3.Picture = pic3_0.Picture: pic2.Picture = pic2_0.Picture: pic1.Picture = Pic1_0.Picture
    '/Afisare
    End Sub

    Private Sub Pic1_Click()

    pic1.Tag = 1
    pic1.Picture = Pic1_1.Picture


    End Sub

    Private Sub pic2_Click()

    pic2.Tag = 1
    pic2.Picture = pic2_1.Picture

    End Sub

    Private Sub pic3_Click()

    pic3.Tag = 1
    pic3.Picture = pic3_1.Picture

    End Sub


    Private Sub Picture2_Click()
    Load MENIU
    MENIU.Show
    Unload c_A
    End Sub

    Private Sub Picture3_Click()
    If stare = True Then
    For k = 1 To 20
    If s(k) = 0 Then
    stare = True
    Else

    Next k

    i = 1
    'If s(i) = 0 Then
    rs.MoveFirst
    Do While (s(i) = 0) And (i <= 20)
    i = i + 1
    rs.MoveNext
    Loop
    s(i) = 1

    ' cx = False
    'Else
    ' cx = True
    'End If

    initializare_ptg
    If (ptg1 = rs!a) And (ptg2 = rs!b) And (ptg3 = rs!c) Then
    cor = True
    Else
    If (ptg1 = False) And (ptg2 = False) And (ptg3 = False) Then
    Exit Sub
    End If
    cor = False
    End If

    If cor Then
    cor = False
    corecte = corecte + 1
    ramase = ramase - 1
    Else
    gresite = gresite + 1
    ramase = ramase - 1
    End If
    If (gresite > 2) Then
    a = MsgBox("Respins", vbInformation, "Rezultat")

    Unload c_A
    End If
    If (corecte >= 17) And (gresite <= 2) And (ramase = 0) Then
    a = MsgBox("Admis", vbInformation, "Rezultat")

    Unload c_A
    End If
    's(i) = 0
    'If cx Then
    rs.MoveNext
    i = i + 1
    'End If
    'Afisare+reinitializare
    Label5.Caption = ramase
    Label7.Caption = corecte
    Label9.Caption = gresite
    txt.Text = rs!intrebare
    TextA.Text = rs!TextA
    TextB.Text = rs!TextB
    TextC.Text = rs!TextC
    Picture1.Picture = Nothing
    If Dir(App.Path & "\imagini\a\1\" & i & "m.jpg") <> "" Then
    Picture1.Picture = LoadPicture(App.Path & "\imagini\a\1\" & i & "m.jpg")
    End If
    pic1.Tag = 0: pic2.Tag = 0: pic3.Tag = 0
    ptg1 = False: ptg2 = False: ptg3 = False
    pic3.Picture = pic3_0.Picture: pic2.Picture = pic2_0.Picture: pic1.Picture = Pic1_0.Picture
    '/Afisare
    End Sub

    Private Sub Timer1_Timer()
    secunde.Caption = sec

    secunde.Refresh

    If sec <= 0 Then
    min = min - 1
    sec = 59
    secunde.Caption = sec
    minute.Caption = min
    minute.Refresh
    secunde.Refresh
    Else
    sec = sec - 1
    secunde.Caption = sec
    secunde.Refresh
    End If
    If (min <= 0) And (sec <= 0) Then
    ax = MsgBox("Respins", vbExclamation, "Rezultat")
    Unload c_A
    End If
    End If

    End Sub

    Public Sub initializare_ptg()
    If pic1.Tag = 1 Then
    ptg1 = True
    Else
    ptg1 = False
    End If
    If pic2.Tag = 1 Then
    ptg2 = True
    Else
    ptg2 = False
    End If
    If pic3.Tag = 1 Then
    ptg3 = True
    Else
    ptg3 = False
    End If
    End Sub



    End Function



    Any ideas how to make it work?
    Or do you have any similar quizes already made? (with answer later button)

  2. #2
    Join Date
    Jan 2006
    Location
    Chicago, IL
    Posts
    14,987

    Re: Visual basic quiz program

    Use CODE TAGS, first off. Then, write down the steps that you are trying to perform, to see if they will work ON PAPER. (I'd bet you'd see the error immediately)

    Code:
    '  To use Code Tags
    David

    CodeGuru Article: Bound Controls are Evil-VB6
    2013 Samples: MS CODE Samples

    CodeGuru Reviewer
    2006 Dell CSP
    2006, 2007 & 2008 MVP Visual Basic
    If your question has been answered satisfactorily, and it has been helpful, then, please, Rate this Post!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center