Jump to content
bc-vnt

Spanzuratoarea- HangMan in VB.NET and source code

By bc-vnt, in Programe utile

Recommended Posts

bc-vnt Newbie

bc-vnt

Posted
Posted (edited)

Scanning result

Download it

Immagine1.png

Immagine2.png

Form1

Public Class Form1
  Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
    Dim word As String = "abc"
    Dim mainList As New List(Of String)
    Dim counter As Integer = 0 'counter
    Dim newString As String = " "
    'We're going to generate every possible combination
    ' using binary techniques.
    ' Every combination for word.length long strings
    While (newString.Length <= word.Length)
      newString = Convert.ToString(counter, 2) 'Convert the number to Base 2
      mainList.Add(newString)
      counter += 1
    End While
    'This method unfortunately leaves us with one extra item on our list, which we can delete
    mainList.RemoveAt(mainList.Count - 1)
    'Also, the first item is going to be invalid ( "0000" will mean 4 blanks later on, which isn't valid)
    mainList.RemoveAt(0)
    'Now we're going to make all the strings the same length.. still binary technique
    ' for each element, add a 0 to the front of the string until eElement is the same length
    ' as word (so for word "abcd" we want "0000", "0001", "0010" instead of "0", "1", "10", etc
    For i = 0 To mainList.Count - 1
      While Not (mainList(i).Length = word.Length)
        mainList(i) = "0" & mainList(i)
      End While
    Next
    'Now we organize our binary data into a way useful for us
    ' first, when we have 0 blanks, then 1 blank, then 2 blanks, all the way up until word.length-1
    Dim sortedList As New List(Of String)
    ' [i] is the amount of blanks. we start by looking for 0, then 1, all the way to word.length
    For i = 0 To mainList.Count - 1
      ' for each element in the list, "0000","0001","0010",..."1111"
      For Each eElement As String In mainList
        Dim numberOfBlanks As Integer = 0
        ' find how many blanks (or "0"s) there are in this element
        For Each eChar As Char In eElement
          ' if it's blank ("0") , add one to this counter variable
          If (eChar = "0") Then
            numberOfBlanks += 1
          End If
        Next
        ' first we were look for 0 blanks (then 1, then 2, etc)
        '  so on the first pass we only add elements that have a matching
        '  numberOfBlanks to what we're looking for
        If (numberOfBlanks = i) Then
          sortedList.Add(eElement)
        End If
      Next
    Next
    Dim parallelList As New List(Of String)


    'hopefully we don't have to delete all the new variables..
  End Sub
End Class

Normal level

Option Strict On
Public Class NormalEvilForm

  Private Sub DisableGame()
    GuessLetterButton.Enabled = False
    GuessLetterTextBox.Enabled = False
    LetterChoicePanel.Enabled = False
    SolveForMeButton.Enabled = False
  End Sub

  Private Sub Win()
    DisableGame()
    TitleLabel.Text = "You Win!"
    GameOverTimer.Start()
  End Sub

  Private Sub Lose()
    DisableGame()
    TitleLabel.Text = "You Lose!  The Word Was:"
    GuessesLeftLabel.Text = "0"
    SolveForMe()
    GenerateWordCountLabel()
    GameOverTimer.Start()
  End Sub

  Private Sub SetupLabels()
    GuessesLeftLabel.Text = (GuessesLeft).ToString
    GenerateWordCountLabel()
  End Sub

  Private Sub SetRemainingGuesses()
    GuessesLeftLabel.Text = GuessesLeft.ToString
  End Sub

  Private Sub GenerateWordCountLabel()
    WordCountLabel.Text = String.Empty
    For Counter As Integer = 0 To CharactersOfWord.Count - 1
      Dim Letter As String = CharactersOfWord(Counter)
      If Letter = " " Then
        WordCountLabel.Text &= "  "
      Else
        If CorrectGuesses(Counter) = True Then
          WordCountLabel.Text &= Letter & " "
        Else
          WordCountLabel.Text &= "_ "
        End If
      End If
    Next
  End Sub

  Private Sub AddLetterButtonEvents()
    For Each Item As Button In LetterChoicePanel.Controls
      If Item.Tag.ToString <> String.Empty Then
        'AddHandler Item.MouseHover, AddressOf LetterButton_Event
        AddHandler Item.GotFocus, AddressOf LetterButton_Event
      End If
    Next
  End Sub

  Private Sub LetterButton_Event(ByVal sender As System.Object, ByVal e As System.EventArgs)
    Dim LetterButton As Button = TryCast(sender, Button)
    GuessLetterTextBox.Text = LetterButton.Tag.ToString
    GuessLetterButton.Focus()
  End Sub

  Private Sub MainForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    ChooseWord()
    AddLetterButtonEvents()
    GenerateCharactersOfWord()
    SetupLabels()
  End Sub

  Private Sub LetterGuessed(ByVal Letter As String)
    GuessedLetters.Add(Letter)
    Dim CorrectGuess As Boolean = False
    For Counter As Integer = 0 To CharactersOfWord.Count - 1
      If CharactersOfWord(Counter).ToLower = Letter.ToLower Then
        CorrectGuesses(Counter) = True
        CorrectGuess = True
      End If
    Next
    If CorrectGuess = False Then
      GuessesLeft -= 1
      GuessesLeftLabel.Text = (GuessesLeft).ToString
    End If
  End Sub

  Private Sub GuessLetterButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GuessLetterButton.Click
    If GuessLetterTextBox.Text <> String.Empty Then
      For Each Item As Button In LetterChoicePanel.Controls
        If Item.Tag.ToString = GuessLetterTextBox.Text Then
          Item.Enabled = False
        End If
      Next
      If GameType = GameMode.Evil Then
        EvilHangmanFunction(GuessLetterTextBox.Text)
      End If
      LetterGuessed(GuessLetterTextBox.Text)
      GenerateWordCountLabel()
      If GameType = GameMode.Evil Then
        CheckCorrectGuesses()
      End If
      If CheckWin() = True Then
        Win()
      ElseIf CheckLose() = True Then
        Lose()
      End If
      GuessLetterTextBox.Clear()
    End If
    GuessLetterTextBox.Focus()
  End Sub

  Private Sub GuessTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles GuessLetterTextBox.KeyPress
    If Not Char.IsLetter(e.KeyChar) Then
      e.Handled = True
    Else
      For Each Letter As String In GuessedLetters
        If e.KeyChar = Letter.ToLower Then
          e.Handled = True
          Exit Sub
        End If
      Next
      GuessLetterTextBox.Text = String.Empty
    End If
  End Sub

  Private Sub GameOverTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles GameOverTimer.Tick
    GameOverTimer.Stop()
    Dim Result As DialogResult = _
      MessageBox.Show("Would you like to play another game?", "Project Hangman - Game Over", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    If Result = DialogResult.Yes Then
      Reset()
      StartupForm.Show()
      Me.Close()
    Else
      Application.Exit()
    End If
  End Sub

  Private Sub SolveForMeButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SolveForMeButton.Click
    Lose()
  End Sub
End Class

Project module

Option Strict On
Imports System.IO
Module ProjectHangmanModule

  Enum GameMode
    Normal
    Evil
    Ultimate
  End Enum

  Public GameType As GameMode = GameMode.Normal

  Public Word As String
  Public WordLength As Integer '2-24
  Public WordList As New List(Of String)

  Public CharactersOfWord As New List(Of String)
  Public CorrectGuesses As New List(Of Boolean)
  Public GuessedLetters As New List(Of String)

  Public GuessesLeft As Integer

  Public Win As Boolean = False
  Public Lose As Boolean = False

  Private RandomClass As New Random()

  Public Sub Reset()
    Word = ""
    WordLength = 0
    WordList.Clear()
    CharactersOfWord.Clear()
    CorrectGuesses.Clear()
    GuessedLetters.Clear()
    GuessesLeft = 0
    Win = False
    Lose = False
  End Sub

  Public Sub ChooseWord()
    Try
      Dim TextFile As New StreamReader("WordList.txt")
      While TextFile.EndOfStream = False
        WordList.Add(TextFile.ReadLine())
      End While

      For Counter As Integer = WordList.Count - 1 To 0 Step -1
        If WordList(Counter).Length <> WordLength Then
          WordList.RemoveAt(Counter)
        End If
      Next
      Word = WordList(RandomClass.Next(0, WordList.Count))
    Catch ex As Exception
      MessageBox.Show("Error:" & ControlChars.NewLine & ex.Message, "Hangman - Error", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1)
    End Try
  End Sub

  Public Sub EvilHangmanFunction(ByVal Letter As String)
    'Convert the letter to lower case
    Letter = Letter.ToLower()
    'A list of all lists of words containing or not containing the given letter
    Dim TotalList As New List(Of List(Of String))
    'Create a sub list to the total list for each letter in the word
    'and one for the word not containing the letter
    For Counter As Integer = 0 To WordLength - 1
      Dim SubList As New List(Of String)
      TotalList.Add(SubList)
    Next
    'For Each word in the current word list
    For Each Word As String In WordList
      Dim ContinueFor As Boolean = False
      'For Each letter in the word
      For Counter As Integer = 0 To Word.Length - 1
        'If the letter is the letter given to the function
        If Word.Substring(Counter, 1) = Letter Then
          'add the word to the list, based on the counter
          TotalList(Counter).Add(Word)
        End If
      Next
    Next
    'Now find the sub list that contains the most elements
    Dim highestCountIndex As Integer = 0
    Dim highestCount As Integer = 0
    For Counter = 0 To TotalList.Count - 1
      If (highestCount < TotalList(Counter).Count) Then
        highestCount = TotalList(Counter).Count
        highestCountIndex = Counter
      End If
    Next
    'A temporary list to store words in
    Dim TempList As New List(Of String)
    'For each word not containing the letter
    For Each Word As String In WordList
      If Not Word.Contains(Letter) Then
        'Add the word to the temp list
        TempList.Add(Word)
      End If
    Next
    'Clea the word list
    WordList.Clear()
    'If the temp list has elements
    If TempList.Count <> 0 Then
      For Each Word As String In TempList
        'Populate WordList by the words in the TempList
        WordList.Add(Word)
      Next
    Else 'If TempList.Count = 0
      For Each Word As String In TotalList(highestCountIndex)
        'Populate WordList by the words in the list with the most elements
        WordList.Add(Word)
      Next
    End If
    'Next set Word to a new random word, in the new list
    Word = WordList(RandomClass.Next(0, WordList.Count))
    GenerateCharactersOfWord()
  End Sub

  Public Sub GenerateCharactersOfWord()
    CorrectGuesses.Clear()
    CharactersOfWord.Clear()
    For Counter As Integer = 0 To Word.Length - 1
      Dim Letter As String
      Letter = Word.Substring(Counter, 1)
      CharactersOfWord.Add(Letter)
      Dim LetterGuessed As Boolean = False
      For Each GLetter In GuessedLetters
        If GLetter.ToLower = Letter.ToLower Then
          LetterGuessed = True
        End If
      Next
      Dim ALetter As Boolean = False
      If Letter = " " Or LetterGuessed = True Then
        ALetter = True
      End If
      CorrectGuesses.Add(ALetter)
    Next
  End Sub

  Public Sub CheckCorrectGuesses()
    For Each Item As String In GuessedLetters
      For Counter As Integer = 0 To WordLength - 1
        If Word.Substring(Counter, 1) = Item.ToLower Then
          CorrectGuesses(Counter) = True
        End If
      Next
    Next
  End Sub

  Public Sub SolveForMe()
    For Counter As Integer = 0 To CorrectGuesses.Count - 1
      CorrectGuesses(Counter) = True
    Next
  End Sub

  Public Function CheckWin() As Boolean
    For Each Letter As Boolean In CorrectGuesses
      If Letter = False Then
        Return False
      End If
    Next
    Return True
  End Function

  Public Function CheckLose() As Boolean
    If GuessesLeft = 0 Then
      Return True
    Else
      Return False
    End If
  End Function

End Module

Start UP

Public Class StartupForm

  Private Sub ShowOptions()
    Me.Size = New Size(806, 342)
    OptionsPanel.Enabled = True
    WordLengthNumericUpDown.Focus()
  End Sub

  Private Sub SetSelectedButton(ByVal Button As GameMode)
    Select Case Button
      Case GameMode.Normal
        NormalButton.ForeColor = Color.Blue
        EvilButton.ForeColor = Color.Black
        UltimateButton.ForeColor = Color.Black
      Case GameMode.Evil
        NormalButton.ForeColor = Color.Black
        EvilButton.ForeColor = Color.Blue
        UltimateButton.ForeColor = Color.Black
      Case GameMode.Ultimate
        NormalButton.ForeColor = Color.Black
        EvilButton.ForeColor = Color.Black
        UltimateButton.ForeColor = Color.Blue
    End Select
  End Sub

  Private Sub NormalButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NormalButton.Click
    GameType = GameMode.Normal
    SetSelectedButton(GameType)
    ShowOptions()
    Me.AcceptButton = StartButton
  End Sub

  Private Sub EvilButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EvilButton.Click
    GameType = GameMode.Evil
    SetSelectedButton(GameType)
    ShowOptions()
    Me.AcceptButton = StartButton
  End Sub

  Private Sub UltimateButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles UltimateButton.Click
    GameType = GameMode.Ultimate
    SetSelectedButton(GameType)
    UltimateForm.Show()
    Me.Close()
  End Sub

  Private Sub StartButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartButton.Click
    WordLength = WordLengthNumericUpDown.Value
    GuessesLeft = NumberOfGuessesNumericUpDown.Value
    NormalEvilForm.Show()
    Me.Size = New Size(806, 212)
    Me.Close()
  End Sub

  Private Sub NumberOfGuessesNumericUpDown_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles _
    NumberOfGuessesNumericUpDown.GotFocus, _
    NumberOfGuessesNumericUpDown.Click
    NumberOfGuessesNumericUpDown.Select(0, 2)
  End Sub

  Private Sub WordLengthNumericUpDown_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles _
    WordLengthNumericUpDown.GotFocus, _
    WordLengthNumericUpDown.Click
    WordLengthNumericUpDown.Select(0, 2)
  End Sub
End Class

Enjoi ... !!!

Edited by bc-vnt
  • Upvote 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
Go to topic listing
×
×
  • Create New...