Write your own hangman game


Many years ago (1985) I wrote a C program to play Hangman. I had decoded a word processor spelling dictionary for my word source.


 


More recently, I have encoded 2 spelling dictionaries for general purpose use: 1 with 171201 words, the other with 53869. There’s some pretty serious compression to get them both into a 679,936 byte dll. That’s an average of 3 bytes per word!


 


This hangman doesn’t have much graphically, but it does keep your average score.


 


Fox and VB versions below:


 


See also:


Click to download Dictionary.dll (you’ll need to REGSVR32 this guy)


A word puzzle (also a link to download the dictionary): A Discounter Introduces Reductions: Multiple Anagrams


Another game: The Nametag Game


A program to convert your phone number into words: Phone Number Challenge update


 


 


Here’s the Fox version


 


PUBLIC ox as HangMan


ox=CREATEOBJECT(“HangMan”)


ox.play


DEFINE CLASS HangMan AS Form


          oDict=0


          nWordLen=0


          cWord=“”


          cPriorWord=“”


          nSolved = 0   && #of letters solved for current word


          nWrongLetters=0 && # of wrong letters for current word


          nTotalWords = 0      


          nTotalWrong=0


          AllowOutput=.f.


          left=200


          DIMENSION aLabels[26]


          ADD OBJECT lblStatus as label WITH ;


                   top=this.Height/2+40,;


                   width = thisform.Width-10,;


                   Height=60,;


                   caption=“”


          PROCEDURE Init


                   this.oDict=CREATEOBJECT(“dictionary.dict”)


                   this.oDict.DictNum=2 && Small dictionary (53000 words)


                   nMinlen=5 && Minimum length of word


                   FOR i = 1 TO ALEN(this.aLabels)


                             this.AddObject(“this.aLabels[“+TRANSFORM(i)+“]”,“MyLabel”)


                   ENDFOR


                   this.Visible= .T.


          PROCEDURE Play


                   nMinlen=5 && Minimum length of word


                   this.nWordLen=0


                   this.cPriorWord = this.cWord


                   DO WHILE this.nWordLen < nMinLen


                             this.cWord=this.oDict.RandWord(1)


                             this.nWordLen=LEN(this.cWord)


                   ENDDO


                   FOR i = 1 TO ALEN(this.aLabels)


                             WITH this.aLabels[i] as Label


                                      IF i <= this.nWordLen


                                                .Visible= .T.


                                                .Left=10 + i * 20


                                                .Top=thisform.Height/2-20


                                                .Width=20


                                                .Caption=“_”


                                      ELSE


                                                .Visible=.f.


                                      ENDIF


                             ENDWITH


                   ENDFOR


                   this.nSolved = this.nWordLen         && track # of solved letters


                   this.nWrongLetters = 0


                   this.ShowStatus


          PROCEDURE ShowStatus


                   cStr=“”


                   cStr=cStr+CHR(13)+” # of Wrong Letters = “+TRANSFORM(this.nWrongLetters)


*                  cStr=cStr+this.cWord+” “    && Cheat!


                   IF !this.cPriorWord ==“”


                             cStr=cStr+CHR(13)+“Prior word = ‘”+this.cPriorWord+“‘”


                             cStr = cStr + CHR(13)+“Average # of wrong guesses is “+;


                                      TRANSFORM(this.nTotalWrong/this.nTotalWords,“999.99”)+” for “+;


                                      TRANSFORM(this.nTotalWords)+” words”


                   ENDIF


                   this.lblStatus.Caption=cStr


          PROCEDURE KeyPress(nKeyCode, nShiftAltCtrl)


                   DO CASE


                   CASE nKeyCode=27


                             thisform.Release


                   CASE ISALPHA(CHR(nKeyCode))


                             cchr = LOWER(CHR(nkeyCode))


                             fGotone = .f.


                             FOR i = 1 TO this.nWordLen


                                      IF SUBSTR(this.cWord, i,1) = cchr  AND ;


                                                          “_” = this.aLabels[i].caption


                                                fGotOne=.t.


                                                this.aLabels[i].Caption=cchr


                                                this.nSolved = this.nSolved-1


                                                IF this.nSolved = 0   && solved it!


                                                          this.nTotalWords = this.nTotalWords+1


                                                          this.nTotalWrong = this.nTotalWrong + this.nWrongLetters


                                                          this.Play


                                                          RETURN


                                                ENDIF


                                      ENDIF


                             ENDFOR


                             IF !fGotOne


                                      this.nWrongLetters = this.nWrongLetters +1


                             ENDIF


                             this.ShowStatus


                   ENDCASE


ENDDEFINE


DEFINE CLASS MyLabel as Label


          FontSize=14


          FontBold=.t.


          FontName=“Courier New”    && Monospace


          width=20


          height=30


         


ENDDEFINE


 


And the VB version:


 


 


Public Class Form1


 


    Dim oDict As Object


    Dim nWordLen = 0


    Dim cWord As String = “”


    Dim cPriorWord As String = “”


    Dim nSolved = 0 ‘&& #of letters solved for current word


    Dim nWrongLetters = 0 ‘&& # of wrong letters for current word


    Dim nTotalWords = 0


    Dim nTotalWrong = 0


    Dim aLabels(26) As MyLabel


    Dim oLblStatus As New Label


 


    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load


        oDict = CreateObject(“Dictionary.Dict”)


        oDict.DictNum = 2   ‘ Small dictionary (53000 words)


        Dim nMinlen = 5 ‘ Minimum length of word


        Me.Width = 400


        Dim i


        For i = 0 To aLabels.Length – 1


            aLabels(i) = New MyLabel


            Me.Controls.Add(aLabels(i))


        Next


        oLblStatus.Top = Me.Height / 2 + 20


        oLblStatus.Height = 150


        oLblStatus.Width = Me.Width


        oLblStatus.Visible = True


        Me.Controls.Add(oLblStatus)


 


 


    End Sub


    Sub Play()


        Dim nMinlen = 5 ‘ Minimum length of word


        Me.nWordLen = 0


        Me.cPriorWord = Me.cWord


        Do While Me.nWordLen < nMinlen


            Me.cWord = Me.oDict.RandWord(1)


            Me.nWordLen = Len(Me.cWord)


        Loop


        For i As Integer = 0 To Me.aLabels.Length – 1


            With Me.aLabels(i)


                If i < Me.nWordLen Then


                    .Visible = True


                    .Left = 10 + i * 20


                    .Top = Me.Height / 2 – 20


                    .Width = 20


                    .Text = “_”


                Else


                    .Visible = False


                End If


            End With


        Next


        Me.nSolved = Me.nWordLen     ‘ track # of solved letters


        Me.nWrongLetters = 0


        Me.ShowStatus()


    End Sub


    Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress


        Select Case e.KeyChar


            Case Chr(27)


                End


            Case Else


                Dim cchr As Char = Char.ToLower(e.KeyChar)


                If Char.IsLetter(cchr) Then


                    Dim fGotone As Boolean = False


                    For i As Integer = 0 To Me.nWordLen – 1


                        If Me.cWord.Substring(i, 1) = cchr And _


                          “_” = Me.aLabels(i).Text Then


                            fGotone = True


                            Me.aLabels(i).Text = cchr


                            Me.nSolved = Me.nSolved – 1


                            If Me.nSolved = 0 Then   ‘ solved it!


                                Me.nTotalWords = Me.nTotalWords + 1


                                Me.nTotalWrong = Me.nTotalWrong + Me.nWrongLetters


                                Me.Play()


                                Return


                            End If


                        End If


                    Next


                    If Not fGotone Then


                        Me.nWrongLetters = Me.nWrongLetters + 1


                    End If


                    Me.ShowStatus()


                End If


        End Select


    End Sub


    Sub ShowStatus()


        Dim cString As String = “”


        cString = cString + Chr(13) + ” # of Wrong Letters = “ & Me.nWrongLetters


                 cString=cString+Me.cWord+” “  && Cheat!


        If Not Me.cPriorWord = “” Then


            cString = cString + Chr(13) + “Prior word = ‘” + Me.cPriorWord + “‘”


            cString = cString + Chr(13) + “Average # of wrong guesses is “ & _


             String.Format(“{0:###.##}”, Me.nTotalWrong / Me.nTotalWords) & ” for “ & _


            Me.nTotalWords & ” words”


        End If


        Me.oLblStatus.Text = cString


 


    End Sub


    Class MyLabel


        Inherits Label


        Sub New()


            Me.Font = New Font(“Courier New”, 14, FontStyle.Bold)


            Width = 20


            Height = 30


 


        End Sub


    End Class


 


    Private Sub Form1_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown


        Me.Play()


    End Sub


End Class


 

Comments (7)

  1. Koen Piller says:

    Calvin,

    great stuff, like the other word related topics you have posted.

    Could you now next reveal how you managed your dictionary.dll and the anagram function?

    Thanks for replying,

    Koen

  2. meghan says:

    this is awsome ……..i think

  3. Foxis Thebest says:

    This is cool…

    Would it be possible to make the dll into an fll?

    If so, would u be willing to post the code so we can convert it?

  4. STUART BROWN says:

    Can you please tell me where i go to get a dictionary to use in-game?

    I am writing a word game in VB, and just want a list of words + meanings, that i can open with a commondialog box as text.

    I.E

    Open c:mydict etc..

     Write #1,DictWord(n)

     Write #1,DictMean(n)

    CLOSE #1

    I can’t find any one the net with meanings.I have one thats got 120,000 words in and some crap aswell!, but with a simple program i got rid of the crap and duplicates.

    I did REGSVR32 DICT.DLL and it said it did something? What exactly please? and how do i use it?

    Thanks for your time.

  5. Parlimantary democracy says:

    blah blah blah blah yada i ming

  6. I was using a program that was yet another TLA and I wanted to create a mnemonic to help me remember

  7. Several years ago, my wife and I were walking through a local shopping mall. At the time, there was some