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
Anonymous
October 10, 2006
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, KoenAnonymous
November 05, 2006
this is awsome ........i thinkAnonymous
November 06, 2006
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?Anonymous
January 01, 2007
The comment has been removedAnonymous
January 09, 2007
blah blah blah blah yada i mingAnonymous
June 06, 2008
I was using a program that was yet another TLA and I wanted to create a mnemonic to help me rememberAnonymous
February 27, 2009
Several years ago, my wife and I were walking through a local shopping mall. At the time, there was some