Imports System.IO
Module Module1
Dim CoveredWord, Word As String
Dim Guessed(30), RandomWord(1) As String
Dim MoveCount As Integer = 7, Score As Integer = 0, GameOver As Integer = 1
Sub Main()
Dim Quit As String
Do
Console.Clear()
Call ChooseWord()
Console.Write("Do You Wish To Continue (Y/N) : ") : Quit = Console.ReadLine
Loop Until LCase$(Quit) = "n"
End Sub
Sub ChooseWord()
Dim StrLen As Integer, Choice As String
' Allows User To Have A random word or choose there own.
Console.Write("Do You Want A Random Word (Y/N) : ") : Choice = LCase$(Console.ReadLine)
Console.WriteLine()
Select Case Choice
Case Is = "n"
Console.Write("Choose Your Word : ") : Word = RTrim$(LTrim$((Console.ReadLine)))
Case Is = "y"
Call RndWord()
End Select
Console.Clear()
StrLen = Len(Word)
For i As Integer = 1 To StrLen
CoveredWord = CoveredWord + "#"
Next 'Creates A String Of Hashs To Represent The Unknown Word.
Word = StrConv(Word, vbProperCase)
Call GuessLetter()
End Sub
Sub GuessLetter()
'Enter Guess and increment counter to fill in the guessed array
Dim Guess As String, GuessPointer As Integer = 1
Do
Console.Write("Enter Your Guess (Help For Help) : ") : Guess = LCase$(Console.ReadLine)
Console.Clear()
Select Case Guess
Case Is = "help"
Console.WriteLine("Enter A Word Or Letter As Your Guess.")
Console.WriteLine("Guessing The Word Gives You A Point.")
Case Else
If ValidGuess(Guess, GuessPointer) = True Then
Call WinCheck(Guess, GuessPointer)
GuessPointer += 1
Else
Console.writeline()
Console.writeline("You Have Already Guessed That. Try Again")
Console.writeline()
End If
End Select
Loop Until GameOver <> 1
End Sub
Sub WinCheck(ByVal Guess As String, ByVal GuessPointer As Integer)
'Checks Guess against Word
'Reassigns coveredword with guess if it is correct
'Increments Movecount and determines Lose
Randomize()
Dim StrPos, Random As Integer, IncorrectGuess As Boolean = True
Dim SubStr As Char
On Error Resume Next
IncorrectGuess = True
Select Case Len(Guess)
Case Is = 1 'Checks If the guess is a single character or a word
Guessed(GuessPointer) = UCase$(Guess)
StrPos = InStr(LCase$(Word), Guess)
While StrPos <> 0
Mid$(CoveredWord, StrPos, 1) = Guess
StrPos = InStr(StrPos + 1, LCase$(Word), Guess)
IncorrectGuess = False
End While 'loop through word checking for guess letter and revealing the covered word.
Case Else
Guessed(GuessPointer) = StrConv(Guess, vbProperCase)
If Guess = Word Then
GameOver = 2
CoveredWord = Word
IncorrectGuess = False
End If 'If Guess > 1 Char Compares to word and returns IncorrectGuess True/Flase
End Select
If IncorrectGuess = True Then
MoveCount -= 1
If MoveCount = 0 Then
GameOver = 3
End If
End If
If Instr(CoveredWord, "#") = 0 Then 'Checks For A Win
GameOver = 2
End If
Call DisplayProgress(GuessPointer)
End Sub
Sub DisplayProgress(ByVal GuessPointer As Integer)
Console.WriteLine()
Console.WriteLine()
If GameOver = 1 Then 'Shows uncovered Word So Far and guesses left.
Console.WriteLine("The Word Is : " + CoveredWord)
Console.WriteLine()
Console.Write("You Have Guessed : ") 'Shows All guesses including full word guesses
For i As Integer = 1 To GuessPointer
If i = GuessPointer Then
Console.Write(Guessed(i))
Else
Console.Write(Guessed(i) + " ")
End If
Next
Console.WriteLine()
Console.WriteLine("You Have " + MoveCount.ToString() + " Guesses Left.")
End If
If GameOver = 2 Then
Score += 1
Console.WriteLine("Congratulations You Have Guessed The Word.")
Console.WriteLine("The Word Was : " + Word)
Console.WriteLine("Your Score is " + Score.ToString())
End If
If GameOver = 3 Then
Score -= 1
Console.WriteLine("You Didnt Guess The Word. You Lost A Point.")
Console.WriteLine("The Word Was : " + Word)
Console.WriteLine("_____") ' Drawing a different man with each guess uses lots of code
Console.WriteLine("| O") '#?If stored in a text file and read into an array/List each set of five would be a different man?#
Console.WriteLine("| -|-")
Console.WriteLine("| /\")
Console.WriteLine("|_____")
Console.WriteLine()
Console.WriteLine("Your Score is " + Score.ToString())
End If
Console.WriteLine()
End Sub
Sub RndWord()
'Opens Textfile and Gets a random word from it
'Allows entry of more words to the file
Randomize()
Dim CurrentReader As StreamReader
Dim CurrentWriter As StreamWriter
Dim Filename As String = "N:/RndWordDict.txt", Count As Integer = 1
Dim Choice, Export As String
If Ubound(RandomWord) < 2 Then
CurrentReader = New StreamReader(Filename) ' , FileMode.Open
While Not CurrentReader.EndOfStream
RandomWord(Count) = CurrentReader.ReadLine()
Count += 1
ReDim Preserve RandomWord(UBound(RandomWord) + 1)
End While
CurrentReader.Close()
End If
Dim ChooseRndWord As Single = (Rnd() * UBound(RandomWord))
Word = LTrim$(RTrim$(RandomWord(CInt(ChooseRndWord))))
Console.Write("Do You Wish To Add More Random Words (Y/N) : ") : Choice = Console.ReadLine
Select Case Choice
Case Is = "y"
CurrentWriter = New StreamWriter(Filename) ', FileMode.Append
Do
Console.Write("Enter Your Word : ") : Export = Console.ReadLine
Console.WriteLine()
CurrentWriter.WriteLine(Export)
Console.Write("Do You Wish To Enter Another Word (Y/N) : ") : Choice = Console.ReadLine
Console.WriteLine()
Loop Until LCase$(Choice) = "n"
End Select
End Sub
Function ValidGuess(ByVal Guess As String, ByVal GuessPointer As Integer) As Boolean
Dim Compare As String
For i As Integer = 1 To GuessPointer
Compare = Guessed(i)
If StrComp(Compare, Guess, vbBinaryCompare) = 0 Then
ValidGuess = False
Exit Function
End If
Next i
ValidGuess = True
End Function
End Module