IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  digitalpanel

Etiketlenen Kullanıcılar

Yeni Konu aç Cevapla
 
LinkBack Seçenekler Stil
Alt 19 Temmuz 2008, 16:51   #1
Çevrimdışı
Yardımcı Admin
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
Adam Asmaca Oyunu




alıntı

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
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 Guessesmisses 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 " WordvbCritical"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 


__________________
[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]

[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]
 
Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
sohbet odaları eglen sohbet sohbet
Cevapla

Etiketler
adam, asmaca, oyunu


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
2 kişilik Adam Asmaca aSi C ve C++ 1 27 Şubat 2012 18:30
Adam Asmaca Oyunu. KuLs Visual Basic 2 21 Şubat 2012 10:30
Adam Asmaca YapraK Oyun Dünyasından Son Haberler 0 20 Şubat 2010 04:25
Java (AWT) ile Adam Asmaca Oyunu Cheki Java 0 04 Temmuz 2006 11:05