Help if you can

vb6 Egypt
  • 19 years ago

    help me if you can , when i make my QUIZ program ,
    i have an eror here


    Dim ans As Integer


    Private Sub cmdSave_Click()
    If txtQuestion <> "" And txtAnsA <> "" And txtAnsB <> "" And txtAnsC <> "" And txtAnsD <> "" And MaskEdBox1 <= 4 Then
    'f MaskEdBox1.Mask = 0 Then Me.Hide
       filenum = FreeFile
       fileans = FreeFile
       Open dataFileLoc For Append As #filenum
       Write #filenum, txtQuestion, txtAnsA, txtAnsB, txtAnsC, txtAnsD:   dataFileLoc = GetSetting(appname, Data, "Data File Loc"): Write #fileans, (MaskEdBox1)
               Me.Hide
       Close
    Else
    'fields contain null strings
    'dont save , or error SHARIF
    MsgBox "FILL ALL FEAILDS", vbInformation, "Enter Data"
    End If
    End Sub


    Private Sub FormLoad()
    txtQuestion = ""
    txtAnsA = ""
    txtAnsB = ""
    txtAnsC = ""
    txtAnsD = ""
    MaskEdBox1 = 0
    ''GET DATA FILE LOCATION FROM REG
    EDIT - SHARIF
    dataFileLoc = GetSetting(appname, "Data", "Data File Loc")
    End Sub


    i want make the Maskedbox1 work!


    it's put in the txt file an eror
    i want it like this


    " qution ","answer1","answer2","answer3","answer4 ",3


    but it's make the file like this
    " qution ","answer1","answer2","answer3","answer4 ","3"


    and my Module is :
    Public dataFileLoc As String, datafile As String
    Public appname As String, formname As String
    Public AdvanceWrong As String
    Public WrongAnsPic As String, CorrectAnsPic As String
    Public QuizBackGround As String, ButtonType As String


    Public QuizBackGroundEnable As String


    Public TransState As String


    '''''PROGRESS BAR CONTROL
    Public Sub Update_ProgressBar()
           Dim Counter As Integer
           Dim Workarea(500) As String
           frmSplash.ProgressBar1.Min = LBound(Workarea)
           frmSplash.ProgressBar1.Max = UBound(Workarea)
           frmSplash.ProgressBar1.Visible = True


           'Set the Progress's Value to Min.
           frmSplash.ProgressBar1.Value = frmSplash.ProgressBar1.Min


           'Loop through the array.
           For Counter = LBound(Workarea) To UBound(Workarea)
           'Set initial values for each item in the array.
           Workarea(Counter) = "Initial value" & Counter
           frmSplash.ProgressBar1.Value = Counter


           Next Counter
           'ProgressBar1.Visible = False
           frmSplash.ProgressBar1.Value = frmSplash.ProgressBar1.Min
    ''MsgBox appname
    End Sub



    Public Sub FormFontWhite()


       '''ENABLE TRANSPARENT CONTROLS ON FORM
       For X = 1 To 4
           frmMain.lblAns(X).ForeColor = vbWhite
       Next X
       
       frmMain.lblQuestion.ForeColor = vbWhite
       
       
       frmMain.lblQuestNum.ForeColor = vbWhite
       
       
       frmMain.lblAnswerStat.ForeColor = vbWhite
       
       
       frmMain.lblStatus.ForeColor = vbWhite
       
       frmMain.lblRandomQuests.ForeColor = vbWhite
       
       frmMain.lblTimer.ForeColor = vbWhite


    End Sub



    Public Sub FormFontBlack()


       '''ENABLE TRANSPARENT CONTROLS ON FORM
       For X = 1 To 4
           frmMain.lblAns(X).ForeColor = vbBlack
       Next X
       
       frmMain.lblQuestion.ForeColor = vbBlack
       
       
       frmMain.lblQuestNum.ForeColor = vbBlack
       
       
       frmMain.lblAnswerStat.ForeColor = vbBlack
       
       
       frmMain.lblStatus.ForeColor = vbBlack
       
       frmMain.lblRandomQuests.ForeColor = vbBlack
       
       frmMain.lblTimer.ForeColor = vbBlack


    End Sub



    Public Sub FormTransControls()


       '''ENABLE TRANSPARENT CONTROLS ON FORM
       For X = 1 To 4
           frmMain.lblAns(X).BackStyle = 0
       Next X
       
       frmMain.lblQuestion.BackStyle = 0
       
       
       frmMain.lblQuestNum.BackStyle = 0
       frmMain.lblQuestNum.BorderStyle = 0
       
       
       frmMain.lblAnswerStat.BackStyle = 0
       frmMain.lblAnswerStat.BorderStyle = 0
       
       
       frmMain.lblStatus.BackStyle = 0
       frmMain.lblStatus.BorderStyle = 0
       
       frmMain.lblRandomQuests.BackStyle = 0
       frmMain.lblRandomQuests.BorderStyle = 0
       
       frmMain.lblTimer.BackStyle = 0
       frmMain.lblTimer.BorderStyle = 0
       
       TransState = "True"
       SaveSetting appname, "Data", "TransState", TransState



    End Sub


    Public Sub FormTransControls_Disable()


       '''ENABLE TRANSPARENT CONTROLS ON FORM
       For X = 1 To 4
           frmMain.lblAns(X).BackStyle = 1
       Next X
       
       frmMain.lblQuestion.BackStyle = 1
       
       
       frmMain.lblQuestNum.BackStyle = 1
       frmMain.lblQuestNum.BorderStyle = 1
       
       
       frmMain.lblAnswerStat.BackStyle = 1
       frmMain.lblAnswerStat.BorderStyle = 1
       
       
       frmMain.lblStatus.BackStyle = 1
       frmMain.lblStatus.BorderStyle = 1
       
       frmMain.lblRandomQuests.BackStyle = 1
       frmMain.lblRandomQuests.BorderStyle = 1
       
       frmMain.lblTimer.BackStyle = 1
       frmMain.lblTimer.BorderStyle = 1
       
       TransState = "False"
       SaveSetting appname, Data, "TransState", TransState



    End Sub



    and the form main is :
    Dim correctAns() As Integer
    Dim question() As String, ans1() As String, ans2() As String, ans3() As String, ans4() As String
    Public num As Integer
    Dim questCount As Integer
    Public numCorrect As Integer
    Public numWrong As Integer
    Public numTries As Integer
    Dim starttime As Single, clearStatus As Integer
    Dim totquest As Integer


    Public randomQuestValue As String


    Public NL



    Public Sub cmdAns_Click(Index As Integer)
    Dim choice As Integer
    choice = cmdAns(Index).Index


    StatusBar1.SimpleText = "Press a button to play."


    'start the timer when button presssed only
    If numTries = 0 Then
       starttime = Timer
       Timer1.Enabled = True
    End If


    numTries = numTries + 1



    If choice = correctAns(num) Then
       numCorrect = numCorrect + 1
       Set Picture1.Picture = LoadPicture(CorrectAnsPic)
       
       StatusBar1.SimpleText = "Correct Answer"
       
       lblAnswerStat.Caption = "CORRECT ANSWER:"
       Beep
       Beep
       
       Picture1.BackColor = &H80000005
       lblAnswerStat.BackColor = &H80000005
       
       lblStatus.Caption = "You got " & numCorrect & " answers right." & Chr(13) & "You got " & numWrong & " answers wrong." & Chr(13) & "Your attempts were " & numTries & Chr(13) & questCount & " questions available."
       
       
       '''DISPLAY A MESSAGE INDICATING IF RANDOM QUESTIONS ARE TO BE USED
       If randomQuestValue = "True" Then
           lblRandomQuests.Caption = "Random Questions Enabled"
       Else
           lblRandomQuests.Caption = "Random Questions Disabled"
       End If
         
       num = num + 1
       
       If num <> questCount Then
       
           ''ACTIVATE RANDOM QUESTION LOADING
           If randomQuestValue = "True" Then
               randomQuestion (totquest)
           End If


           Call display_question(num)


       Else
       
       End If


    Else
           Set Picture1.Picture = LoadPicture(WrongAnsPic)
           numWrong = numWrong + 1
           lblStatus.Caption = "You got " & numCorrect & " answers right." & Chr(13) & "You got " & numWrong & " answers wrong." & Chr(13) & "Your attempts were " & numTries & Chr(13) & questCount & " questions available."
           
           StatusBar1.SimpleText = "Wrong Answer!"
           
           Picture1.BackColor = &HFF&
           lblAnswerStat.BackColor = &HFF&


           
           lblAnswerStat.Caption = "WRONG ANSWER DUDE."
           Beep
           Beep
     
           ''MOVE TO NEXT QUESTION IF ANSWER IS WRONG
           
           If AdvanceWrong = "True" Then
               ''CALL PROCEDURE
               num = num + 1
               
               Call AdvanceifWrong(num)


               If num <= questCount Then
                   
                   ''ACTIVATE RANDOM QUESTION LOADING
                   If randomQuestValue = "True" Then
                       randomQuestion (totquest)
                   Else
                       Call display_question(num)
                   End If


               End If
               
               Call AdvanceifWrong(num)
               
           Else
               
               
           End If
           
           Picture1.BackColor = &HFF&
           lblAnswerStat.BackColor = &HFF&
               
    End If



    End Sub



    Private Sub cmdClear_Click()
    If clearStatus = False Then
       For i = 1 To 4
           cmdAns(i).Visible = False
           lblAns(i).Visible = False
       Next i
    lblQuestion.Visible = False
    End If
    clearStatus = False
    End Sub


    Private Sub cmdQuit_Click()
       Unload Me
    End Sub


    Private Sub cmdRandomQuestion_Click()
       randomQuestion (totquest)
    End Sub


    Public Sub cmdStart_Click()


       lblQuestion.Visible = True
       cmdAns(1).Visible = True
       lblAns(1).Visible = True
       
       For i = 2 To 4
           lblAns(i).Visible = True
           cmdAns(i).Visible = True
       Next i
    End Sub


    Private Sub Form_Unload(cancel As Integer)
       
       SaveSetting appname, "Data", "Form Font", frmMain.FontName
       SaveSetting appname, "Data", "Form Font", frmMain.FontName
       
       End


    End Sub



    Private Sub mnuDisableTransClick()
       Call Form
    TransControlsDisable
    End Sub


    Private Sub mnuTransparencyClick()
       Call FormTransControls
    End Sub


    Private Sub mnuAbout_Click()
       frmAboutInfo.Visible = True
    End Sub


    Private Sub mnuAnswersFont_Click()
    Dim fntAnsFontNme As String
    Dim fntAnsFontSze As String


    CommonDialog1.Flags = cdlCFScreenFonts
    CommonDialog1.ShowFont


    fntAnsFontNme = CommonDialog1.FontName
    fntAnsFontSze = CommonDialog1.FontSize


    For i = 1 To 4
    lblAns(i).FontName = fntAnsFontNme
    lblAns(i).FontSize = fntAnsFontSze
    Next i


    ''reg settibgs
    SaveSetting appname, "Data", "Answers Font", fntAnsFontNme
    SaveSetting appname, "Data", "Answers Font Size", fntAnsFontSze


    End Sub


    Private Sub mnuButtonsFont_Click()
    Dim fntButtonsFontNme As String
    Dim fntButtonsFontSze As String


    CommonDialog1.Flags = cdlCFScreenFonts
    CommonDialog1.ShowFont


    fntButtonsFontNme = CommonDialog1.FontName
    fntButtonsFontSze = CommonDialog1.FontSize


    For i = 1 To 4
    cmdAns(i).FontName = fntButtonsFontNme
    cmdAns(i).FontSize = fntButtonsFontSze
    Next i


    ''save reg button font name
    SaveSetting appname, "Data", "Buttons Font", fntButtonsFontNme
    SaveSetting appname, "Data", "Buttons Font Size", fntButtonsFontSze



    End Sub



    Private Sub mnuEnableTransClick()
       Call FormTransControls
    End Sub


    Private Sub mnuExit_Click()
       Unload Me
    End Sub


    Private Sub mnuFontBlackClick()
       Call FormFontBlack
    End Sub


    Private Sub mnuFontWhiteClick()
       Call FormFontWhite
    End Sub


    Private Sub mnuNewGameClick()
       
       Timer1.Enabled = False
       lblTimer.Caption = "READY"
       num = 1
       Call display
    question(num)
       
       cmdAns(1).Enabled = True
       cmdAns(2).Enabled = True
       cmdAns(3).Enabled = True
       cmdAns(4).Enabled = True


       
       numCorrect = 0
       numTries = 0
       numWrong = 0
         
       lblStatus.Caption = "You got " & numCorrect & " answers right." & Chr(13) & "You got " & numWrong & " answers wrong." & Chr(13) & "Your attempts were " & numTries & Chr(13) & questCount & " questions available."


       
    End Sub



    Private Sub mnuQuestionFont_Click()
    Dim fntQuestionFontNme As String
    Dim fntQuestionFontSze As String


    CommonDialog1.Flags = cdlCFScreenFonts
    CommonDialog1.ShowFont


    fntQuestionFontNme = CommonDialog1.FontName
    fntQuestionFontSze = CommonDialog1.FontSize


    lblQuestion.FontName = fntQuestionFontNme
    lblQuestion.FontSize = fntQuestionFontSze


    ''save reg questions font name
    SaveSetting appname, "Data", "Questions Font", fntQuestionFontNme
    SaveSetting appname, "Data", "Questions Font Size", fntQuestionFontSze


    End Sub


    Private Sub mnuSetDataFileLoc_Click()
       frmOptionsMultChoiceQ.Visible = True
    End Sub


    Private Sub mnuUseQeditor_Click()
       frmQuestionEditor.Visible = True
    End Sub


    Private Sub mnuVersionInfo_Click()
       frmAbout.Visible = True
    End Sub


    Private Sub mnuWebsite_click()


    response = MsgBox("Do you want to go to see gerrys Web site?", vbYesNo, "Gerrys Web Site")


    If response = vbYes Then
       Call CallWebSite
    End If


    End Sub


    Private Sub CallWebSite()


       Shell "start http://go.to/wdwtbam"
         
    End Sub


    Public Sub Form_Load()


    NL = Chr(13) & Chr(10)


    num = 1
    Dim clearStatus As Boolean


    ''''DISPLAT SPLASG SCREEN FRO 5 SECS
    Dim PauseTime, Start, Finish, TotalTime
    If vbYes = vbYes Then
       PauseTime = 1   ' Set duration.
       Start = Timer   ' Set start time.
       Do While Timer < Start + PauseTime
           frmSplash.Visible = True
           DoEvents    ' Yield to other processes.
           
           ''UPDATE THE PROGRESS BAR
           Call UpdateProgressBar
           ''GET APPNAME AND DATFILE LOCATION
           Call Get
    AppnameDatafile
           
           Call Update
    ProgressBar


           ''LOAD QUESTIONS
           Call LoadQuestion
           
           Call Update
    ProgressBar


           Call Count_Questions


           
       Loop
       Finish = Timer  ' Set end time.
       TotalTime = Finish - Start  ' Calculate total time.
    Else
       End
    End If





    If cmdClear.Value = True Then
       clearStatus = True
    End If



    lblAnswerStat.Caption = "ready"
    lblStatus.Caption = "PRESS Start to start Quiz."
    lblTimer.Caption = "ready"
    lblRandomQuests.Caption = "Ready"
    Timer1.Enabled = False



    cmdAns(1).Visible = False
    lblQuestion.Visible = False
    lblAns(1).Visible = False


    For i = 2 To 4
       Load cmdAns(i)
       Load lblAns(i)
       cmdAns(i).Top = cmdAns(i - 1).Top + cmdAns(1).Height + 300
       
       lblAns(i).Top = lblAns(i - 1).Top + cmdAns(1).Height + 300
       lblAns(i).Visible = False
       cmdAns(i).Visible = False
       
       cmdAns(i).Caption = i
       lblAns(i).Caption = ""


    Next i


    Call Update_ProgressBar


    Call LoadQuestion
    Call display
    question(num)




    frmMain.Caption = formname
    'Prog.Caption = GetSetting(AppName, "Data", "Program", "")


    ''LOAD REG SAVES SETTINGS FOR ANSWERS FONT SETTINGS
    fntAnsFontNme = GetSetting(appname, "Data", "Answers Font", "")
    fntAnsFontSze = GetSetting(appname, "Data", "Answers Font Size", "")


    ''LOAD FOR BUTTONS FONT AND SIZE
    fntButtonsFontNme = GetSetting(appname, "Data", "Buttons Font", "")
    fntButtonsFontSze = GetSetting(appname, "Data", "Buttons Font Size", "")


    ''LOAD SETTINGS FOR QUESTIONS FONT AND SIZE
    fntQuestionFontNme = GetSetting(appname, "Data", "Questions Font", "")
    fntQuestionFontSze = GetSetting(appname, "Data", "Questions Font Size", "")


    ''SEE IF RANDOM QUESTIONS ARE WANTED
    randomQuestValue = GetSetting(appname, "Data", "Random Quests", "")


    ''SEE IF ADVANCE TO NEXT QUESTION IS WANTED
    AdvanceWrong = GetSetting(appname, "Data", "Advance Wrong Ans", "")




    ''CORRECT ANS AND WRONG ANS PICTURE FILES
    WrongAnsPic = GetSetting(appname, "Data", "Wrong Ans Pic", "")
    CorrectAnsPic = GetSetting(appname, "Data", "Correct Ans Pic", "")


    frmOptionsMultChoiceQ.txtCorrectAnsPic.Text = CorrectAnsPic
    frmOptionsMultChoiceQ.txtWrongAnsPic.Text = WrongAnsPic




    ''CHECK TO SEE IF SETTING IS SAVED FOR PICTURE FILES
    If WrongAnsPic = "" Then
       Picture1.Picture = LoadPicture()
    'Else
    End If



    If CorrectAnsPic = "" Then
       Picture1.Picture = LoadPicture()
    End If


    Call Update_ProgressBar


    ''''''''''''''''''''''''''''''''''''''''''
    ''''LOAD FORM BACKGROUND
    QuizBackGround = GetSetting(appname, "Data", "Main Form Skin", "")
    QuizBackGroundEnable = GetSetting(appname, "Data", "Enable Main Skin", "")


    frmOptionsMultChoiceQ.txtMainPicture = QuizBackGround


    If QuizBackGroundEnable = "False" Then
       frmMain.Picture = LoadPicture()
       ''QuizBackGround = ""
       frmOptionsMultChoiceQ.chkQuizBackGround.Value = 0
       ''frmOptionsMultChoiceQ.txtMainPicture = QuizBackGround


    ElseIf QuizBackGroundEnable = "True" Then


       frmOptionsMultChoiceQ.chkQuizBackGround.Value = 1
       frmMain.Picture = LoadPicture(QuizBackGround)
       frmOptionsMultChoiceQ.txtMainPicture = QuizBackGround
       
    '''''SEE IF TRANSPARENCY IS WANTED


       TransState = GetSetting(appname, "Data", "TransState", "")


    '''ENABLE TRANSPARENT CONTROLS ON FORM
     If TransState = "True" Then
        Call FormTransControls
     Else
        Call FormTransControlsDisable
     End If
       
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''
    Call Update
    ProgressBar



    '''CHECK BUTTON TYPE IF TRUE THEN USE LETTERS, FALSE NUMBERS
    ButtonType = GetSetting(appname, "Data", "Button Type", "")


    If ButtonType = "True" Then
           
           cmdAns(1).Caption = "A"
           cmdAns(2).Caption = "B"
           cmdAns(3).Caption = "C"
           cmdAns(4).Caption = "D"
           frmOptionsMultChoiceQ.chkButtonType.Value = 1


    Else
       ''leave a alone
           cmdAns(1).Caption = "1"
           cmdAns(2).Caption = "2"
           cmdAns(3).Caption = "3"
           cmdAns(4).Caption = "4"
           frmOptionsMultChoiceQ.chkButtonType.Value = 0


    End If




    frmOptionsMultChoiceQ.txtDataFileLoc.Text = dataFileLoc



    ''IF THE SETTING ISNT SAVED
    If fntAnsFontNme = "" Then
       fntAnsFontNme = "Arial"
    End If
    If fntAnsFontSze = "" Then
       fntAnsFontSze = "12"
    End If



    ''IF THE SETTING ISNT SAVED
    If fntButtonsFontNme = "" Then
       fntButtonsFontNme = "Arial"
    End If
    If fntButtonsFontSze = "" Then
       fntButtonsFontSze = "12"
    End If


    ''IF NOT SAVED
    If fntQuestionFontNme = "" Then
       fntQuestionFontNme = "Arial"
    End If
    If fntQuestionFontSze = "" Then
       fntQuestionFontSze = "12"
    End If



    ''''''''ACTIVATE THE SETTINGS AS LOADED FROM THE REGISTRY



    ''SET FONT SETTINGS FROM REG FOR ANSWERS
    lblQuestion.FontName = fntQuestionFontNme
    lblQuestion.FontSize = fntQuestionFontSze


    For i = 1 To 4
       lblAns(i).FontName = fntAnsFontNme
       lblAns(i).FontSize = Val(fntAnsFontSze)
       
       cmdAns(i).FontName = fntButtonsFontNme
       cmdAns(i).FontSize = Val(fntButtonsFontSze)
       
    Next i


    ''ACTIVATE RANDOM QUESTION LOADING
    If randomQuestValue = "True" Then
       randomQuestion (totquest)
       frmOptionsMultChoiceQ.chkRandomQuestions.Value = 1
    End If


    ''PUT THE CHECK MARK IF ADVANCE TO NEXT QUESTION IS PICKED
    If AdvanceWrong = "True" Then
       ''CALL PROCEDURE
       AdvanceifWrong (num)
       frmOptionsMultChoiceQ.chkWrongAdv.Value = 1
    End If


    ''SET THE DATA FILE T O APPEAR IN TXT BOC CAPTION


    frmOptionsMultChoiceQ.txtDataFileLoc = dataFileLoc



    ''STATUS BAR DISPLAYS
    StatusBar1.SimpleText = "Click start to play."


    ''''''ENABLE DISABLE TRANSPARENY




    End Sub


    Public Sub Load_Question()
    questCount = 0


    Open dataFileLoc For Input As #1




       Do While Not EOF(1)
           questCount = questCount + 1
           ReDim Preserve question(1 To questCount)
           ReDim Preserve ans1(1 To questCount)
           ReDim Preserve ans2(1 To questCount)
           ReDim Preserve ans3(1 To questCount)
           ReDim Preserve ans4(1 To questCount)
           ReDim Preserve correctAns(1 To questCount)
           
           Input #1, question(questCount), ans1(questCount), ans2(questCount), ans3(questCount), ans4(questCount)
           Input #1, correctAns(questCount)
           
       Loop


    Close #1


    End Sub




    Public Sub display_question(ByRef num As Integer)


    If num = (questCount + 1) Then


       MsgBox "You Have Reached the End the Quiz." & Chr(13) & "You got " & numCorrect & " answers right." & Chr(13) & "You got " & numWrong & " answers wrong." & Chr(13) & "Your attempts were " & numTries, vbInformation
       ''code to clear form
       cmdAns(1).Enabled = False
       cmdAns(2).Enabled = False
       cmdAns(3).Enabled = False
       cmdAns(4).Enabled = False


    Else
       lblAns(1).Caption = ans1(num)
       lblAns(2).Caption = ans2(num)
       lblAns(3).Caption = ans3(num)
       lblAns(4).Caption = ans4(num)
       lblQuestion.Caption = question(num)
       lblQuestNum.Caption = "Quest No." & num
       
       Picture1.BackColor = &H80000005
       lblAnswerStat.BackColor = &H80000005
    End If


    End Sub


    Private Sub pp_Click()


    End Sub


    Private Sub Timer1_Timer()
       
       Dim elapsedtime As Single
       Dim temp As Single
       temp = Timer
       elapsedtime = temp - starttime
       lblTimer.Caption = "Elapsed Time : " & Format(elapsedtime, "#####")


    End Sub


    Public Function randomQuestion(ByVal totquest As Integer) As Integer


    Dim MyValue
    Randomize Timer  ' Initialize random-number generator.


    MyValue = Int((totquest * Rnd) + 1)    ' Generate random value between 1 and 6.
    'MsgBox MyValue
    num = MyValue
    display_question (MyValue)
    End Function


    Public Sub Get_DataFile()


       On Error GoTo cancel
       'frmOptionsMultChoiceQ.Visible = True
       CommonDialog1.Filter = "Data File (.TXT)|.TXT|All|."
       
       CommonDialog1.CancelError = True
       CommonDialog1.DialogTitle = "Select the Data File to Use:"
       CommonDialog1.Flags = &H4
       CommonDialog1.ShowOpen
       
       If Dir(CommonDialog1.FileName) <> "" Then
       
       dataFileLoc = CommonDialog1.FileName
       SaveSetting appname, "Data", "Data File Loc", dataFileLoc


       MsgBox dataFileLoc
       Else
       MsgBox "No such program dude", vbCritical
       End If


    cancel:


    End Sub


    Public Sub GetAppnameDatafile()
    ''CALL PROCDURE TO GET APP NAME AND DATAFILE LOCATION


    ''REG SETTINGS FOR PROGRAM NAME
    appname = App.ProductName
    formname = App.ProductName & " BETA V " & Str(App.Major) & "." & Str(App.Minor) & "." & (App.Revision)



    ''GET DATA FILE LOCATION FROM REG
    dataFileLoc = GetSetting(appname, "Data", "Data File Loc", "")


    If dataFileLoc = "" Then
       ''MsgBox "You will now be asked to set the datafile location for this program.  The datafiel contains the questions which are being used in this quiz.", vbInformation, "Set Data File Location"
       ''MsgBox "ERROR:  Data File Path not specified, you must set the data file to use.  The data file should be in the directory as this program e.g; c:\program files\gerrys muliple choice quests.  YOu only have to do this once i.e when you start the program for the first time." & Chr(13) & Chr(13) & "NOTE: You MUST set data file location.", vbExclamation, "ERROR: Datafile not Specified"
       ''Call Get_DataFile
       '' SET DATA FILE TO DEFAULT LOCATION
       
       MsgBox "Thanks for using this great product, since its your first use im gonna set up the questions and answers data file for you.  Setting up data file for first use", vbInformation, "First use: Loading Datafile"
       dataFileLoc = App.Path & "\questionsandanswers.txt"
       
       SaveSetting appname, "Data", "Data File Loc", dataFileLoc
       
       frmOptionsMultChoiceQ.txtDataFileLoc.Text = dataFileLoc
    End If


    frmOptionsMultChoiceQ.txtDataFileLoc.Text = dataFileLoc


    End Sub



    Public Sub Count_Questions()
    ''COUNT NUMBER OF QUESTIONS


    Open dataFileLoc For Input As #2


    totquest = 0


       Do While Not EOF(2)
           totquest = totquest + 1
           Input #2, temp1, temp2, temp3, temp4, temp5, ans
       Loop
       
    Close #2


    End Sub



    Public Sub AdvanceifWrong(ByVal num As Integer)
       
       Call display_question(num)


    End Sub



    so , help me if you can !

  • 19 years ago

    Although we often ask for code to be posted, it might help if you narrow down the code to the area that is causing the problem... ;-)

Post a reply

Enter your message below

Sign in or Join us (it's free).

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“We should forget about small efficiencies, say about 97% of the time: premature optimization is the root of all evil.” - Donald Knuth