webmaster
 
Cevapla
10-08-2012 14:25:26
 

Adam Asmaca Oyunu

Kod:
	
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 = "+++++dier"
        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

Bir önceki yazı Access'ten Excel'e Veri Aktarımı hakkında bilgi vermektedir.

Cevapla

"Adam Asmaca Oyunu" konusu hakkında etiketler
adam asmaca oyunlari oyunu

Access'ten Excel'e Veri Aktarımı Önceki | Sonraki ADO İle Veritabanı




Saat: 18:09 - Webmaster Forumu - Rss - Arşiv
İletişim Bilgileri, Contact Us, Kullanım Sözleşmesi, Gizlilik