adam asmaca oyunu(Hangman Game)

DOWLOAD LINK http://turbobit.net/i2ddhdnostop.html

Option Explicit
Dim kelime As String
Dim hata_sayisi As Integer
Dim varmi As Boolean
Dim p, a As Integer
'Program içerisinde herzaman kullanacağım değişkenleri tanımlıyorum


Private Sub buton_Click(Index As Integer)
'Butonu tıkladığım harfin seçilmiş olan kelimede olup olmadığını kontrol ediyorum.....
Dim kontrol As String
Dim k, a, j As Integer
varmi = False

For k = 1 To Len(kelime)
kontrol = Mid(kelime, k, 1)
If kontrol = buton(Index).Caption Then 'Bbasmış olduğum butonun harfi varmı,yok mu bunun kontrolünü yapıyorum.
yazimiz(k - 1).Caption = kontrol
varmi = True 'eğer harf var ise "varmi" değişkenini "True" değerini ektarıyorum.
End If
Next
If varmi = False Then
hata_sayisi = hata_sayisi + 1 'eğer harf yok ise yapmış olduğum hata sayısını buluyorum
ciz (hata_sayisi) 'çöp adamı çizmek içIn yazmış olduğum alt programı çağırıyorum
ElseIf varmi = True Then
Me.dogru_harf_sayisi.Caption = 1
For j = 1 To Len(kelime)
If yazimiz(j - 1).Caption = "_" Then
Me.dogru_harf_sayisi.Caption = Me.dogru_harf_sayisi.Caption + 1
End If
Next j
Me.dogru_harf_sayisi.Caption = Me.dogru_harf_sayisi.Caption - 1
End If
buton(Index).Enabled = False
Label2.Caption = ""
For a = 1 To Len(kelime)
Label2.Caption = Label2.Caption & " " & yazimiz(a - 1).Caption
Next a
'----------------------Çıkmayan Harf Varmı kontrolü--------------------------


If Me.dogru_harf_sayisi.Caption = 0 Then
MsgBox "KAZANDINIZ...", , "ADAM ASMACA"
yenioyun.Visible = True
exitbuton.Visible = True
End If
End Sub

Sub oyun_yukle()
On Local Error Resume Next
Dim i, harf_sayisi As Integer
Dim dogrula As Boolean
Me.Label2.BackStyle = 0
Me.Label2.Visible = True
Me.Label2.Caption = ""
Me.adami_sil
'-------------------Kelime Seç ve Kontrol yükle-----------------------
Randomize Timer
List1.ListIndex = Int((Rnd * List1.ListCount) + 1) 'Rasgele list1 In index numarasını seç
kelime = List1.Text 'seçmiş olduğum index'In Text özelliğini kelime değişkenine aktar
Me.dogru_harf_sayisi.Caption = Len(kelime) 'kelimenin harf sayısını bul
For i = 1 To Len(kelime) 'döngü oluştur ve harf sayısı kadar label yükle
Load yazimiz(i)
yazimiz(i).Left = yazimiz(i - 1).Left + 350
If Mid(kelime, i, 1) = " " Then 'kelime içerisinde boşluk var ise bunu da labelda göster
yazimiz(i - 1).Caption = " "
Else
yazimiz(i - 1).Caption = "_"
End If
Label2.Caption = Label2.Caption & " " & yazimiz(i - 1).Caption
Next i
hata_sayisi = 0
For i = 0 To 28 'yüklenen bütün butonların enabled özelliklerini True yap
buton(i).Enabled = True
Next i
End Sub
'-------------------------------Butonları Yükle-----------------------
Sub buton_yukle()
Dim i As Integer
For i = 1 To 28
Load buton(i)
buton(i).Visible = True
buton(i).Left = buton(i - 1).Left + 255
Next i
buton(0).Caption = "A"
buton(1).Caption = "B"
buton(2).Caption = "C"
buton(3).Caption = "Ç"
buton(4).Caption = "D"
buton(5).Caption = "E"
buton(6).Caption = "F"
buton(7).Caption = "G"
buton(8).Caption = "?"
buton(9).Caption = "H"
buton(10).Caption = "I"
buton(11).Caption = "İ"
buton(12).Caption = "J"
buton(13).Caption = "K"
buton(14).Caption = "L"
buton(15).Caption = "M"
buton(16).Caption = "N"
buton(17).Caption = "O"
buton(18).Caption = "Ö"
buton(19).Caption = "P"
buton(20).Caption = "R"
buton(21).Caption = "S"
buton(22).Caption = "Ş"
buton(23).Caption = "T"
buton(24).Caption = "U"
buton(25).Caption = "Ü"
buton(26).Caption = "V"
buton(27).Caption = "Y"
buton(28).Caption = "Z"
End Sub


Private Sub Command2_Click()
'-----------------------Hakkında butonuna yazmış olduğum kodlar------------------
Dim a, b, c As String
a = "Bu program çocukların kelime dağarcığını geliştirmeleri içIn"
b = "Harun YENİ tarafından yapılmıştır."
c = "Program ücretsiz olup istediğiniz kişi ile paylaşabilirsiniz."
MsgBox a + Chr(13) + b + Chr(13) + c, vbInformation, "HarunSOFT [Harun YENİ]" 'Chr(13) kodu enter işlevi görür
End Sub

Private Sub exitbuton_Click()
'---------------------------ÇIKIŞ BUTONUNA YAZDI?IM KODLAR------------------------------------
Dim secim As String
secim = MsgBox("Adam ASMACA Kapatılacak.Devam Edilsin mi?", vbYesNo + vbExclamation, "Adam ASMACA 1.0")
If secim = vbYes Then
End
ElseIf secim = vbNo Then
Exit Sub
End If
End Sub

Private Sub Form_Load()
'---------------------------FORM YÜKLENİRKEN ÇALIŞTIRDI?IM KOMUTLAR---------------------------------
Me.buton_yukle
kelimeyukle
p = 0

End Sub

Sub ciz(sayi As Integer)
'-------------------------ADAM ÇİZMEK İÇİN Select Case ÖZELLİ?İNİ KULLANDIM----------------------
'---BU ÖZELLİKLE KAÇINCI YANLIŞ YAPTI?INI BULDUN VE O KONTROLÜN VİSİBLE ÖZELLİ?İNİ True YAPTIM-----------------
Select Case sayi
Case 1
Line1.Visible = True
Case 2
Line2.Visible = True
Case 3
Line3.Visible = True
Case 4
Line4.Visible = True
Case 5
Shape1.Visible = True
Case 6
Line5.Visible = True
Case 7
Line6.Visible = True
Case 8
Line7.Visible = True
Case 9
Line8.Visible = True
Case 10
Dim s As Integer
Line9.Visible = True
MsgBox "KAYBETTİNİZ", , "ADAM ASMACA"
For s = 1 To Len(kelime)
yazimiz(s - 1).Caption = Mid(kelime, s, 1)
Next s
yenioyun.Visible = True
exitbuton.Visible = True
End Select
End Sub

Sub adami_sil()
'-----------------ADAMIN BÜTÜN ÇİZGİLERİNİ VİSİBLE False DE?ERİNİ AKTARDIM-------------------------
'----YENİ OYUNU AÇMAK İÇİN------------------------
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
Shape1.Visible = False
Line5.Visible = False
Line6.Visible = False
Line7.Visible = False
Line8.Visible = False
Line9.Visible = False
End Sub

Private Sub Form_Resize()
'--------------------YAPMIŞ OLDU?UM SKİNİ FORMUN BOYUTLARINDA AYARLANMASINI SA?LADIM--------------
'----------VE BU KODU RESIZE OLAYINA YAZMAM İLE FORMUN ÖZELLİ?İNİN HER DE?İŞTİ?İNDE TEKRAR AYARLANMASINI SA?LADIM-------

End Sub

Sub mnhakkinda()
Command2_Click
End Sub

Sub mnexit()
exitbuton_Click
End Sub


Sub mnyeni()
yenioyun_Click
End Sub

Private Sub skin1_Kapat()
exitbuton_Click
End Sub

Private Sub skin1_MenuMouseDown()
'-POPUP MENÜYÜ AÇTIM--------------
PopupMenu menu_form.mnmenu
End Sub

Private Sub skin1_MouseDown()
'---------------------Formu Taşımak içIn Mouse down olayına yapıştır---------------
'-AMA BU KODU ÇALIŞTIRABİLMEK İÇİN "MODMAIN" İSMİNDE BİR ModÜL EKLEDİM-------------
'------------------E?ER EKLEMEZ İSEM KOD HATA VERECEKTİR.---------------------------
Dim rc As Long
rc = ReleaseCapture
rc = SendMessage(hWnd, WM_NCLBUTTONDOWN, LP_HT_CAPTION, ByVal 0&)
'----------------------------------------------------------------------------------
End Sub

Private Sub skin1_SimgeDurumuna()
'-------SİMGE DURUMUNA KÜÇÜLTTÜM-----------------
Me.WindowState = 1
End Sub

Private Sub Timer1_Timer()
'----------------------BUTONLARIN RENGİNİ SIRA İLE DE?İŞTİREN ÖRNEK TİMER KULLANIMI YAPTIM......--------
If p = 0 Then
buton(p).BackColor = &HC0FFFF
buton(28).BackColor = &H8000000F
p = p + 1
ElseIf buton(p - 1).BackColor = &HC0FFFF Then
buton(p - 1).BackColor = &H8000000F
buton(p).BackColor = &HC0FFFF
p = p + 1
End If
If p = 29 Then
p = 0
End If
End Sub

Private Sub yenioyun_Click()
Me.oyun_yukle
yenioyun.Visible = False
exitbuton.Visible = False
End Sub

Sub kelimeyukle()
'kelime.txt dosyasından kelimeleri okuyorum
'kelime eklemek içIn kelime.txt dosyasını açın ve kelimeyi büyük harfle
'tırnak içinde alt alta yazın
'ama kelimede yabancı harfler olmasın.Bunu sebebi ingilizce harflerini programda kullanmamamdı.
'Cümlede ekleyebilirsiniz....

Dim dosya, okunan As String
dosya = App.Path & "/kelime.txt"
If Dir(dosya) <> "" Then
Open (dosya) For Input As #1
While Not EOF(1)
Input #1, okunan
List1.AddItem okunan
Wend
Close #1
End If
End Sub