Subscribe to Jupiter 2's Blog        RSS Feed
-----

Code for Hangman.xls

Icon Leave Comment
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

 

July 2014

S M T W T F S
  12345
6789101112
13141516171819
2021 22 23242526
2728293031  

Tags

    Recent Entries

    Search My Blog

    0 user(s) viewing

    0 Guests
    0 member(s)
    0 anonymous member(s)