Hi,
I've attempted to make a simple hangman game and it went kinda of okay. However, I've ran into two hiccups, which I cant seem to solve. Before I go on outlining my problem, I'll say I have basic knowledge, but I am pretty comfortable in areas like, sub routines, functions, arrays, loops, string manipulation among the basics. Now that's out of the way, I present my two problems.
So those are my two problems, and I'm hoping to get them resolved here. Any help is appreciated. Code is below.
Oh, and here is a picture of what I've got setup! http://gyazo.com/d22cc36c43689ad7971c3c1503db1b13
The word is 'The Simpsons' That should give you an idea of how it is taken incorrect lives away.
I've attempted to make a simple hangman game and it went kinda of okay. However, I've ran into two hiccups, which I cant seem to solve. Before I go on outlining my problem, I'll say I have basic knowledge, but I am pretty comfortable in areas like, sub routines, functions, arrays, loops, string manipulation among the basics. Now that's out of the way, I present my two problems.
- Obviously, in Hangman you only get a certain amount of lives. I've managed to make the 'frame and hangman bits and pieces' appear when lives are deducted but I can't seem to be able to distinguish between correct letters and incorrect letters, a life will decrease regardless and I'm not sure why.
- The other problem is that I'm not sure when to call my 'Win' sub-routine when the player has succesfully guessed all the letters correctly. There doesnt seem to be a right place to call it. This is probably down to my beginner coding and for lack of a better word, rubbish system of checking if a letter is correct.
So those are my two problems, and I'm hoping to get them resolved here. Any help is appreciated. Code is below.
Code:
Option Explicit
'Gets set from the command button arrays
Dim Char_To_Search As String
'Each character of current word is in here
Dim Current_Word_CharArr() As String
'The hangman word
Dim Current_Word As String
'Used to Count Seconds
Dim Elapsed_Seconds As Integer
'Used to Count Minutes
Dim Elapsed_Minutes As Integer
'Used to count remaining lives before the man is hung
Dim Lives_Remaining As Integer
'String for the used letters which the user has clicked
Dim Used_Letters As String
Sub Form_Load()
Start_Game
End Sub
Sub Start_Game()
'Changes all hangmen frame parts to not visible. Still thinking of a more efficent way.
Call Change_Parts("Frame_Bottom_Base", True)
Call Change_Parts("Frame_Bottom_Verticle", True)
Call Change_Parts("Frame_Verticle", False)
Call Change_Parts("Frame_Top", False)
Call Change_Parts("Rope", False)
Call Change_Parts("Head", False)
Call Change_Parts("Body", False)
Call Change_Parts("Left_Arm", False)
Call Change_Parts("Right_Arm", False)
Call Change_Parts("Left_Leg", False)
Call Change_Parts("Right_Leg", False)
'Loop indexes
Dim x As Integer
Dim i As Integer
'Resets the lives
Lives_Remaining = 9
'Resets the timer to 0
Elapsed_Minutes = 0
Elapsed_Seconds = 0
'Resets the used characters
Used_Letters = ""
'Resets the current word
Current_Word = ""
'Takes a word for the hangman from the user and converts it to Lcase to case issues during runtime.
Current_Word = LCase(InputBox("enter a word"))
'Declaring agian so I avoid using a constant
ReDim Current_Word_CharArr(Len(Current_Word))
'Turns the characters from the word into an array. Ubound = max index of the array
For x = 1 To UBound(Current_Word_CharArr)
Current_Word_CharArr(x) = Mid$(Current_Word, x, 1)
Next
'Fills the labels with a character from the array, then blacks out the black. Ubound = max index of the array
For i = 1 To UBound(Current_Word_CharArr())
Char_Pos(i).Caption = Current_Word_CharArr(i)
'Changes the label to a black colour making it not visible
Char_Pos(i).BackColor = &H80000007
Next
End Sub
Sub Win_Game()
'Used to decide if the player wants to play again or not
Dim Play_Again As String
Play_Again = LCase(InputBox("You have won! And luckily, the boy hasn't been hung.(Play Again(""Yes/No""))"))
If (Play_Again = "yes") Then
'Calls form load, which calls start game again
Call Form_Load
ElseIf (Play_Again = "no") Then
'Exits the game
End
Else
MsgBox ("You have entered something incorrect, now restarting the game regardless your choice.")
'Calls form load, which calls start game again
Call Form_Load
End If
End Sub
Sub End_Game()
'Used to decide if the player wants to play again or not
Dim Play_Again As String
Play_Again = LCase(InputBox("You have lost! And sadly, the boy has been hung. Maybe you can save him next time? (Try Again(""Yes/No""))"))
If (Play_Again = "yes") Then
'Calls form load, which calls start game again
Call Form_Load
ElseIf (Play_Again = "no") Then
'Exits the game
End
Else
MsgBox ("You have entered something incorrect, now restarting the game regardless your choice.")
'Calls form load, which calls start game again
Call Form_Load
End If
End Sub
Sub Elapsed_Time_Timer()
'Adds one second
Elapsed_Seconds = Elapsed_Seconds + 1
'Checks for when minutes occur, then resets the second counter and increases the minute by one
If (Elapsed_Seconds = 60) Then
Elapsed_Minutes = Elapsed_Minutes + 1
Elapsed_Seconds = 0
End If
'Displays the label as "Elapsed Time: Elapsed Minutes:Elapsed Seconds"
Elapsed_Time_Label.Caption = "Elapsed Time: " & Elapsed_Minutes & ":" & Elapsed_Seconds
End Sub
Sub Game_Loop_Timer()
Lives_Label.Caption = "Lives Remaining: " & Lives_Remaining
Used_Letters_Label.Caption = Used_Letters
Select Case Lives_Remaining:
Case 8:
Call Change_Parts("Frame_Verticle", True)
Case 7:
Call Change_Parts("Frame_Top", True)
Case 6:
Call Change_Parts("Rope", True)
Case 5:
Call Change_Parts("Head", True)
Case 4:
Call Change_Parts("Body", True)
Case 3:
Call Change_Parts("Left_Arm", True)
Case 2:
Call Change_Parts("Right_Arm", True)
Case 1:
Call Change_Parts("Left_Leg", True)
Case 0:
Call Change_Parts("Right_Leg", True)
Call End_Game
End Select
End Sub
Function Change_Parts(Part As String, Is_Visible As Boolean)
Select Case Part
Case Is = "Frame_Bottom_Base":
Frame_Bottom_Base.Visible = Is_Visible
Case Is = "Frame_Bottom_Verticle":
Frame_Bottom_Verticle.Visible = Is_Visible
Case Is = "Frame_Verticle":
Frame_Verticle.Visible = Is_Visible
Case Is = "Frame_Top":
Frame_Top.Visible = Is_Visible
Case Is = "Rope":
Rope.Visible = Is_Visible
Case Is = "Head":
Head.Visible = Is_Visible
Case Is = "Body":
Body.Visible = Is_Visible
Case Is = "Left_Arm":
Left_Arm.Visible = Is_Visible
Case Is = "Right_Arm":
Right_Arm.Visible = Is_Visible
Case Is = "Left_Leg":
Left_Leg.Visible = Is_Visible
Case Is = "Right_Leg":
Right_Leg.Visible = Is_Visible
Case Else:
Print ("error, invalid part. Damnit Ben, fix this bug")
End Select
End Function
Private Sub Command1_Click(Index As Integer)
'Loop index
Dim i As Integer
Dim x As Integer
'switching between the button indexs and setting the appropaite value
Select Case Index:
Case 0:
Char_To_Search = " "
Used_Letters = Used_Letters & " ,"
Case 1:
Char_To_Search = "w"
Used_Letters = Used_Letters & "w,"
Case 2:
Char_To_Search = "e"
Used_Letters = Used_Letters & "e,"
Case 3:
Char_To_Search = "r"
Used_Letters = Used_Letters & "r,"
Case 4:
Char_To_Search = "t"
Used_Letters = Used_Letters & "t,"
Case 5:
Char_To_Search = "y"
Used_Letters = Used_Letters & "y,"
Case 6:
Char_To_Search = "u"
Used_Letters = Used_Letters & "u,"
Case 7:
Char_To_Search = "i"
Used_Letters = Used_Letters & "i,"
Case 8:
Char_To_Search = "o"
Used_Letters = Used_Letters & "o,"
Case 9:
Char_To_Search = "p"
Used_Letters = Used_Letters & "p,"
Case 10:
Char_To_Search = "a"
Used_Letters = Used_Letters & "a,"
Case 11:
Char_To_Search = "s"
Used_Letters = Used_Letters & "s,"
Case 12:
Char_To_Search = "d"
Used_Letters = Used_Letters & "d,"
Case 13:
Char_To_Search = "f"
Used_Letters = Used_Letters & "f,"
Case 14:
Char_To_Search = "g"
Used_Letters = Used_Letters & "g,"
Case 15:
Char_To_Search = "h"
Used_Letters = Used_Letters & "h,"
Case 16:
Char_To_Search = "j"
Used_Letters = Used_Letters & "j,"
Case 17:
Char_To_Search = "k"
Used_Letters = Used_Letters & "k,"
Case 18:
Char_To_Search = "l"
Used_Letters = Used_Letters & "l,"
Case 19:
Char_To_Search = "z"
Used_Letters = Used_Letters & "z,"
Case 20:
Char_To_Search = "x"
Used_Letters = Used_Letters & "x,"
Case 21:
Char_To_Search = "c"
Used_Letters = Used_Letters & "c,"
Case 22:
Char_To_Search = "v"
Used_Letters = Used_Letters & "v,"
Case 23:
Char_To_Search = "b"
Used_Letters = Used_Letters & "b,"
Case 24:
Char_To_Search = "n"
Used_Letters = Used_Letters & "n,"
Case 25:
Char_To_Search = "m"
Used_Letters = Used_Letters & "m,"
Case 27:
Char_To_Search = "q"
Used_Letters = Used_Letters & "q,"
End Select
'Searchs the current 'Char_To_Search' in all the labels, if found it makes the label visible
For i = 1 To UBound(Current_Word_CharArr)
If (Char_To_Search = Char_Pos(i)) Then
Char_Pos(i).BackColor = &H80000004
End If
Next
'What I tried to remove lives if character are incorrect.
If (Char_To_Search <> Current_Word_CharArr(x)) Then Lives_Remaining = Lives_Remaining - 1
End Sub
Private Sub Button_Functions_Click(Index As Integer)
Dim Word_Attempt As String
Dim Try_Again As String
Dim Should_Exit As String
Select Case Index:
Case 0:
Word_Attempt = LCase(InputBox("Enter the word you think it is"))
If (Word_Attempt = Current_Word) Then
'Calls the win function
Call Win_Game
Else
Try_Again = LCase(InputBox("Sorry, that is incorrect. Type ""Yes"" if you want to try again, else type ""No"" "))
If (Try_Again = "yes") Then
'Call thes button click sub agian.
Button_Functions_Click (0)
ElseIf (Try_Again = "no") Then
'Exits the button click sub
Exit Sub
Else
MsgBox ("You have entered something incorrect, now exiting you of regardless your choice.")
'Exits the button click sub
Exit Sub
End If
End If
Case 1:
Should_Exit = LCase(InputBox("Are you sure you want to exit? (""Yes/No"") "))
If (Should_Exit = "yes") Then
'Exits the game
End
ElseIf (Should_Exit = "no") Then
'Exits the button click sub
Exit Sub
Else
MsgBox ("You have entered something incorrect, now exiting you of regardless your choice.")
'Exits the game
End
End If
End Select
End SubThe word is 'The Simpsons' That should give you an idea of how it is taken incorrect lives away.