This is the code for "Hangman.xls"
Dim mvarLbL, mvarCmd As Object
Dim mintRandomHangmanWord As Integer
Dim blnWin As Boolean
Dim mintWidth, mintTop, mintLeft, mintHeight, mintEndNum, mintNum, mintCounter As Integer
Dim mstrWord, mstrLetter As String
Private Sub cmdEndProgram_Click()
End
End Sub
Private Sub cmdHelper_Click()
Dim strAx, strAy, strAw As String
strAx = "There are ten words in a preset list. The words are common to Excel Users. " & vbCrLf & _
"Click START to begin then RESET for each subsequent game. Click an option button Letter then click TRY SELECTED LETTER button to see if your " & _
"guess is correct. Each incorrect guess will show a body part. The quantity of incorrect guesses allowed " & _
"before you are HANGED is only eight."
strAy = "Written and designed by" & vbCrLf & _
"Mark E. Philpot" & vbCrLf & _
"http://www.geocities.com/excelmarksway"
strAw = "Wednesday, 15 February 2006"
MsgBox strAx & vbCrLf & vbCrLf & strAy & vbCrLf & vbCrLf & strAw, vbInformation, "Executioner"
End Sub
Private Sub cmdInsert_Click()
Dim strA, strB As String
Dim i, n As Integer
i = 0
n = 0
If lblHanged.Visible = True Then
MsgBox "You are hanged!", vbExclamation, "Executioner"
With fraWord
For i = 1 To Len(mstrWord)
strB = (Mid(mstrWord, i, 1))
.Controls.Item(i - 1).Caption = strB
Next
End With
blnWin = False
Exit Sub
End If
If blnWin = True Then
Exit Sub
End If
With fraAlphabet
For i = 0 To .Controls.Count
On Error Resume Next
If .Controls.Item(i).Value = True Then
lblUsed.Caption = lblUsed.Caption & " " & .Controls.Item(i).Caption
mstrLetter = .Controls.Item(i).Caption
.Controls.Item(i).Value = False
.Controls.Item(i).Visible = False
Exit For
Else
End If
Next
End With
If Len(mstrLetter) = 0 Then
MsgBox "Please Click an Option Button Letter!", vbExclamation, "Executioner"
Exit Sub
End If
For i = 1 To mintEndNum
strA = UCase(Mid(mstrWord, i, 1))
strB = UCase(mstrLetter)
If strA = strB Then
lstNums.AddItem i - 1
End If
Next
i = 0
With fraWord
If lstNums.ListCount > 0 Then
Do Until lstNums.ListCount = 0
mintNum = CInt(lstNums.List(i))
lstNums.RemoveItem (i)
.Controls.Item(mintNum).Caption = strB
mintCounter = mintCounter + 1
Loop
' mintCounter = mintCounter + 1
strA = ""
End If
End With
If mintCounter = mintEndNum Then
MsgBox "You Win!", vbExclamation, "Executioner"
blnWin = True
mintCounter = 0
Exit Sub
End If
If strA = "" Then
mstrLetter = ""
cmdInsert.Enabled = False
Exit Sub
End If
With fraMan
For i = 0 To .Controls.Count - 1
If .Controls.Item(i).Visible = False Then
If .Controls.Item(i).Name <> lblHanged Then
.Controls.Item(i).Visible = True
Exit For
End If
End If
Next
End With
cmdInsert.Enabled = False
mstrLetter = ""
End Sub
Private Sub cmdReset_Click()
Dim i, n As Integer
If cmdReset.Caption = "Start" Then
cmdReset.Caption = "Reset"
fraAlphabet.Enabled = True
End If
lstNums.Clear
mintWidth = 26
mintHeight = 18
mintLeft = 12
mintTop = 12
i = 0
n = 0
If blnWin = True Then
blnWin = False
End If
lblUsed.Caption = ""
mintCounter = 0
cmdInsert.Enabled = False
With fraMan
For i = 0 To .Controls.Count - 1
.Controls.Item(i).Visible = False
Next
End With
With fraAlphabet
If .Controls.Count > 0 Then
.Controls.Clear
End If
i = 0
Do
With fraAlphabet
Set mvarCmd = .Controls.Add("Forms.Optionbutton.1", "togBut", Visible = True)
mvarCmd.Width = mintWidth
mvarCmd.Height = mintHeight
mvarCmd.Left = mintLeft
mvarCmd.Top = mintTop
mintLeft = mintLeft + 6
n = n + 1
i = i + 1
mvarCmd.Caption = ""
mvarCmd.Value = False
mvarCmd.TextAlign = 2
mvarCmd.Font.Bold = True
mvarCmd.Font.Size = 12
mintLeft = mintLeft + 30
If n = 10 Then
mintTop = mintTop + 24
mintLeft = 12
n = 0
End If
End With
Loop Until i = 26
For i = 0 To .Controls.Count - 1
.Controls.Item(i).Caption = Chr(i + 65)
.Controls.Item(i).ControlTipText = Chr(i + 65)
Next
.Controls.Item(0).Value = True
mstrLetter = .Controls.Item(0).Caption
End With
With lstWords
.Clear
.AddItem "data"
.AddItem "row"
.AddItem "column"
.AddItem "function"
.AddItem "query"
.AddItem "userform"
.AddItem "cell"
.AddItem "selection"
.AddItem "format"
.AddItem "tools"
mintRandomHangmanWord = .ListCount
End With
With fraWord
If .Controls.Count > 0 Then
.Controls.Clear
End If
End With
cmdStart_Click
End Sub
'setup
Private Sub cmdStart_Click()
Dim n, i As Integer
Dim strWord As String
Dim MyValue
lstNums.Clear
Randomize ' Initialize random-number generator.
MyValue = Int((mintRandomHangmanWord * Rnd) + 1) - 1 ' Generate random value between 1 and 6.
mintTop = 12
mintLeft = 12
n = 0
mstrWord = lstWords.List(MyValue)
mintEndNum = Len(mstrWord)
lblEndNum = mintEndNum
lblWord = mstrWord
Do
With fraWord
Set mvarLbL = .Controls.Add("Forms.Label.1", "lblNum", Visible = True)
mvarLbL.Width = mintWidth
mvarLbL.Height = mintHeight
mvarLbL.Left = mintLeft
mvarLbL.Top = mintTop
mintLeft = mintLeft + 6
n = n + 1
mvarLbL.Caption = ""
mvarLbL.TextAlign = 2
mvarLbL.Font.Bold = True
mvarLbL.Font.Size = 12
mvarLbL.BorderStyle = 1
If n >= mintEndNum Then
Exit Do
End If
mintLeft = mintLeft + 20
End With
Loop Until n >= mintEndNum
With lstWords
.RemoveItem (MyValue)
mintRandomHangmanWord = .ListCount
End With
mintLeft = 6
mintTop = 12
n = 0
End Sub
Private Sub fraAlphabet_AddControl(ByVal Control As MSForms.Control)
End Sub
Private Sub fraAlphabet_Click()
End Sub
Private Sub fraAlphabet_Enter()
Dim ix As Integer
cmdInsert.Enabled = True
End Sub
Private Sub fraAlphabet_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cmdInsert.Enabled = True
Cancel = False
End Sub
Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
End Sub
'24 x 18 move + 30
'left 6 top 12
Private Sub UserForm_Initialize()
Dim i As Integer
blnWin = False
mintWidth = 18
mintHeight = 24
mintLeft = 6
mintTop = 12
mintCounter = 0
mintEndNum = -1
cmdReset_Click
cmdReset.Caption = "Start"
fraAlphabet.Enabled = False
End Sub
0 Comments On This Entry
Tags
My Blog Links
Recent Entries
-
Code for Hangman.xlson Jan 20 2010 05:26 AM
Search My Blog
0 user(s) viewing
0 Guests
0 member(s)
0 anonymous member(s)
0 member(s)
0 anonymous member(s)
|
|



Leave Comment









|