Option Compare Database
Private strWord As String
Private strLetter As String
Private intWordLength As Integer
Private intLettersGot As Integer
Private intHangman As Integer
Private intPoints As Integer
Private colLetters As Collection
Private Function ClickLetter()
Dim ctrl As Access.CommandButton
Set ctrl = Me.ActiveControl
strLetter = Right(ctrl.Caption, 1)
cmdReset.SetFocus
ctrl.Enabled = False
Call CheckLetter
End Function
Private Sub cmdCheck_Click()
Dim tempLetter As String
If Trim(Me.txtLetter & " ") <> "" Then
tempLetter = Left(Me.txtLetter, 1)
If (Asc(tempLetter) > 64 And Asc(tempLetter) < 98) Or (Asc(tempLetter) > 96 And Asc(tempLetter) < 123) Then
strLetter = tempLetter
Me.txtLetter = tempLetter
If VerifyLetter(tempLetter) Then
Call CheckLetter
Else
MsgBox "Letter already used", vbInformation
End If
End If
End If
Me.txtLetter.SetFocus
Me.txtLetter.Text = ""
Me.txtLetter = Null
End Sub
Public Function VerifyLetter(tempLetter As String) As Boolean
'do it the lazy way
Dim i As Integer
For i = 1 To colLetters.Count
If colLetters(i) = tempLetter Then Exit Function
Next i
VerifyLetter = True
colLetters.Add (tempLetter)
End Function
Private Sub cmdReset_Click()
'Start new game
NewGame
intPoints = 0
lblPoints.Caption = "Points : " & intPoints
End Sub
Private Sub Form_Load()
If Not Trim(Me.OpenArgs & " ") = "" Then
strWord = Me.OpenArgs
NewGame
End If
End Sub
Private Sub CheckLetter()
On Error GoTo ErrorHandler
'Checks the letter entered against the random word
Dim i As Integer
Dim booGotLetter As Boolean
Dim id As String
booGotLetter = False
Dim strSingleLetter As String
'Go through the selected word
For i = 1 To intWordLength
'Get letter from word
strSingleLetter = Right(Left(strWord, i), 1)
'Check if selected letter is same as letter in word
If strLetter = strSingleLetter Then
'Increment got letters count
intLettersGot = intLettersGot + 1
booGotLetter = True
'Place the letter on the board
If i < 10 Then
id = "0" & i
Else
id = CStr(i)
End If
Me.Controls("lblLetter" & id).Caption = strLetter
End If
Next i
'Check if the user got the whole word finished
If intLettersGot = intWordLength Then
'They have completed the word
intPoints = intPoints + intHangman
lblPoints.Caption = "Points : " & intPoints
If MsgBox("Well done, you have beaten the hangman!" & vbCrLf & vbCrLf & _
"Would you like another go?", vbYesNo, "Congratulations") = vbYes Then
'User wants another go
NewGame
Else
'Close form
DoCmd.Close acForm, "frmHangman"
End If
End If
'Check if the user got a letter
If booGotLetter = False Then
'Didn't get a letter
intHangman = intHangman - 1
End If
'Update screen details
lblTries.Caption = "Tries Remaining : " & intHangman
HideBody
head.Visible = (intHangman = 9)
body.Visible = (intHangman = 8)
right_arm.Visible = (intHangman = 7)
left_arm.Visible = (intHangman = 6)
right_leg.Visible = (intHangman = 5)
left_leg.Visible = (intHangman = 4)
right_hand.Visible = (intHangman = 3)
left_hand.Visible = (intHangman = 2)
right_foot.Visible = (intHangman = 1)
'Check if the game is over!
If intHangman = 0 Then
'Game over
intPoints = intPoints - 10
If intPoints < 1 Then intPoints = 0
lblPoints.Caption = "Points : " & intPoints
hung.Visible = True
If MsgBox("Sorry, you did not get the word!" & vbCrLf & vbCrLf & _
"Would you like to try again?", vbYesNo, "Unlucky!") = vbYes Then
'New game
NewGame
Exit Sub
Else
'Quit
DoCmd.Close acForm, "frmHangman"
Exit Sub
End If
End If
Exit Sub
ErrorHandler:
'Close the form
DoCmd.Close acForm, "frmHangman"
End Sub
Private Sub NewGame()
'Set variables and screen for a new game
'SelectWord
'Reset all the command buttons
Set colLetters = New Collection
' EnableCommands
'Hide body
HideBody
'Reset letters got
ResetLetters
intLettersGot = 0
intHangman = 10
lblTries.Caption = "Tries Remaining : " & intHangman
End Sub
Public Sub HideBody()
Dim ctrl As Access.Control
For Each ctrl In Me.Controls
If ctrl.Tag = "Body" Then
ctrl.Visible = False
End If
Next ctrl
End Sub
Public Sub ResetLetters()
Dim ctrl As Access.Control
Dim i As Integer
Dim id As String
intWordLength = Len(strWord)
For i = 1 To 16
If i < 10 Then
id = "0" & i
Else
id = CStr(i)
End If
Set ctrl = Me.Controls("lblLetter" & id)
ctrl.Caption = "_"
If i <= intWordLength Then
ctrl.Visible = True
Else
ctrl.Visible = False
End If
Next i
End Sub