Oyun Makinası

[DeadGhost]

HERAKLES Otomatik Avlı kalıcı sunucu. 19 Haziran'da açılıyor. Atius & Wizard güvencesiyle hemen kayıt ol, ön kayıt ödülleri aktif. HEMEN TIKLA!

3 Farklı resmin bilgisayar tarafından seçildiği ve en az 2 aynı resmi bulunca puan kazanılan aksi halde ana krediden puan kaybedilen guzel bir( timer lı) oyun örneği..Basit bir örnek..
NESNELER
--------------------------------------------------------------------------------


3 form



1. Form(frmOyunMakinesi)
--------------------------------------------------------------------------------

<KOD>NESNELER</KOD>

3 label
1 textbox
2 commandbutton
3 image


<KOD>MENU EDITOR</KOD>

Dosya(mnuDosya)

** Yeni Oyun(mnuYeni)
** - (mnuSpace3)
** Zorluk Seviyesi(mnuZorluk)
**** Kolay(mnuKolay)
**** Normal(mnuOrta)
**** Zor(mnuZor)
** - (mnuSpace4)
** Skor (mnuSkor)
** - (mnuSpace1)
** Çıkış(mnuCikis)

Yardım(mnuYardim)

** Oyun Oynanışı(mnuOyun_Oynanisi)
** İletişim(mnuIletisim)
** - (mnuSpace2)
** Hakkında(mnuHakkinda)


1.Form KODLAMASI
--------------------------------------------------------------------------------


Dim AnaPara, Oyun_Sayisi, i As Integer
Dim Resim1, Resim2, Resim3 As Integer
Dim Zorluk, Puan As Integer

Private Sub cmdOyna_Click()
Timer4.Enabled = True
cmdOyna.Enabled = False

i = 0

Oyun_Sayisi = Oyun_Sayisi + 1
lblOyun.Caption = Oyun_Sayisi

If Oyun_Sayisi > 100 And (Oyun_Sayisi Mod 10 = 0) Then
Giris = MsgBox("Oyunu Bitirmek ister misiniz?", vbYesNo + vbInformation, "Oyun Makinesi")

If Giris = vbYes Then
Dosya_Yaz
mnuYeni_Click
End If
End If
End Sub


Private Sub cmdPara_Click()
If IsNumeric(txtPara) = False Then
MsgBox "Lütfen sayı giriniz..", vbExclamation, "Hata"
txtPara = ""
ElseIf txtPara > 250 Or txtPara < 5 Then
MsgBox "En az 5 giriniz..(Max: 250)", vbInformation, "Para Miktarı"
txtPara = ""
Else
AnaPara = txtPara
txtPara.Locked = True
cmdPara.Enabled = False
cmdOyna.Enabled = True
Oyun_Sayisi = 0
lblOyun.Caption = Oyun_Sayisi
End If

mnuZorluk.Enabled = False
End Sub


Private Sub Form_Load()
Dim Skor As Integer
Dim Seviye As String

On Error GoTo Son

cmdOyna.Enabled = False
img1.Picture = LoadPicture("")
img2.Picture = LoadPicture("")
img3.Picture = LoadPicture("")
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
Timer4.Enabled = False
mnuZorluk.Enabled = True

mnuKolay_Click

Open App.Path & "\skor.mrt" For Input As #1
Input #1, Skor
Input #1, Seviye
Close #1

Exit Sub

Son:

Skor = 0
Seviye = "Kolay"
Open App.Path & "\skor.mrt" For Output As #1
Print #1, Skor
Print #1, Seviye
Close #1
End Sub


Private Sub mnuCikis_Click()
Dim Giris As Byte

Giris = MsgBox("Çıkmak istediğinize emin misiniz?", vbYesNo, "Çıkış")

If Giris = vbYes Then End
End Sub


Private Sub mnuHakkinda_Click()
frmAbout.Show
End Sub


Private Sub mnuIletisim_Click()
Shell "explorer.exe mailto:materna@mynet.com", vbMaximizedFocus
End Sub


Private Sub mnuKolay_Click()
mnuKolay.Checked = True
mnuOrta.Checked = False
mnuZor.Checked = False
Zorluk = 3
Puan = 3
End Sub


Private Sub mnuOrta_Click()
mnuKolay.Checked = False
mnuOrta.Checked = True
mnuZor.Checked = False
Zorluk = 5
Puan = 10
End Sub


Private Sub mnuOyun_Oynanisi_Click()
frmOyunOynanisi.Show
End Sub


Private Sub mnuSkor_Click()
Open App.Path & "\skor.mrt" For Input As #1
Input #1, Skor
Input #1, Seviye
Close #1

MsgBox "En Yüksek Skorunuz: " & Skor & Chr(13) & "Seviye : " & Seviye, vbInformation, "Skor Bilgisi"

End Sub


Private Sub mnuYeni_Click()
Form_Load

txtPara.Text = ""
txtPara.Locked = False
cmdPara.Enabled = True
Oyun_Sayisi = 0
lblOyun.Caption = Oyun_Sayisi
End Sub


Private Sub mnuZor_Click()
mnuKolay.Checked = False
mnuOrta.Checked = False
mnuZor.Checked = True
Zorluk = 10
Puan = 15
End Sub


Private Sub Timer1_Timer()
Resim1 = Int((Zorluk - 1 + 1) * Rnd + 1)

img1.Picture = LoadPicture(App.Path & "\images\" & Resim1 & ".jpg")
End Sub


Private Sub Timer2_Timer()
Resim2 = Int((Zorluk - 1 + 1) * Rnd + 1)

img2.Picture = LoadPicture(App.Path & "\images\" & Resim2 & ".jpg")

End Sub


Private Sub Timer3_Timer()
Resim3 = Int((Zorluk - 1 + 1) * Rnd + 1)

img3.Picture = LoadPicture(App.Path & "\images\" & Resim3 & ".jpg")

End Sub


Private Sub Timer4_Timer()
Timer1.Enabled = True
Timer2.Enabled = True
Timer3.Enabled = True

i = i + 1

If i = 16 Then
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
Timer4.Enabled = False

Kontrol
End If
End Sub


Sub Kontrol()
If Resim1 = Resim2 And Resim2 = Resim3 Then
AnaPara = AnaPara + 50
txtPara = AnaPara
End If

If (Resim1 = Resim2 And Resim2 <> Resim3) Or (Resim2 = Resim3 And Resim1 <> Resim3) Or (Resim1 = Resim3 And Resim1 <> Resim2) Then
AnaPara = AnaPara + 10
txtPara = AnaPara
End If

If (Resim1 <> Resim2 And Resim2 <> Resim3) Then
AnaPara = AnaPara - Puan
txtPara = AnaPara
End If

cmdOyna.Enabled = True

If AnaPara <= 0 Then
MsgBox "Paranız Bittiği için oyun bitmiştir.." & Chr(13) & Chr(13) & "Ulaştığınız Oyun Sayısı: " & Oyun_Sayisi & Chr(13) & Chr(13) & "Dosya menüsünden YENİ OYUN u seçerek yeniden oyunu oynayabilirsiniz..", vbInformation, "Oyun Bitti"
cmdOyna.Enabled = False
Dosya_Yaz
End If
End Sub


Sub Dosya_Yaz()
Dim Skor As Integer
Dim Seviye As String

Open App.Path & "\skor.mrt" For Input As #1
Input #1, Skor
Input #1, Seviye
Close #1

If mnuKolay.Checked = True Then
Seviye = "Kolay"
ElseIf mnuOrta.Checked = True Then
Seviye = "Normal"
Else
Seviye = "Zor"
End If

If Skor < Oyun_Sayisi Then

Skor = Oyun_Sayisi

Open App.Path & "\skor.mrt" For Output As #1
Print #1, Skor
Print #1, Seviye
Close #1

MsgBox "<<< ***** ÖNCEKİ SKORUNUZU GEÇTİNİZ ***** >>>", vbInformation, "Skor Bilgisi"
Else
MsgBox "<<< ***** ÖNCEKİ SKORUNUZU GEÇEMEDİNİZ ***** >>>", vbInformation, "Skor Bilgisi"
End If
End Sub


2.Form (frmAbout)
--------------------------------------------------------------------------------


NESNELER

2 label

Label2 yukarda Label1 aşağıda olsun..



2.Form KODLAMASI
--------------------------------------------------------------------------------


Private Sub Form_Click()
Unload Me
End Sub


Private Sub Form_Load()
frmAbout.Caption = "Hakkında"
Label1.Caption = Chr(13) & "Yazan: " & Chr(13) & Chr(13) & "Oyun Makinesi v1.0" & Chr(13) & _
Chr(13) & Chr(13)
Label2.Caption = "FreeWareSoft Copyright"
End Sub


Private Sub Label1_Click()
Unload Me
End Sub


Private Sub Label2_Click()
Unload Me
End Sub


3.Form (frmOyunOynanisi)
--------------------------------------------------------------------------------


NESNELER

2 label

label1 (Lab1)
label2 (Lab2)

label2 yukarda label1 aşağıda olsun..



3.Form KODLAMASI
--------------------------------------------------------------------------------


Private Sub Form_Load()
Dim Kural1, Kural2, Kural3, Kural4 As String

Lab2.Caption = " Oyunun Oynanışı"

Kural1 = " Oyuna başlamak için ilk önce PARANIZ kısmına en az 5 yazarak ana paranızı belirleyiniz..Sonra PARA ÇEK e basarak oyuna başlamak için gerekli işlemi yapmış olursunuz..." + Chr(13)
Kural2 = Chr(13) + " OYNA butonu aktif olunca oyuna başlayabilirsiniz..Oyunda en az iki aynı resimi bulmazsanız puan kazanamaz askine oyunun zorluk seviyesine göre belli miktarda puanı kaybedersiniz..Oyunda her zorluk seviyesinde de 2 aynı resimi bulduğunuzda 10 PUAN , 3 aynı resimi bulmanız durumunda 50 PUAN kazanırsınız.."
Kural3 = Chr(13) + Chr(13) + " Zorluk Seviyesi Kolay seçildiğinde, 3 farklı resim size 3 PUAN kaybettirir." & _
Chr(13) + " Zorluk Seviyesi Normal seçildiğinde, 3 farklı resim size 10 PUAN kaybettirir." & _
Chr(13) + " Zorluk Seviyesi Zor seçildiğinde, 3 farklı resim size 15 PUAN kaybettirir."
Kural4 = Chr(13) + Chr(13) + " İyi Eğlenceler..."
Lab1.Caption = Kural1 + Kural2 + Kural3 + Kural4
End Sub