Why wont my code go back to the main menu? - vb.net

I'm creating a guess the number game in VB.Net. I've got to the point where I'm asking the player if they would like to play again after they have won. When I try and send them back to the main menu if they select that they would like to play again it just exits out of the program.
Sub MainMenu()
Console.WriteLine("Main Menu")
Console.WriteLine("1) Play Game")
Console.WriteLine("2) Instructions")
Console.WriteLine("3) View Score")
Console.WriteLine("4) Exit")
Console.WriteLine()
End Sub
If UserGuess = CorrectNumber Then
PlayerScore = PlayerScore + 1
Console.WriteLine("...CORRECT!!! You win!")
Console.WriteLine("You took " & NOfGuesses & " guesses!")
Console.WriteLine("Press Enter to Continue")
Console.ReadLine()
Console.Clear()
PlayAgainSub()
End If
Sub PlayAgainSub()
Dim PlayAgain As Char
Console.Clear()
Console.WriteLine("Would you like to play again? (Y/N)")
PlayAgain = Console.ReadLine.ToUpper
If PlayAgain = "Y" Then
MainMenu()
ElseIf PlayAgain = "N" Then
Quit()
Else
Console.WriteLine("Option not valid!")
REM Next line waits for 0.5 seconds so the user has time to see the error message.
Threading.Thread.Sleep(500)
Console.Clear()
PlayAgainSub()
End If
End Sub
This isn't all of the code, just what I considered relevant, if you need the rest of it I will update the post.

set a variable for recursion example
Dim recur As Char
then use Do .. loop while

Related

How do I show a progress bar whilst my sub routine is running?

I am trying to work out how to get my progress bar to show the progress of the subroutine below. Does anyone have any ideas how to get the ball rolling on this one?
Any help or advice is appreciated.
Private Sub CommandButton8_Click()
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Direct Data
Sheet4.Activate
Call Test1
Call Test2
Call Test3
Call Test4
'Return to Welcome Page
Sheet8.Activate
'*****************************
'Determine how many seconds the code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
vbInformation
End Sub
Here's what I use for a progress bar:
Application.StatusBar = "Processing... " & CInt(nRow / nLastRow * 100) & "% " & String(CInt(nRow / nLastRow * 100), ChrW(9609))
DoEvents ' optional
nRow is the increment number
nLastRow is the value for 100% complete
When the loop is complete, reset it like this:
Application.StatusBar = ""
The logic behind a progressbar is this:
have a userform with a Label (or image or button) with the image of your example photo. Put it in a frame. The width of the frame is initialised to zero and grows as your number grows by either calling a Public Sub inside the userform, of directly Userform1.Frame1.width=Percent*MaxWidth/100.
Sometime you would want to add a doevents, wich i use only every X cycles (if clng(percent) mod X = 0 then doevents , for example).
Step 1: design a progress dialog box. For the following example, it must have the name frmProgress and have two text labels lblMsg1 and lblMsg2
Step 2: insert the following code in the dialog's code module:
Sub ShowProgressBox()
Me.Show vbModeless
End Sub
Sub SetProgressMsg(msg1, msg2)
If (msg1 <> "") Then Me.lblMsg1 = msg1
If (msg2 <> "") Then Me.lblMsg2 = msg2
DoEvents
End Sub
Sub SetProgressTitle(title)
Me.Caption = title
DoEvents
End Sub
Sub EndProgressBox()
Unload Me
End Sub
You can call these functions from your code to show progress messages.
Step 3: in your code, at the beginning of the lengthy operation, call
frmProgress.ShowProgressBox
Step 4: during the lengthy operation, regularly call the set function to show the user information, for example in a loop:
frmProgress.SetProgressMsg "Searching in "+ myArray(i), "Working..."
Step 5: Once done, close the progress box:
frmProgress.EndProgressBox

MS Access, DoEvents to exit loop

What I'd like to accomplish:
Do While ctr < List and Break = False
code that works here...
DoEvents
If KeyDown = vbKeyQ
Break = True
End If
loop
Break out of a loop by holding down a key (eg, Q). I've read up on DoEvents during the loop in order to achieve the functionality that I want. The idea is to have a Do While loop run until either the end of the list is reached or when Q is held down. I'm having issues getting the code to work the way I want, so I'm reaching out to hopefully end the frustration. My experience with VBA is very limited.
UPDATE - More code to expose where the problem might be. This is all in the order I have it (in case order of subs makes a difference:
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim strChar As String
strChar = UCase(Chr(KeyAscii))
If strChar = "Q" Then
blnQuit = True
Debug.Print "Q pressed"
End If
End Sub
Private Sub Master_Report_Click()
Dim i As Integer
Dim Deptarray
blnQuit= False
If IsNull(Me.Hospital) Then
MsgBox ("Please Choose a Hospital")
Else
DoCmd.OpenForm "Report Print/Update", acNormal, , , , acDialog
If Report_choice = "Current_List" Then
Debug.Print "Create master rec report"
DoCmd.OpenReport "Master Rec Report", acViewPreview
DoCmd.RunCommand acCmdZoom100
ElseIf Report_choice = "Update_All" Then
total = (DCM_Dept.ListCount - 1)
ctr = 1
Do While ctr < (DCM_Dept.ListCount) And LoopBreak = False
Debug.Print "LoopBreak: "; LoopBreak
Debug.Print "Counter: "; ctr
DCM_Dept.Value = DCM_Dept.Column(0, ctr)
Update_Site (Me.Hospital)
ctr = ctr + 1
'DoEvents
' If vbKeyQ = True Then
'LoopBreak = True
'End If
Loop
Debug.Print "Update loop exited"
Debug.Print "Create master rec report"
DoCmd.OpenReport "Master Rec Report", acViewPreview
DoCmd.RunCommand acCmdZoom100
Else
End If
End If
End Sub
Private Sub Update_Site(Site As String)
If IsNull(Me.Hospital) Then
MsgBox ("Please Choose a Hospital")
ElseIf IsNull(Me.DCM_Dept) Then
MsgBox ("Please Choose a Department")
ElseIf Site = "FORES" Then
Debug.Print "Run FORES update macro"
DoCmd.RunMacro "0 FORES Master Add/Update"
ElseIf Site = "SSIUH" Then
Debug.Print "Run SSIUH update macro"
DoCmd.RunMacro "0 SSIUH Master Add/Update"
End If
End Sub
Report_choice and LoopBreak are both Public variables. My original idea was to have a popup form floating over the main form to display a counter ("Processing department X of Y") and a button to break the loop on there. I realized that the form was unresponsive while the Update_Site() was running its macro so I decided to go with holding a key down instead.
So, where do I go from here to get OnKeyDown to work? Or, is there a better way to do it?
Try to set the Key Preview of the form to Yes and add a variable blnQuit and a key press event in your form like this:
Private blnQuit As Boolean
'form
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim strChar As String
strChar = UCase(Chr(KeyAscii))
If strChar = "Q" Then
blnQuit = True
End If
End Sub
Then check the blnQuit in your Do While condition, like this:
blnQuit = False
Do While ctr < List And Not blnQuit
code that works here...
DoEvents
loop

Random number guessing game VB

OBJECTIVE:
This is a guessing game. The program is to generate a random number between 1 and 500. The user is to guess the number.
The form should include a START button, a listbox to hold all valid guesses, and a label displaying the answer.
Upon clicking the START button, the user will enter a number in response to an InputBox().
If the user’s guess is invalid (not numeric, not a whole number, out of range), display an appropriate message.
If the guess is valid but is not the correct number (high or low), display an appropriate message.
image high quess dialog boximage low quess dialog box
Every time the user guesses a valid numeric guess within range, add the guess to the listbox on the form. Allow the guesses to be shown in multiple columns in the listbox.
If the user successfully guesses the number, display an appropriate message. Include how many guesses they took. Count only valid (in range, integral) numeric guesses as a guess.
Allow the user to quit the game by entering Quit in response to the input box. If the user gives up, tell them the correct number
Important: Display the random number in a label immediately after generating it so that I (and you) know what the number is while I am (and you are) testing it. You can obviously take it out if you really want to play the game.
Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
'Declare Variables
Dim strGuess As String
Dim random As New Random
Dim answer As Integer
'Start with empty Boxes
lstGuesses.Items.Clear()
answer = random.Next(1, 500)
lblAnswer.Text = CStr(answer)
Do
Try
strGuess = InputBox("Enter a numeric integer between 1 and 500. , Enter 'quit' to Quit.", "Guessing Game")
lstGuesses.Items.Add(strGuess)
If strGuess = CStr("quit") Then
MessageBox.Show("The number was " & answer & ". Click Start Game to play again.")
Exit Do
End If
If CInt(strGuess) < CInt(1) Then
MessageBox.Show("Invalid Guess. Enter an Integer Number between 1 and 500!")
End If
If CInt(strGuess) > CInt(500) Then
MessageBox.Show("Invalid Guess. Enter an Integer Number between 1 and 500!")
End If
If CInt(strGuess) = CInt(answer) Then
MessageBox.Show("Got it! You guessed " & lstGuesses.Items.Add(strGuess) & " times!")
End If
If CInt(strGuess) > CInt(answer) And CInt(strGuess) <= CInt(500) Then
MessageBox.Show("Guess is High")
End If
If CInt(strGuess) < CInt(answer) And CInt(strGuess) >= CInt(1) Then
MessageBox.Show("Guess is Low")
End If
If lstGuesses.Items.Contains("quit") = True Then
MessageBox.Show("The number was " & answer & ". Click Start Game to play again.")
End If
Catch ex As InvalidCastException
'Make user guess
MessageBox.Show("Invlid Guess. Enter a numeric integer between 1 and 500!")
End Try
Loop While CInt(strGuess) <> answer
End Sub
MY PROBLEM:
I have been trying everything and this is the best i have made yet. This homework is due in 4 hours so any help will be appreciated.
I am suppose to type the word "quit" to end the game. But also give an error message when something other than letters are typed. Every time I type a letter and press enter, it gives the warning that i set but then it crashes. It is not supposed to crash. It says the crash is from:
Loop While CInt(strGuess) <> answer
and the problem is because of an InvalidCastException and says convertion from string to type integer is not valid. I tried doing TRYPARSE but still the same problem. Can anyone tell me how to let me type the word "quit" into the box so that it quits the game, but doesn't make it crash.
Maybe this is not the best way but i think it will help.
What you need to do is Make a new if statement at the top just after the user entered something in the inputbox.
If IsNumeric(strGuess) Or strGuess = CStr("quit") Then
Else
MessageBox.Show("Only Numbers")
GoTo Line1
End If
And here you check "If IsNumeric(strGuess) Or strGuess = CStr("quit") Then"
if yes do nothing
If No show a msgbox and use a goto "GoTo Line1" "so above your do you add Line1:"
If somebody types something like "a" he will go to line1 "so start the do" and the user needs to enter something new in the inputbox.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'Declare Variables
Dim strGuess As String
Dim random As New Random
Dim answer As Integer
'Start with empty Boxes
lstGuesses.Items.Clear()
answer = random.Next(1, 500)
lblAnswer.Text = CStr(answer)
Line1:
Do
Try
strGuess = InputBox("Enter a numeric integer between 1 and 500. , Enter 'quit' to Quit.", "Guessing Game")
lstGuesses.Items.Add(strGuess)
If IsNumeric(strGuess) Or strGuess = CStr("quit") Then
Else
MessageBox.Show("Only Numbers")
GoTo Line1
End If
If strGuess = CStr("quit") Then
MessageBox.Show("The number was " & answer & ". Click Start Game to play again.")
Exit Do
End If
If CInt(strGuess) < CInt(1) Then
MessageBox.Show("Invalid Guess. Enter an Integer Number between 1 and 500!")
End If
If CInt(strGuess) > CInt(500) Then
MessageBox.Show("Invalid Guess. Enter an Integer Number between 1 and 500!")
End If
If CInt(strGuess) = CInt(answer) Then
MessageBox.Show("Got it! You guessed " & lstGuesses.Items.Add(strGuess) & " times!")
End If
If CInt(strGuess) > CInt(answer) And CInt(strGuess) <= CInt(500) Then
MessageBox.Show("Guess is High")
End If
If CInt(strGuess) < CInt(answer) And CInt(strGuess) >= CInt(1) Then
MessageBox.Show("Guess is Low")
End If
If lstGuesses.Items.Contains("quit") = True Then
MessageBox.Show("The number was " & answer & ". Click Start Game to play again.")
End If
Catch ex As InvalidCastException
'Make user guess
MessageBox.Show("Invlid Guess. Enter a numeric integer between 1 and 500!")
End Try
Loop While CInt(strGuess) <> answer
End Sub

'Listen' for a keypress while thread is sleeping

Is there a way to do this with no UI on the screen? Currently I'm having this small non-UI program read and write information from a 3270 mainframe to a Text File every 60 seconds, suppose the user wants to cancel in the middle of the 60 second wait, how could I 'listen' for a keypress without any events from the UI?
You need some kind of interface to capture keystrokes.
Here is example that runs in a console application (create a blank one and paste into the defauklt module)
It allows processing "SOMETHING" in a background thread while leaving the GUI idle for the user to enter commands. In this case just a simple 1 second delay counter to 1000.
Option Compare Text
Module Module1
Sub Main()
Console.WriteLine("Enter ""Start"", ""Stop"", or ""Exit"".")
Do
Dim Com As String = Console.ReadLine
Select Case Com
Case "Start"
Console.WriteLine(StartWork)
Case "Stop"
Console.WriteLine(StopWork)
Case "Exit"
Console.WriteLine("Quiting on completion")
Exit Do
Case Else
Console.WriteLine("bad command Enter ""Start"", ""Stop"", or ""Exit"".")
End Select
Loop
End Sub
Public Function StartWork() As String
If ThWork Is Nothing Then
ThWork = New Threading.Thread(AddressOf Thread_Work)
ThWork.IsBackground = False 'prevents killing the work if the user closes the window.
CancelWork = False
ThWork.Start()
Return "Started Work"
Else
Return "Work Already Processing"
End If
End Function
Public Function StopWork() As String
CancelWork = True
If ThWork Is Nothing Then
Return "Work not currently running"
Else
Return "Sent Stop Request"
End If
End Function
Public CancelWork As Boolean = False
Public ThWork As Threading.Thread = Nothing
Public dummyCounter As Integer = 0
Public Sub Thread_Work()
Try
Do
dummyCounter += 1
Console.Title = "Working ... #" & dummyCounter
' ###############
' do a SMALL PART OF YOUR WORK here to allow escape...
' ###############
If dummyCounter >= 1000 Then
Console.Title = "Work Done at #" & dummyCounter
Exit Do
ElseIf CancelWork Then
Exit Do
End If
Threading.Thread.Sleep(1000) ' demo usage only.
Loop
Catch ex As Exception
Console.WriteLine("Error Occured at #" & dummyCounter)
End Try
ThWork = Nothing
If CancelWork Then
Console.Title = "Work Stopped at #" & dummyCounter
End If
End Sub
End Module

vb.net console application only works once

I'm just learning to code in vb.net and am currently messing around with VB.net console applications. I can't for the life of me figure something out. It's probably been asked before on here, but I can't find anything by searching. I just coded a simple "check if Y or N was entered. If y/n was entered, display 'you have entered y/n'" program, and it works fine the first time. However, after the first entry I can't get the process to repeat. All I get back is blank space. For example, if i enter y, I'll get the corresponding message. however, if after that I enter n I get nothing back.
here's the code:
Module Module1
Sub Main()
Console.Title = "Hello"
Console.WriteLine("Y or N")
Dim line As String
line = Console.ReadLine()
Do Until line = "exit"
If line = "y" Then
Console.WriteLine("you have chosen y")
Console.ReadLine()
ElseIf line = "n" Then
Console.WriteLine("you have chosen n")
Console.ReadLine()
End If
line = ""
Loop
End Sub
End Module
I'm assuming the answer's super simple, but I can't seem to figure it out or fin the answer online.
Thanks for the help.
You have to store the value of Console.ReadLine() in the Line string.
Module Module1
Sub Main()
Console.Title = "Hello"
Console.WriteLine("Y or N")
Dim line As String
line = Console.ReadLine()
Do Until line = "exit"
If line = "y" Then
Console.WriteLine("you have chosen y")
ElseIf line = "n" Then
Console.WriteLine("you have chosen n")
End If
line = Console.ReadLine()
Loop
End Sub
End Module
you need to assign Console.Readline() to line in your Do Loop:
Do Until line = "exit"
If line = "y" Then
Console.WriteLine("you have chosen y")
ElseIf line = "n" Then
Console.WriteLine("you have chosen n")
End If
line = Console.ReadLine()
Loop
This line is your problem:
line = ""
You're reading the console but not assigning that to your variable.
Here's how it should be:
Do Until line = "exit"
If line = "y" Then
Console.WriteLine("you have chosen y")
ElseIf line = "n" Then
Console.WriteLine("you have chosen n")
End If
line = Console.ReadLine()
Loop
You need to re-assign line to whatever the next line read from the console is, like so:
Module Module1
Sub Main()
Console.Title = "Hello"
Console.WriteLine("Y or N")
Dim line As String
line = Console.ReadLine()
Do Until line = "exit"
If line = "y" Then
Console.WriteLine("you have chosen y")
ElseIf line = "n" Then
Console.WriteLine("you have chosen n")
End If
line = Console.ReadLine() ''here
Loop
End Sub
End Module
Inside your loop, you're doing Console.ReadLine() without doing anything with the value, and you're then doing line = "". Your loop is going around infinitely with an empty line, and ignoring the user input.
Remove the two lines Console.ReadLine(), and then replace line = "" with line = Console.ReadLine().