Adam Asmaca Oyunu

 
Option Explicit
Dim Word As String
Dim Letter1 As String
Dim Letter2 As String
Dim Letter3 As String
Dim Letter4 As String
Dim Letter5 As String
Dim Letter6 As String
Dim Letter7 As String
Dim Letter8 As String
Dim Letter9 As String
Dim Letter10 As String
Dim Letter11 As String
Dim Hangs As Integer
Dim Wins As Integer
Dim Miss As Integer

Private Sub cmdExit_Click()
'Exit Hangman Program
End

End Sub

Private Sub cmdLetter_Click(Index As Integer)
cmdLetter(Index).Enabled = False
Dim Guess As String
'Find Letter guessed
'-------------------------------
Select Case Index
Case 0
Guess = "a"
Case 1
Guess = "b"
Case 2
Guess = "c"
Case 3
Guess = "d"
Case 4
Guess = "e"
Case 5
Guess = "f"
Case 6
Guess = "m"
Case 7
Guess = "n"
Case 8
Guess = "o"
Case 9
Guess = "p"
Case 10
Guess = "q"
Case 11
Guess = "r"
Case 12
Guess = "g"
Case 13
Guess = "h"
Case 14
Guess = "i"
Case 15
Guess = "j"
Case 16
Guess = "k"
Case 17
Guess = "l"
Case 18
Guess = "s"
Case 19
Guess = "t"
Case 20
Guess = "u"
Case 21
Guess = "v"
Case 22
Guess = "w"
Case 23
Guess = "x"
Case 24
Guess = "y"
Case 25
Guess = "z"
End Select
'------------------------
'find any matches
Match (Guess)
Hang
Winner

End Sub

Private Sub cmdNew_Click()
'Enable All Guesses, misses = 0
Miss = 0
Hang
Dim Index As Integer
Index = cmdLetter(Index).Index
For Index = 0 To cmdLetter.Count - 1
cmdLetter(Index).Enabled = True
Next Index
'--------------------
FindWord
WordLength
'Clear previous letters
lbl(0).Caption = ""
lbl(1).Caption = ""
lbl(2).Caption = ""
lbl(3).Caption = ""
lbl(4).Caption = ""
lbl(5).Caption = ""
lbl(6).Caption = ""
lbl(7).Caption = ""
lbl(8).Caption = ""
lbl(9).Caption = ""
lbl(10).Caption = ""

End Sub

Private Sub Form_Load()
'Program Info and First Word Selection
MsgBox "Hangman V1.0 By SnapperTech Design", vbInformation, "Start"
Call cmdNew_Click

End Sub

Public Sub FindWord()
'Find Word for Play
Dim Result As Integer
'Number of Words to ramndomize-----------------------
Randomize
Result = Int(70 * Rnd + 1)
'=====================================================
'Words Availiable
Select Case Result
Case 1
Word = "program"
lblCategory.Caption = "Computers"
lblHint.Caption = "Instructions"
lblCategory.Caption = "Computers"
lblHint.Caption = "Instructions"
Case 2
Word = "snappertech"
lblCategory.Caption = "Computers"
lblHint.Caption = "Company"
Case 3
Word = "moniter"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 4
Word = "scanner"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 5
Word = "mouse"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 6
Word = "modem"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 7
Word = "tower"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 8
Word = "keyboard"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 9
Word = "proccessor"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 10
Word = "microsoft"
lblCategory.Caption = "Computers"
lblHint.Caption = "Company"
Case 11
Word = "internet"
lblCategory.Caption = "Computers"
lblHint.Caption = "Technology"
Case 12
Word = "printer"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 13
Word = "windows"
lblCategory.Caption = "Computers"
lblHint.Caption = "Operating System"
Case 14
Word = "linux"
lblCategory.Caption = "Computers"
lblHint.Caption = "Operating System"
Case 15
Word = "compaq"
lblCategory.Caption = "Computers"
lblHint.Caption = "Manufacturer"
Case 16
Word = "gateway"
lblCategory.Caption = "Computers"
lblHint.Caption = "Manufacturer"
Case 17
Word = "lexmark"
lblCategory.Caption = "Computers"
lblHint.Caption = "Manufacturer"
Case 18
Word = "emachines"
lblCategory.Caption = "Computers"
lblHint.Caption = "Manufacturer"
Case 19
Word = "database"
lblCategory.Caption = "Computers"
lblHint.Caption = "Information"
Case 19
Word = "spreadsheet"
lblCategory.Caption = "Computers"
lblHint.Caption = "Information"
Case 20
Word = "webcam"
lblCategory.Caption = "Computers"
lblHint.Caption = "Hardware"
Case 21
Word = "pencil"
lblCategory.Caption = "School"
lblHint.Caption = "Supplies"
Case 22
Word = "notebook"
lblCategory.Caption = "School"
lblHint.Caption = "Supplies"
Case 23
Word = "backpack"
lblCategory.Caption = "School"
lblHint.Caption = "Supplies"
Case 24
Word = "dodge"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 25
Word = "chysler"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 26
Word = "plymouth"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 27
Word = "porshe"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 28
Word = "saturn"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 29
Word = "mitsubishi"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 30
Word = "toyota"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 31
Word = "lincoln"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 32
Word = "oldsmobile"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 33
Word = "avenger"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 34
Word = "skylark"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 35
Word = "navigator"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 36
Word = "chevrolet"
lblCategory.Caption = "Cars"
lblHint.Caption = "Make"
Case 37
Word = "avalanche"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 38
Word = "chevelle"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 39
Word = "mustang"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 40
Word = "camero"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 41
Word = "stealth"
lblCategory.Caption = "Cars"
lblHint.Caption = "Model"
Case 42
Word = "stalin"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 43
Word = "hitler"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 44
Word = "rommel"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 45
Word = "patten"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 46
Word = "eisenhower"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 47
Word = "hussein"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 48
Word = "lennon"
lblCategory.Caption = "wars"
lblHint.Caption = "Leaders"
Case 49
Word = "polaris"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Make"
Case 50
Word = "yamaha"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Make"
Case 51
Word = "cannondale"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Make"
Case 52
Word = "bombadier"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Make"
Case 53
Word = "honda"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Make"
Case 54
Word = "recon"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Model"
Case 55
Word = "grizzly"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Model"
Case 56
Word = "sportsman"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Model"
Case 57
Word = "raptor"
lblCategory.Caption = "4-Wheelers"
lblHint.Caption = "Model"
Case 58
Word = "kariya"
lblCategory.Caption = "Sports"
lblHint.Caption = "Hockey"
Case 58
Word = "federov"
lblCategory.Caption = "Sports"
lblHint.Caption = "Hockey"
Case 59
Word = "stevens"
lblCategory.Caption = "Sports"
lblHint.Caption = "Hockey"
Case 60
Word = "broduer"
lblCategory.Caption = "Sports"
lblHint.Caption = "Hockey"
Case 61
Word = "gomez"
lblCategory.Caption = "Sports"
lblHint.Caption = "Hockey"
Case 62
Word = "barnaby"
lblCategory.Caption = "Sports"
lblHint.Caption = "Hockey"
Case 63
Word = "marlin"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 64
Word = "martin"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 65
Word = "stewart"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 66
Word = "kenseth"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 67
Word = "andretti"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 68
Word = "newman"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 69
Word = "waltrip"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"
Case 70
Word = "wallace"
lblCategory.Caption = "Sports"
lblHint.Caption = "Racing"

End Select
Letter1 = Mid(Word, 1, 1)
Letter2 = Mid(Word, 2, 1)
Letter3 = Mid(Word, 3, 1)
Letter4 = Mid(Word, 4, 1)
Letter5 = Mid(Word, 5, 1)
Letter6 = Mid(Word, 6, 1)
Letter7 = Mid(Word, 7, 1)
Letter8 = Mid(Word, 8, 1)
Letter9 = Mid(Word, 9, 1)
Letter10 = Mid(Word, 10, 1)
Letter11 = Mid(Word, 11, 1)
'=====================================================

End Sub

Private Sub WordLength()
Dim Length As Integer
Length = Len(Word)
'================================
'Show letters for length

lbl(0).Visible = False
lbl(1).Visible = False
lbl(2).Visible = False
lbl(3).Visible = False
lbl(4).Visible = False
lbl(5).Visible = False
lbl(6).Visible = False
lbl(7).Visible = False
lbl(8).Visible = False
lbl(9).Visible = False
lbl(10).Visible = False
Select Case Length
Case 1
lbl(0).Visible = True
Case 2
lbl(0).Visible = True
lbl(1).Visible = True
Case 3
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
Case 4
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
Case 5
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
Case 6
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
lbl(5).Visible = True
Case 7
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
lbl(5).Visible = True
lbl(6).Visible = True
Case 8
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
lbl(5).Visible = True
lbl(6).Visible = True
lbl(7).Visible = True
Case 9
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
lbl(5).Visible = True
lbl(6).Visible = True
lbl(7).Visible = True
lbl(8).Visible = True
Case 10
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
lbl(5).Visible = True
lbl(6).Visible = True
lbl(7).Visible = True
lbl(8).Visible = True
lbl(9).Visible = True
Case 11
lbl(0).Visible = True
lbl(1).Visible = True
lbl(2).Visible = True
lbl(3).Visible = True
lbl(4).Visible = True
lbl(5).Visible = True
lbl(6).Visible = True
lbl(7).Visible = True
lbl(8).Visible = True
lbl(9).Visible = True
lbl(10).Visible = True
End Select

End Sub

Public Sub Match(Guess)
'dispaly matches
Dim Strike As Integer
Strike = 0
If Guess = Letter1 Then
lbl(0).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter2 Then
lbl(1).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter3 Then
lbl(2).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter4 Then
lbl(3).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter5 Then
lbl(4).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter6 Then
lbl(5).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter7 Then
lbl(6).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter8 Then
lbl(7).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter9 Then
lbl(8).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter10 Then
lbl(9).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
If Guess = Letter11 Then
lbl(10).Caption = UCase(Guess)
Else
Strike = Strike + 1
End If
'==========================================
'Total miss, hang
If Strike = 11 Then
Miss = Miss + 1
End If


End Sub

Public Sub Winner()
Dim lettermatch1 As Boolean
Dim lettermatch2 As Boolean
Dim lettermatch3 As Boolean
Dim lettermatch4 As Boolean
Dim lettermatch5 As Boolean
Dim lettermatch6 As Boolean
Dim lettermatch7 As Boolean
Dim lettermatch8 As Boolean
Dim lettermatch9 As Boolean
Dim lettermatch10 As Boolean
Dim lettermatch11 As Boolean
Dim Win As Boolean
'Check Matches
'------------------------------------
If Not lbl(0).Caption = "" Or lbl(0).Visible = False Then
lettermatch1 = True
End If
If Not lbl(1).Caption = "" Or lbl(1).Visible = False Then
lettermatch2 = True
End If
If Not lbl(2).Caption = "" Or lbl(2).Visible = False Then
lettermatch3 = True
End If
If Not lbl(3).Caption = "" Or lbl(3).Visible = False Then
lettermatch4 = True
End If
If Not lbl(4).Caption = "" Or lbl(4).Visible = False Then
lettermatch5 = True
End If
If Not lbl(5).Caption = "" Or lbl(5).Visible = False Then
lettermatch6 = True
End If
If Not lbl(6).Caption = "" Or lbl(6).Visible = False Then
lettermatch7 = True
End If
If Not lbl(7).Caption = "" Or lbl(7).Visible = False Then
lettermatch8 = True
End If
If Not lbl(8).Caption = "" Or lbl(8).Visible = False Then
lettermatch9 = True
End If
If Not lbl(9).Caption = "" Or lbl(9).Visible = False Then
lettermatch10 = True
End If
If Not lbl(10).Caption = "" Or lbl(10).Visible = False Then
lettermatch11 = True
End If
'-------------------------
'Find Win
If lettermatch1 = True And lettermatch2 = True _
And lettermatch3 = True And lettermatch4 = True _
And lettermatch5 = True And lettermatch6 = True _
And lettermatch7 = True And lettermatch8 = True _
And lettermatch9 = True And lettermatch10 = True _
And lettermatch11 = True Then
Win = True
End If
If Win = True Then
MsgBox "Congradulations, You are a winner!", vbExclamation, "Winner!"
Wins = Val(lblWins.Caption) + 1
lblWins.Caption = Wins
Call cmdNew_Click
End If


End Sub


Public Sub Hang()
'display correct picture for # of misses
Select Case Miss
Case 0
img1.Visible = True
img2.Visible = False
img3.Visible = False
img4.Visible = False
img5.Visible = False
img6.Visible = False
img7.Visible = False
Case 1
img1.Visible = False
img2.Visible = True
img3.Visible = False
img4.Visible = False
img5.Visible = False
img6.Visible = False
img7.Visible = False
Case 2
img1.Visible = False
img2.Visible = False
img3.Visible = True
img4.Visible = False
img5.Visible = False
img6.Visible = False
img7.Visible = False
Case 3
img1.Visible = False
img2.Visible = False
img3.Visible = False
img4.Visible = True
img5.Visible = False
img6.Visible = False
img7.Visible = False
Case 4
img1.Visible = False
img2.Visible = False
img3.Visible = False
img4.Visible = False
img5.Visible = True
img6.Visible = False
img7.Visible = False
Case 5
img1.Visible = False
img2.Visible = False
img3.Visible = False
img4.Visible = False
img5.Visible = False
img6.Visible = True
img7.Visible = False
Case 6
img1.Visible = False
img2.Visible = False
img3.Visible = False
img4.Visible = False
img5.Visible = False
img6.Visible = False
img7.Visible = True
Hangs = Hangs + 1
lblHangs.Caption = Hangs
MsgBox "You've Been Hanged. The Word Was " & Word, vbCritical, "Hanged"
Call cmdNew_Click
End Select
End Sub

Private Sub mnuExit_Click()

End

End Sub

Private Sub mnuNewg_Click()

Call cmdNew_Click
Hangs = 0
Wins = 0
Miss = 0
lblHangs.Caption = Hangs
lblWins.Caption = Wins

End Sub

Private Sub mnuNeww_Click()

Call cmdNew_Click

End Sub

Private Sub mnuProg_Click()

frmProg.Show

End Sub

 

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

adam asmaca oyunu