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