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