I have created a Quiz application in Visual Basic.I have stored the questions in a text file and I'm using streamreader to read the lines.The text file looks like this
If x is the first of five consecutive odd numbers then what is their average ?
x
x+1
x+4
x+3
3
Which of the following number is divisible by 24 ?
76300
78132
80424
81234
3
The first line is the question,the lines 2 to 5 is the options and the 6th line is the answer key and there are more than 100 questions and I should print random questions and its corresponding choices each time I open the application and it should not repeat the same question.Can any one give me a code snippet for this?
Imports System.IO
Imports System.Runtime.InteropServices
Public Class Quiz
Public ques As Integer = 1
Dim Shuffle As Integer = 0
Dim SCORE As Integer = 0
Dim val As Integer = 30
Public anskey As String
Private currentQuestion As Integer
Private listOfQuestions As List(Of Question) = New List(Of Question)
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Public Sub Reset_all()
val = 30
SCORE = 0
ProgressBar1.Value = 0
Button3.Hide()
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = 30
Timer1.Enabled = True
Using reader = New System.IO.StreamReader("Quiz.txt")
Dim line = reader.ReadLine()
While (Not String.IsNullOrWhiteSpace(line))
Dim question = New Question
question.Question = line
question.Choice1 = reader.ReadLine()
question.Choice2 = reader.ReadLine()
question.Choice3 = reader.ReadLine()
question.Choice4 = reader.ReadLine()
question.Answer = reader.ReadLine()
listOfQuestions.Add(question)
line = reader.ReadLine()
End While
End Using
If listOfQuestions.Count > 0 Then
LoadQuestion(0)
End If
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Reset_all()
End Sub
Sub LoadQuestion(questionIndex As Integer)
Dim question = listOfQuestions(questionIndex)
currentQuestion = questionIndex
If listOfQuestions.Count - 1 = currentQuestion Then
End If
With question
Label3.Text = ques
Label1.Text = .Question
RadioButton1.Text = .Choice1
RadioButton2.Text = .Choice2
RadioButton3.Text = .Choice3
RadioButton4.Text = .Choice4
anskey = .Answer
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If (SCORE > 0) Then
SCORE -= 1
End If
If (currentQuestion > 0) Then
If (ques > 0) Then
ques -= 1
LoadQuestion(currentQuestion - 1)
End If
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If (anskey = "a" And RadioButton1.Checked = True Or anskey = "b" And RadioButton2.Checked = True Or anskey = "c" And RadioButton3.Checked = True Or anskey = "d" And RadioButton4.Checked = True) Then
SCORE += 1
End If
If (currentQuestion < listOfQuestions.Count - 1) Then
If (ques <= 99) Then
ques += 1
LoadQuestion(currentQuestion + 1)
End If
End If
End Sub
Private Sub Quiz_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
Dashboard.Show()
Me.Hide()
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ProgressBar1.Value += 1
val -= 1
Label2.Text = val & " Sec"
If ProgressBar1.Value = ProgressBar1.Maximum Then
Timer1.Enabled = False
End If
If ProgressBar1.Value > 23 Then
SendMessage(ProgressBar1.Handle, 1040, 2, 0)
Button3.Show()
End If
If ProgressBar1.Value = 30 Then
End If
End Sub
Private Sub SubmitResult()
MsgBox("You have Scored " + SCORE.ToString + " Out of 100")
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim Re As Integer = MsgBox("Are you sure you want to submit?",
vbYesNo, "Submit")
If (Re = 6) Then
SubmitResult()
Try
Me.Close()
Dashboard.Show()
Catch ex As Exception
End Try
End If
End Sub
Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
End Sub
End Class
Public Class Question
Public Property Question As String
Public Property Choice1 As String
Public Property Choice2 As String
Public Property Choice3 As String
Public Property Choice4 As String
Public Property Answer As String
End Class
I would make a class "question" like this:
public Class Question
public questionas String
public answer1 as String
public answer2 as String
public answer3 as String
public answer4 as String
public correctAnswer as integer
public sub new(que as string, a1 as string, a2 as string, a3 as string, a4 as string, answer as integer)
question= que
answer1=a1
answer2=a2
answer3=a3
answer4=a4
correctAnswer=answer
end sub
end Class
Now load all your questions in the programm like this:
Imports System
Imports System.IO
Class MainWindow
private listQuestions as List(Of Question)
Public Sub window_loaded() handles MainWindow.loaded
listQuestions = loadAllQuestions()
End Sub
private function loadAllQuestions() as List(Of Question)
Dim str() As String
Try
' Open the file using a stream reader.
Using sr As New StreamReader("example.txt")
Dim line As String
' Read the stream to a string and write the string to the console.
line = sr.ReadToEnd()
Str = line.Split(vbNewLine)
End Using
Catch e As Exception
Console.WriteLine("The file could not be read:")
Console.WriteLine(e.Message)
End Try
'So now put the questions in your list:
dim list as new List(Of Question)
For i = 0 to str.count - 1
if (i+1) mod 5 = 0 then 'is divible without rest by 6
list.add(new Question(str(i-5), str(i-4), str(i-3), str(i-2), str(i-1), str(i))
end if
next
return list
end sub
'Load a random question:
private sub btNext_click() handles btNext.click()
dim ranQuestion as Question
dim r as new random
ranQuestion = listFragen.item(r.next(0,listQuestions.count))
End Class
Hope i could help you. To prevent that the programm can show the same question again its your job :)
First, I would recommend using the File.ReadAllLines() function to get an array of lines in the text file with questions. Then you can access them easily.
If you observe, the index of the line of the question will be (n - 1) * 6, where n is the question number. Once you get that, the indices of the options are given by:
i + 1
i + 2
i + 3
i + 4
where i = (n - 1) * 6. The answer key is given by:
i + 5
That should get you started. If you get stuck, leave a comment :)
So you would do the first part by:
Dim lines() As String = File.ReadAllLines("<yourQuestions.txt")
Then, you can generate a random number within the required range using:
Dim questionNumber As Integer = Random.Next(1, (lines.Length / 6) + 1)
After that, you can retrieve the question, options and answer key by:
Dim i As Integer = (questionNumber - 1) * 6
Dim question As String = lines(i)
Dim options() As String = {lines(i + 1), lines(i + 2), lines(i + 3), lines(i + 4)}
Dim answerKey As String = lines(Integer.Parse(lines(i + 5)))
You can also consider creating a class Question:
Public Class Question
Public Property Question As String
Public Property Choice1 As String
Public Property Choice2 As String
Public Property Choice3 As String
Public Property Choice4 As String
Public Property Answer As String
Public Sub New(q As String, c1 As String, c2 As String, c3 As String, c4 As String, ans As String)
Question = q
Choice1 = c1
Choice2 = c2
Choice3 = c3
Choice4 = c4
Answer = ans
End Sub
End Class
Then you can assign the properties.
Another alternative (might be better in performance, in fact, I think it should be) would be to use the File.ReadLines() function and use the Take() and Skip() extension methods of IEnumerable<T> (LINQ):
Dim questionNumber As Integer = Random.Next(1, (File.ReadLines("<yourQuestions.txt").Count() / 6) + 1)
Dim blockLines = File.ReadLines("<yourQuestions.txt").Skip((questionNumber - 1) * 6).Take(6)
Dim currentQuestion As New Question(blockLines(0), blockLines(1), blockLines(2), blockLines(3), blockLines(4), blockLines(blockLines(5)))
To start with, load your questions this way:
Dim questions = _
File _
.ReadLines("questions.txt") _
.Select(Function (x, n) New With { .Line = X, .Index = n }) _
.GroupBy(Function (xn) xn.Index \ 6, Function (xn) xn.Line) _
.Select(Function (xs) New Question() With _
{ _
.Question = xs(0), _
.Choice1 = xs(1), _
.Choice2 = xs(2), _
.Choice3 = xs(3), _
.Choice4 = xs(4), _
.Answer = xs(5) _
}) _
.ToArray()
That'll give you an array for your questions:
Next, you need to create a "queue.txt" file that contains the indices of your questions in a random order that you wish to display them in. Here's how to create your queue:
Dim rnd = New Random()
Dim queue = _
Enumerable _
.Range(0, questions.Length) _
.OrderBy(Function (n) rnd.Next()) _
.Select(Function (n) n.ToString()) _
.ToArray()
File.WriteAllLines("queue.txt", queue)
Then when you load your program, you can read this file and choose the next question to ask, and save the file, skipping the first question for next time, like this:
Dim queue = File.ReadAllLines("queue.txt")
Dim questionToAsk As Question = questions(Integer.Parse(queue.First()))
File.WriteAllLines("queue.txt", queue.Skip(1))
It would be up to you to make sure that the file is created when it doesn't exist and to write the code that checks if you've asked all the questions and need to re-create the queue.
Here are the basics of a class that uses XML.
Public Class QuestionAndAnswer
'the container for all questions/answers
Private ReadOnly qa As XElement = <QandA></QandA>
'the container for a question and some number of possible answers
Private ReadOnly ent As XElement = <entry></entry>
'the question
Private ReadOnly aquestion As XElement = <question></question>
'an answer - the c attribute will be "y" for the correct answer
Private ReadOnly ananswer As XElement = <answer c=""></answer>
Private theQA As XElement
Public Sub New()
Me.theQA = New XElement(qa) 'set up
End Sub
Public Sub New(path As String)
Me.theQA = XElement.Load(path)
End Sub
Public Sub Save(path As String)
Me.theQA.Save(path)
End Sub
Private Function AddQuestion(theQuestion As String, correctAnsw As String) As XElement
Dim e As New XElement(ent)
Dim q As New XElement(aquestion)
Dim a As New XElement(ananswer)
q.Value = theQuestion
a.Value = correctAnsw
a.#c = "y"
e.Add(q)
e.Add(a)
Me.theQA.Add(e)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw)
Dim a As New XElement(ananswer)
a.Value = ans1
e.Add(a)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String, ans2 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw, ans1)
Dim a As New XElement(ananswer)
a.Value = ans2
e.Add(a)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String, ans2 As String, ans3 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw, ans1, ans2)
Dim a As New XElement(ananswer)
a.Value = ans3
e.Add(a)
Return e
End Function
Public Function AddQuestion(theQuestion As String, correctAnsw As String,
ans1 As String, ans2 As String, ans3 As String, ans4 As String) As XElement
Dim e As XElement = Me.AddQuestion(theQuestion, correctAnsw, ans1, ans2, ans3)
Dim a As New XElement(ananswer)
a.Value = ans4
e.Add(a)
Return e
End Function
Private Shared prng As New Random
Public LastQuestionAnswer As String
Public Function RandomQuestion() As String
Dim q As XElement = Me.SelectRandomQ
If q IsNot Nothing Then
Dim rv As New System.Text.StringBuilder
rv.AppendLine(q.<question>.Value)
rv.AppendLine()
Dim ie As IEnumerable(Of XElement)
ie = From qa In q.<answer>
Select qa
ie = ie.OrderBy(Function() prng.Next(q.<answer>.Count))
Dim x As Integer = 1
For Each a As XElement In ie
If a.#c = "y" Then
Me.LastQuestionAnswer = x.ToString
End If
rv.AppendFormat("{0}. {1}", x, a.Value)
rv.AppendLine()
x += 1
Next
rv.AppendLine()
Me.LastQuestionAnswer = Me.LastQuestionAnswer.Insert(0, rv.ToString)
Debug.WriteLine(Me.LastQuestionAnswer)
Return rv.ToString
End If
Return ""
End Function
Private Function SelectRandomQ() As XElement
If Me.theQA IsNot Nothing AndAlso Me.theQA.<entry>.Count > 0 Then
Dim ie As IEnumerable(Of XElement)
ie = From ent In Me.theQA.Elements
Where ent.#used <> "y"
Select ent
Dim rv As XElement = ie(prng.Next(ie.Count))
rv.#used = "y"
Return rv
End If
Return Nothing
End Function
End Class
A form with a richtextbox and a button shows it
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim foo As New QuestionAndAnswer
foo.RandomQuestion()
foo.AddQuestion("Which Vietnam War film directed by Francis Ford Coppola followed a screenplay based on famous adventure story Heart of Darkness?",
"Apocalypse Now",
"Good Morning Vietnam",
"Born on the Fourth of July",
"Band of Brothers")
foo.AddQuestion("What was the name of the baseball pitcher that hit a bird with a pitch during a 2001 Spring Training game?",
"Randy Johnson",
"Mike Mussina",
"Roger Clemens",
"Greg Maddux",
"Johan Santana")
foo.AddQuestion("The third largest desert in the world is the Sahara, what is the first?",
"Antarctic",
"Gobi",
"Sonoran")
foo.AddQuestion("How many US presidents have died while in office?",
"8",
"6",
"7")
foo.AddQuestion("If x is the first of five consecutive odd numbers > 0, then what is their average?",
"x + 4",
"x",
"x + 1",
"x + 3")
Dim qa As New System.Text.StringBuilder
foo.RandomQuestion()
qa.AppendLine(foo.LastQuestionAnswer)
qa.AppendLine()
foo.RandomQuestion()
qa.AppendLine(foo.LastQuestionAnswer)
qa.AppendLine()
foo.RandomQuestion()
qa.AppendLine(foo.LastQuestionAnswer)
RichTextBox1.Text = qa.ToString
End Sub
Related
I'm new at visual basic programming and everything was fine until our topic shifted to arrays. I tried to understand it's code using Java. (Example: method are called functions.. .)
My prof has given us an exercise to create a Quiz program that asks the user more than 5 questions (in textbox) with choices (in buttons) and computes the score at the end (All just in one form). If the user click an a button it will tell if it's right or wrong and then proceed to change the question along with the choices.
*Required: - After the user finish the quiz the score will be displayed and there should be a restart button and all the question will be asked again randomly no pattern. - Try to make functions.
I tried searching the web since yesterday and I still have made no progress at my code.
Public Class Form1
Dim questions(5) As String
Dim answers(5) As String
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Method/Function for loading the Q&A
loadQsAndAs()
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
Me.Close()
End Sub
Private Sub loadQsAndAs()
'Questions
questions(0) = "What is 1 + 1?"
questions(1) = "Who is the first man to walk on the Moon?"
questions(2) = "What is the name of the main character in the movie: Yes Man! (2007)"
questions(3) = "If I gave you three apples and you ate two, how many is left?"
questions(4) = "What do you want in your final grade?"
questions(5) = "What is the name of the thing(s) that you use whenever you eat?"
'Answers
answers(0) = "2"
answers(1) = "Neil Armstrong"
answers(2) = "Jim Carrey"
answers(3) = "1"
answers(4) = "A 4.0"
answers(5) = "A Spoon and Fork"
TextBox1.Text = setTheQuestion()
Button1.Text = setTheAnswer1()
Button2.Text = setTheAnswer2()
Button3.Text = setTheAnswer3()
Button4.Text = setTheAnswer4()
End Sub
Private Function setTheQuestion() As String
Dim randomValue As New Random
Dim randomQ As String = ""
Dim i As Integer
Dim index As Integer
For i = 0 To 0
index = randomValue.Next(0, questions.Length)
randomQ &= questions(index)
Next
Return randomQ
End Function
Private Function setTheAnswer1() As String
Dim randomValue As New Random
Dim randomAns As String = ""
Dim i As Integer
Dim index As Integer
For i = 0 To 0
index = randomValue.Next(0, answers.Length)
randomAns &= answers(index)
Next
Return randomAns
End Function
Private Function setTheAnswer2() As String
Dim randomValue As New Random
Dim randomAns As String = ""
Dim i As Integer
Dim index As Integer
For i = 0 To 0
index = randomValue.Next(1, answers.Length)
randomAns &= answers(index)
Next
Return randomAns
End Function
Private Function setTheAnswer3() As String
Dim randomValue As New Random
Dim randomAns As String = ""
Dim i As Integer
Dim index As Integer
For i = 0 To 0
index = randomValue.Next(2, answers.Length)
randomAns &= answers(index)
Next
Return randomAns
End Function
Private Function setTheAnswer4() As String
Dim randomValue As New Random
Dim randomAns As String = ""
Dim i As Integer
Dim index As Integer
For i = 0 To 0
index = randomValue.Next(3, answers.Length)
randomAns &= answers(index)
Next
Return randomAns
End Function
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
loadQsAndAs()
End Sub
End Class
Public Class Form1
Dim questions As New ArrayList
Dim answers As New ArrayList
Dim dtQAMain As New DataTable
Dim questionsCopy As New ArrayList
Dim alAnsButton As New ArrayList 'arraylist to store all answer button.
Dim totalScore As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles MyBase.Load
'Method/Function for loading the Q&A
alAnsButton.Add(Button1)
alAnsButton.Add(Button2)
alAnsButton.Add(Button3)
alAnsButton.Add(Button4)
loaddtQA()
loadQsAndAs()
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles Button5.Click
Me.Close()
End Sub
Private Sub loaddtQA()
dtQAMain = New DataTable
dtQAMain.Columns.Add("Q")
dtQAMain.Columns.Add("A")
For i = 0 To 5
questions.Add("")
answers.Add("")
Next
'Questions
questions(0) = "What is 1 + 1?"
questions(1) = "Who is the first man to walk on the Moon?"
questions(2) = "What is the name of the main character in the movie: Yes Man!(2007)"
questions(3) = "If I gave you three apples and you ate two, how many is left?"
questions(4) = "What do you want in your final grade?"
questions(5) = "What is the name of the thing(s) that you use whenever you eat?"
'Answers
answers(0) = "2"
answers(1) = "Neil Armstrong"
answers(2) = "Jim Carrey"
answers(3) = "1"
answers(4) = "A 4.0"
answers(5) = "A Spoon and Fork"
For i = 0 To questions.Count - 1
dtQAMain.Rows.Add(questions(i), answers(i)) 'assign QA in table for scoring purpose later
Next
End Sub
Private Sub loadQsAndAs()
Label1.Visible = False
For i = 0 To alAnsButton.Count - 1
alAnsButton(i).visible = True
Next
questionsCopy = New ArrayList
questionsCopy = questions.Clone 'close a copy so we dont effect the actual question copy when randomize and eliminate asked question from arraylist
TextBox1.Text = setTheQuestion()
setTheAnswer()
End Sub
Private Function setTheQuestion() As String
Dim randomValue As New Random
Dim randomQ As String = ""
Dim index As Integer
If questionsCopy.Count <> 0 Then
index = randomValue.Next(0, questionsCopy.Count - 1)
randomQ = questionsCopy(index)
questionsCopy.RemoveAt(index) 'asked question will be remove.
Else ' questions are finished, show the mark
ShowMark()
End If
Return randomQ
End Function
Private Sub setTheAnswer() 'randonmize the answer and assign to button
If TextBox1.Text = "" Then Exit Sub ' if question finish exit sub
Dim randomValue As New Random
Dim NewIndex As Integer
Dim temp As String
Dim answersCopy As ArrayList = answers.Clone
For n = answersCopy.Count - 1 To 0 Step -1
NewIndex = randomValue.Next(0, n + 1)
' Swap them.
temp = answersCopy(n)
answersCopy(n) = answersCopy(NewIndex)
answersCopy(NewIndex) = temp
Next
Dim AnswerRowCheck As Integer = questions.IndexOf(TextBox1.Text)
Dim ActualAnswer As String = dtQAMain.Rows(AnswerRowCheck).Item("A") 'check actual answer
Dim totalRemove As Integer = 0
For i = answersCopy.Count - 1 To 0 Step -1
If totalRemove = 2 Then Exit For
If answersCopy(i) <> dtQAMain.Rows(AnswerRowCheck).Item("A") Then
answersCopy.RemoveAt(i)
totalRemove += 1
End If
Next 'remove 2 of the selection,since only 4 button for answer selection and should not take out the actual answer
For i = 0 To alAnsButton.Count - 1
alAnsButton(i).text = answersCopy(i)
Next
End Sub
Private Sub ShowMark()
For i = 0 To alAnsButton.Count - 1
alAnsButton(i).text = "" 'clear the text, no more input receive from user.
Next
Label1.Visible = True
Label1.Text = totalScore & " out of 6 are correct."
End Sub
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
totalScore = 0
loadQsAndAs() 'refresh question
End Sub
Private Sub Button4_MouseClick(sender As Object, e As MouseEventArgs) Handles Button4.MouseClick, Button3.MouseClick, Button2.MouseClick, Button1.MouseClick
If sender.text = "" Then Exit Sub
Dim AnswerRowCheck As Integer = questions.IndexOf(TextBox1.Text) 'search question number
If dtQAMain.Rows(AnswerRowCheck).Item("A") = sender.text Then 'checking answer
totalScore += 1
End If
TextBox1.Text = setTheQuestion() 'next question
setTheAnswer()
End Sub
End Class
The code had cover most of the necessary comment which include the idea and how it work. Random() and arraylist are the key for this program to function, just pay more attention on it. Good luck.
How about trying this?
Public Class Form1
Dim questions(5) As String
Dim answers(5) As String
Private Sub loadQsAndAs()
'Questions
questions(0) = "What is 1 + 1?"
questions(1) = "Who is the first man to walk on the Moon?"
questions(2) = "What is the name of the main character in the movie: Yes Man! (2007)"
questions(3) = "If I gave you three apples and you ate two, how many is left?"
questions(4) = "What do you want in your final grade?"
questions(5) = "What is the name of the thing(s) that you use whenever you eat?"
'Answers
answers(0) = "2"
answers(1) = "Neil Armstrong"
answers(2) = "Jim Carrey"
answers(3) = "1"
answers(4) = "A 4.0"
answers(5) = "A Spoon and Fork"
Dim random As New Random
Dim indices = { 0, 1, 2, 3, 4, 5 }.OrderBy(Function (n) random.Next()).ToArray()
Dim question = random.Next(questions.Length - 1)
TextBox1.Text = questions(indices(question))
Button1.Text = answers(indices(0))
Button2.Text = answers(indices(1))
Button3.Text = answers(indices(2))
Button4.Text = answers(indices(3))
End Sub
End Class
That's it. Nice and simple. The key trick is creating a randomize indices array to do the lookups into the questions and answers arrays.
Private Dim rnd As Integer
Private Function setTheQuestion() As String
rnd = (CInt(Math.Ceiling(Rnd() * questions.Length)) + 1)
Return questions(rnd)
End Function
Private Function setTheAnswer1() As String
Return answers(rnd)
End Function
i'm having an issue with setting a variable to the return value of a function i made i can't seem to be able to get it to work and i get no errors or feedback from visual studios even in strict mode
Imports System.Net
Imports System.IO
Imports System.ComponentModel
Public Class Form2
Dim i As Integer
Public CleanSearchTexts As String()
Dim count As Integer = 0
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If BackgroundWorker1.IsBusy = False Then
i = RichTextBox1.Lines.Count
i = i - 1
BackgroundWorker1.RunWorkerAsync()
Else
MsgBox("Threads are busy")
End If
End Sub
Private Sub StartThreads()
Dim SearchText As String
For count = count To i
SearchText = LineFunc(count)
count += 1
SearchText = CType(Ask_Query(SearchText), String)
SearchText = CType(Bing_Query(SearchText), String)
SearchText = CType(Yahoo_Query(SearchText), String)
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
If SearchText.Contains("All_Query:Yes") Then
SearchText = SearchText.Replace("All_Query:Yes", "")
RTB(SearchText)
End If
Next
End Sub
Private Delegate Sub UpdateStatus(ByVal s As String)
Private Delegate Sub UpdateLabel(ByVal thread_count As String)
Public Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If InvokeRequired Then
Invoke(New GetTextBox(AddressOf LineFunc), index)
Else
Dim indexSearchText As String
indexSearchText = RichTextBox1.Lines(index)
Return indexSearchText
End If
End Function
Public Sub RTB(ByVal s As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateStatus(AddressOf RTB), New Object() {s})
Else
RichTextBox2.AppendText(Environment.NewLine & s)
End If
End Sub
Public Sub Label_T(ByVal thread_count As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateLabel(AddressOf Label_T), New Object() {thread_count})
Else
Label3.Text = "Threads Running: " + thread_count
End If
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim count As Integer
Dim num As Integer = CInt(TextBox1.Text) - 1
For count = 0 To num
Dim thread = New Threading.Thread(AddressOf StartThreads)
thread.IsBackground = True
thread.Name = "Web Thread #" + CType(count, String)
thread.Start()
Threading.Thread.Sleep(500)
Next
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
MsgBox("Work is done")
End Sub
End Class
the issue is clearly with either the line getting function or the for count
i have tested the function by adding a button and doing the process of setting a variable to the return and msgboxing it and it works perfectly not only that when i breakpoint it it shows it's returning the right output but its just not setting it for whatever reason in this sub
Public Sub StartThreads(ByVal List As Object)
Dim List2 As String() = CType(List, String())
For Each dork As String In List2
dork = CType(Ask_Query(dork), String)
dork = CType(Bing_Query(dork), String)
dork = CType(Yahoo_Query(dork), String)
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
If dork.Contains("All_Query:Yes") Then
dork = dork.Replace("All_Query:Yes", "")
RTB(dork)
End If
Next
End Sub
and here is the function
Public Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If InvokeRequired Then
Invoke(New GetTextBox(AddressOf LineFunc), index)
Else
Dim indexSearchText As String
indexSearchText = RichTextBox1.Lines(index)
Return indexSearchText
End If
End Function
Update: List Split Func
Public Function splitData(ByVal width As Integer, ByVal dd As List(Of String)) As List(Of List(Of String))
Dim dds As New List(Of List(Of String))
Dim numberOfLists As Integer = (dd.Count \ width)
For i As Integer = 0 To numberOfLists
Dim newdd As List(Of String)
newdd = dd.Skip(i * width).Take(width).ToList()
dds.Add(newdd)
Next i
Return dds
End Function
Updated Background Worker
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim dds As New List(Of String)
GetList(dds)
Dim num As Integer = CInt(TextBox1.Text)
Dim ThreadCount As Integer = CInt(TextBox1.Text)
If ThreadCount > 1 Then
ThreadCount -= 1
End If
Dim RTBLines As Integer = RTB_Lines()
num = CInt(RTBLines / num)
num = CInt(Math.Ceiling(num))
Dim splitdd As List(Of List(Of String)) = CType(splitData(num, dds), List(Of List(Of String)))
For count = 0 To ThreadCount
Dim ListArray As String() = splitdd(count).ToArray
Dim newthread As New Thread(AddressOf StartThreads)
newthread.Name = "Web Thread #" + CType(count, String)
newthread.Start(ListArray)
Threading.Thread.Sleep(500)
Next
End Sub
I'm creating a Quiz Application in VB and the quiz app reads the questions from a text file which is already created and it has got some questions in it.
1
Q.Who won the WorldCup last time?
I Don't know
May be he knows
Who knows
Who cares?
2
Question 2
Answer A
Answer B
Answer C
Answer D
3
Question 3
Ans 1
Ans 2
Ans 3
Ans 4
The first line is the question number,the second line is the question,lines 3 - 6 represents the answer choices.Now I have created a Form for quiz and when the next button is pressed it should display the next question i.e,After the first question it should go to Question 2 and print accordingly.But unfortunately i'm unable to calculate the logic to go to next question.
Public Class Quiz
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Dim SCORE As Integer = 0
Dim val As Integer = 30
Dim QUES As Integer = 0
Dim Line As Integer = 1
Dim allLines As List(Of String) = New List(Of String)
Dim TextFilePath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "Quiz.txt")
Private Sub Quiz_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = 30
Timer1.Enabled = True
Next_Prev_Ques(Line + QUES)
End Sub
Public Function Next_Prev_Ques(quesno As Integer) As Integer
Line = quesno
Using file As New System.IO.StreamReader(TextFilePath)
Do While Not file.EndOfStream
allLines.Add(file.ReadLine())
Loop
End Using
QUES = ReadLine(Line, allLines)
Label1.Text = ReadLine(Line + 1, allLines)
RadioButton1.Text = ReadLine(Line + 2, allLines)
RadioButton2.Text = ReadLine(Line + 3, allLines)
RadioButton3.Text = ReadLine(Line + 4, allLines)
RadioButton4.Text = ReadLine(Line + 5, allLines)
Return Line
End Function
Public Function ReadLine(lineNumber As Integer, lines As List(Of String)) As String
Return lines(lineNumber - 1)
End Function
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ProgressBar1.Value += 1
val -= 1
Label2.Text = val & " Sec"
If ProgressBar1.Value = ProgressBar1.Maximum Then
Timer1.Enabled = False
End If
If ProgressBar1.Value > 25 Then
SendMessage(ProgressBar1.Handle, 1040, 2, 0)
End If
End Sub
Private Sub Quiz_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
Form1.Close()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
MsgBox(Line + QUES + 5)
Next_Prev_Ques(Line + QUES + 4)
Me.Refresh()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Next_Prev_Ques(Line + QUES + 5)
End Sub
The function Next_Prev_Ques Should run accordingly but its not.Can anyone post the correct code?
Below is some code that uses serialization to get the same results. You can create a class called Questions and properties on it like questionnumber, question and answer, store the data into a xml file and retrieve them with string methods. Check the code below:
The code for the class
Public Class clsQuestions
Private _Number As String
Private _Question As String
Private _Answer As String
Public Property Number() As String
Get
Number = _Number
End Get
Set(ByVal Value As String)
_Number = Value
End Set
End Property
Public Property Question() As String
Get
Question = _Question
End Get
Set(ByVal Value As String)
_Question = Value
End Set
End Property
Public Property Answer() As String
Get
Answer = _Answer
End Get
Set(ByVal Value As String)
_Answer = Value
End Set
End Property
End Class
The code for the form
Imports System.IO
Imports System.Xml.Serialization
Public Class Form1
Dim numQuestions() As String
Dim questions() As String
Dim answersGroup() As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Label1.Text = ""
Label2.Text = ""
Label3.Text = ""
Main()
End Sub
Private Sub Main()
Dim p As New clsQuestions
p.Number = "1,2,3,4,5,6,7,8,9,10"
p.Question = "Question 1,Question 2,Question 3," &
"Question 4,Question 5,Question 6,Question 7," &
"Question 8,Question 9,Question 10"
p.Answer = "Answer 1.1,Answer 1.2,Answer 1.3,Answer 1.4;" &
"Answer 2.1,Answer 2.2,Answer 2.3,Answer 2.4;" &
"Answer 3.1,Answer 3.2,Answer 3.3,Answer 3.4;" &
"Answer 4.1,Answer 4.2,Answer 4.3,Answer 4.4;" &
"Answer 5.1,Answer 5.2,Answer 5.3,Answer 5.4;" &
"Answer 6.1,Answer 6.2,Answer 6.3,Answer 6.4;" &
"Answer 7.1,Answer 7.2,Answer 7.3,Answer 7.4;" &
"Answer 8.1,Answer 8.2,Answer 8.3,Answer 8.4;" &
"Answer 9.1,Answer 9.2,Answer 9.3,Answer 9.4;" &
"Answer 10.1,Answer 10.2,Answer 10.3,Answer 10.4"
'Serialize object to a text file.
Dim objStreamWriter As New StreamWriter("C:\Users\Username\Documents\Questions.xml")
Dim x As New XmlSerializer(p.GetType)
x.Serialize(objStreamWriter, p)
objStreamWriter.Close()
'Deserialize text file to a new object.
Dim objStreamReader As New StreamReader("C:\Users\Username\Documents\Questions.xml")
Dim p2 As New clsQuestions
p2 = x.Deserialize(objStreamReader)
objStreamReader.Close()
numQuestions = p2.Number.Split(",")
questions = p2.Question.Split(",")
answersGroup = p2.Answer.Split(";")
End Sub
Private Sub btnNext_Click(sender As Object, e As EventArgs) Handles btnNext.Click
Static x As Integer
If x <= questions.Length - 1 Then
Label1.Text = ""
Label2.Text = ""
Label3.Text = ""
arrayIndex(x)
x += 1
End If
End Sub
Private Sub arrayIndex(ByVal num As Integer)
Label1.Text = numQuestions(num)
Label2.Text = questions(num)
Dim answers() As String
answers = answersGroup(num).Split(",")
For Each item As String In answers
Label3.Text &= item & Environment.NewLine
Next
End Sub
End Class
For VB.net 2015
I'm a new programmer. I've been warping my brain around this for 2 days. Can seem to see the problem. It seems I can only add 150 records to the dictionary. I'm not sure where its failing in the code. I'm not getting any errors or warnings.
Really hope someone can give me a hand.
Heres a link to my file I'm working with.
https://drive.google.com/file/d/0B1zf86jcRv49Y1lCMHRvNWt4UFk/view?usp=sharing
P.S. Sry about the crappy coding skill :-)
Imports System
Imports System.IO
Public Class Form1
Dim xx As Integer = 0
Private MainDataList As New Dictionary(Of String, List(Of String))
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim temp1 As List(Of String)
'MsgBox(xx)
If MainDataList.ContainsKey(TextBox1.Text) Then
temp1 = MainDataList.Item(TextBox1.Text)
Label1.Text = temp1(0)
Beep()
Else
Label1.Text = "Not Found"
Beep()
Beep()
End If
TextBox1.Text = ""
End Sub
Private Sub GetData()
Dim ReadDataLine(50000) As String
Try
' Open the file using a stream reader.
Using sr As New StreamReader("C:\Inventory\Invatory.csv")
'Dim line As String
' Read the stream to a string and write the string to the console.
ReadDataLine(0) = sr.ReadLine
Do While (sr.EndOfStream = False)
ReadDataLine(xx) = sr.ReadLine
'AddToList(ReadDataLine) ' pars data into main list
'MsgBox(sr.ReadLine)
xx = xx + 1
Loop
sr.Close()
'line = sr.ReadLine()
End Using
Catch e As Exception
'MsgBox(xx)
MsgBox("The file could not be read:")
MsgBox(e.Message)
End Try
'MsgBox(xx)
'xx = 0
For Each i As String In ReadDataLine
AddToList(i)
'MsgBox(xx)
'xx = xx + 1
Next
End Sub
Private Sub AddToList(data As String)
Dim barCode As String = ""
Dim steps As Integer = 1
Dim LastPos As Integer = 2
Dim datalist As New List(Of String)
Dim firstPass As Boolean = False
For i = 2 To Len(data)
'Find end of cell
If Mid(data, i, 1) = "," Then
If firstPass = False Then
barCode = Mid(data, LastPos, i - 2)
'MsgBox(Mid(data, LastPos, i - 2))
LastPos = i
firstPass = True
Else
Dim temp As Integer = i - LastPos
datalist.Add(Mid(data, LastPos + 1, temp - 1))
'MsgBox(Mid(data, LastPos + 1, temp - 1))
LastPos = i
End If
End If
Next
MainDataList.Add(barCode, datalist)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
GetData()
Label1.Text = "Ready!"
Me.Show()
TextBox1.Focus()
End Sub
Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
End Sub
End Class
Ever since I added the CheckForCollision_Enemy method, I've been getting a stack overflow exception every time I run my code.
Here is the CheckForCollision_Enemy method, in the Main class.
Public Sub CheckForCollision_Enemy()
Dim ship1 As New Enemy(Nothing, Nothing)
Dim ship2 As New Enemy(Nothing, Nothing)
Debug.Print("")
Dim ships = {acc_e, bs_e, sb_e, ds_e, pb_e}
For i As Integer = 0 To ships.Length - 1
ship1 = ships(i)
For j As Integer = 0 To ships.Length - 1
ship2 = ships(j)
If ship1.name <> ship2.name Then
For l As Integer = 0 To ship1.length - 1
For t As Integer = 0 To ship2.length - 1
If ship1.space_filled(l, 0) = ship2.space_filled(t, 0) And ship1.space_filled(l, 1) = ship2.space_filled(t, 1) Then
Debug.Print("Collision at {" & ship1.space_filled(l, 0) & ", " & ship1.space_filled(l, 1) & "} " & ship1.name & " VS " & ship2.name)
End If
Next
Next
End If
Next
Next
End Sub
Here is the Enemy class. This is the class where the error is shown. I marked exactly where as a comment.
Shared gen As New Random()
Dim x As Integer = 0
Dim y As Integer = 0
Public Sub New(ByVal namep As String, ByVal lengthp As Integer)
name = namep
length = lengthp
ReDim _start_point(2)
ReDim _space_filled(length, 2)
GenerateDirection()
If direction = "horizontal" Then
x = gen.Next(0, 11 - length)
y = gen.Next(0, 10)
ElseIf direction = "vertical" Then
x = gen.Next(0, 10)
y = gen.Next(0, 11 - length)
End If
GenerateStartPoint()
ExtendStartPoint()
DefineFilled()
ColorFilled()
Main.CheckForCollision_Enemy() 'If this is taken out, it will work fine.
End Sub
Public Sub GenerateStartPoint()
start_point = {x, y}
End Sub
Public Sub GenerateDirection()
If gen.Next(0, 2) = 0 Then
direction = "horizontal"
Else
direction = "vertical"
End If
End Sub
Public Sub ExtendStartPoint()
If direction = "horizontal" Then
For i As Integer = 0 To length - 1
space_filled(i, 0) = start_point(0) + i
space_filled(i, 1) = start_point(1)
Next
ElseIf direction = "vertical" Then
For i As Integer = 0 To length - 1
space_filled(i, 0) = start_point(0)
space_filled(i, 1) = start_point(1) + i
Next
End If
End Sub
Public Sub DefineFilled()
For i As Integer = 0 To length - 1
x = space_filled(i, 0)
y = space_filled(i, 1)
Try
generate = False
Main.TrackerBoard.box_list(x, y).full = True
Catch
End Try
Next
End Sub
Private Sub ColorFilled()
For y As Integer = 0 To 9
For x As Integer = 0 To 9
'Debug.Print(Main.PlayerBoard.box_list(x, y).full)
If Main.TrackerBoard.box_list(x, y).full = True Then 'New error: "InvalidOperationException"
Main.TrackerBoard.box_list(x, y).image.BackColor = System.Drawing.Color.Red
Else
Main.TrackerBoard.box_list(x, y).image.BackColor = System.Drawing.Color.Silver 'Most often, the error appears here.
End If
Next
Next
End Sub
Here is the ship class. I've taken out most of the methods to save space; if you want to see anything, I'll add it in for you.
Public Class Ship
Dim _name As String
Public Property name() As String ...
Dim WithEvents _image As PictureBox
Public Property image() As PictureBox ...
Dim _length As Integer
Public Property length() As Integer ...
Dim _direction As String
Public Property direction() As String ...
Dim _selected As Boolean
Public Property selected() As Boolean ...
Dim _placed As Boolean
Public Property placed() As Boolean ...
Dim _location() As Integer = {0, 0}
Public Property location() As Integer() ...
Dim _has_moved As Boolean
Public Property has_moved() As Boolean ...
Dim _space_filled(,) As Integer
Public Property space_filled() As Integer(,) ...
Public rect As System.Drawing.Rectangle
Dim mouse_up As Boolean = False
Dim tile_size As Integer = 25
Public Sub New(ByVal namep As String, ByVal imagep As PictureBox, ByVal lengthp As Integer, ByVal directionp As String, ByVal selectedp As Boolean, ByVal placedp As Boolean)
name = namep
image = imagep
length = lengthp
direction = directionp
selected = selectedp
placed = placedp
location(0) = 0
location(1) = 0
ReDim space_filled(length, 2)
rect = New System.Drawing.Rectangle(location(0), location(1), length * tile_size, 1 * tile_size)
End Sub
Private Sub Ship_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles _image.MouseMove ...
Private Sub Ships_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles _image.MouseClick ...
Private Sub Ship_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles _image.MouseUp ...
Public Sub Update() ...
Public Sub SnapToBox() ...
Private Sub DefineSpaceFilled() ...
Private Sub ColorFilled() ...
End Class
Your CheckForCollision_Enemy calls New Enemy, and New Enemy calls CheckForCollision_Enemy. You are recursing until the stack overflows.