Visual Studio/visual Basic Proje ödevi?ne yapıyım

T

tolga6_6

New member
Katılım
10 Ara 2008
Mesajlar
4
Reaction score
0
Puanları
0
visual studio 2005 kul. lar varsa aranızda yada bilen
visual basic den okul için proje lazım
-resimleri slayt şeklinde gösterme
-yılan oynu vb . yapmasını bilen yada daha önce yapmış olan varmı
yada ; bir sınıf listesinde ayrı ayrı kişilere isim adres vb. bilgiler girip görüntüleme gibi bir program başka birşeyy ne yapabilirim?
 
vısual basıcın gorsel yuzunden yapman gerek

YILAN OYUNUUU



Kod: 
FORM1 ICIN KOD:
Private Sub Command1_Click() 'Yeni Oyun Butonu
For i = 0 To 4 ' Baslangicta 5 bogum var
    Image2(i).Left = 20 + (i * 15) ' Yilanin bogumlarinin yerleri sol hizasi
    Image2(i).Top = 20 ' Yilanin bogumlarinin yerleri yukari hizasi
Next i
For i = 5 To es ' Yeni oyun Butonuna basidigi zaman eger ortada diger bogumlar varsa
'Bunlarin gorunmemesi lazim
    Image2(i).Left = 500: Image2(i).Top = 40: Image2(i).Visible = False
Next i
Call Form_Load 'Bir oyun sonrasi ilk ayarlara donmek icin form_load olayi cagriliyo
Label9.Caption = "0" 'Yuzdeyi gosteren label sifirlanmali
Shape1.Visible = True: Shape3.Visible = True: Label6.Visible = True: HScroll1.Visible = True
'Menu elemanlarinin bazilari gorunmemeli
For i = 0 To 6 ' Oyun seviyesinde kullanilan cubuklar gosteriliyor
    Shape2(i).Visible = True
Next i
Command1.Visible = False 'Yeni oyun butonu kapatiliyo cunku basla butonu gozukmeli
Command5.Visible = True ' Basla butonu
Command6.Visible = False 'Devam butonu bu asamada gorumemeli
Shape5.Height = 0: Shape5.Top = 285 'Tamamlanma yuzdesi icin kullanilan cubuk ayari yapilmali
son = False 'Oyunun bittigini algilayan bayrak degeri timer1 icin duzeltilmeli
Label4.Caption = 0 'Puan label i sifirlanmali
End Sub

Private Sub Command2_Click() ' Puan listesi butonu
Form1.Hide: Form2.Show 'Form1 i sakla Liste formunu goster
End Sub

Private Sub Command3_Click() 'Hazirlayan butonu
m = MsgBox("Bu program Eyüp Sercan Akgül" + Chr(10) + Chr(13) + "     tarafindan hazirlanmistir.", vbOKOnly, "Hazirlayan")
End Sub

Private Sub Command4_Click() 'Kapat butonu
End
End Sub

Private Sub Command5_Click() 'Basla Butonu
Shape1.Visible = False: Shape3.Visible = False: Label6.Visible = False: HScroll1.Visible = False
'Menu ayarlamalari gosterilememesi gerekenler gizleniyor
For i = 0 To 6 'Oyun seviyesi cubuklari gizleniyor
    Shape2(i).Visible = False
Next i
Command5.Visible = False 'Kendini gizliyor
Timer1.Enabled = True: Timer2.Enabled = True 'Durmus olan timer lar calistiriliyor
Command2.Enabled = False: Command3.Enabled = False: Command4.Enabled = False
'Liste, Hazirlayan, Kapat butonlari erisilemez yapiliyor
Command6.Visible = False 'Devam butonu gizleniyor
Label8.Visible = True: Label9.Visible = True: Label10.Visible = True: Shape6.Visible = True
'Tamamlama yuzdesi labelleri ve yuzde cubugu gosteriliyor
d = 1 'Escape tusu basildiginda devam dugmesinin nerede gosterilecegini belirleyen degisken
Timer1.Interval = 400 - (50 * (HScroll1.Value + 1)) 'Oyun seviyesi ayarlaniyor
pkat = (HScroll1.Value + 1) * 5 'Puan katsayisi belirleniyor
Shape5.Visible = True 'Oyun yuzdesi cubugu gosteriliyor
Unload Form2 'Liste formu aciksa kapatilmali
Form1.Show 'Form1 gosteriliyor
End Sub

Private Sub Command6_Click() 'Devam butonu
Timer1.Enabled = True 'Hareket timer i calistirilyor
    Command1.Visible = False: Command6.Visible = False
    'Yeni Oyun ve Devam butonlari gizleniyor
    Command2.Enabled = False: Command3.Enabled = False: Command4.Enabled = False
    'Diger menu tuslari erisilemez yapiliyor
    Label8.Visible = True: Label9.Visible = True: Label10.Visible = True
    'Yuzde labelleri tekrar gosteriliyor
    Shape6.Visible = True: Shape5.Visible = True 'Yuzde cercevesi ve yuzde cubugu tekrar gosteriliyor
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Basilan Tuslarin algilanmasi
    If KeyCode = vbKeyUp Then yon = 1 'Yukari tusu basilirsa yon degiskeni 1 olur
    If KeyCode = vbKeyDown Then yon = 2 'Asagi tusu basilirsa yon degiskeni 2 olur
    If KeyCode = vbKeyLeft Then yon = 3 'Sol tusu basilirsa yon degiskeni 3 olur
    If KeyCode = vbKeyRight Then yon = 4 'Sag tusu basilirsa yon degiskeni 4 olur
    If KeyCode = 27 Then 'Escape tusu basilirsa gerekli kodu cagir
        Call esc
    End If
    End Sub

Private Sub Form_Load() 'Form yuklendiginde yapilan duzenlemeler
es = 5 'Bogum sayisi 5 olsun
yon = 4 'Yilan saga gitsin
eyon = 0 'Eski yon olmayacak onun icin sifir degerinde
b = 0
puan = 0 'Puan sifir olacak
pkat = 5 'Puan katsayisi en dusuk olan 5 de olacak
yuzde = 0 'Yuzde degiskeni sifir olacak
d = 0 'Escape olayinda duzenleyici d degiskeni sifir olacak
Label7.Caption = Time 'Zaman label7 de gosterilecek
son = False 'Oyunun bitip bitmedigini denetleyen degisken false olacak
Shape5.Visible = False 'Yuzde cubugu saklanacak
Call yukle 'Puanlar diziye aktarilacak
Label2.Caption = y(0) 'En yuksek skor diziden alinip ilgili yere yazilacak
End Sub

Private Sub HScroll1_Change() 'Oyun seviyesi degistiricisi
For i = 0 To HScroll1.Value 'Oyun seviyesi cubuklarinin ayarlanmasi
    Shape2(i).FillStyle = 0: Shape2(i).FillColor = RGB(255, 0, 0)
Next i
For i = HScroll1.Value + 1 To 6 'Dugmeye basilma yonunde cubuklarin boyanmasi
     Shape2(i).FillStyle = 1
Next i
Timer1.Interval = 400 - (50 * (HScroll1.Value + 1)) 'Oyun hizinin ayarlanmasi
pkat = (HScroll1.Value + 1) * 5 'Puan katsayisinin ayarlanmasi
End Sub

Private Sub Timer1_Timer() 'Yilanin hemen hemen tum islevini yerine getirmesini saglayan timer
If es >= 900 Then 'Eger eleman sayisi 900 olmussa oyun bitmis demektir
    GoTo bitti 'Bitti bolumune git
End If
Select Case yon 'Yon degiskenine gore yapilmasi gerekenler
Case 1 'Yukari tusu basilmissa yapilacaklar
1:
    If eyon = 2 Then GoTo 2 'Eger yilan asagi giderken yukariya gitmesi istenirse
    'bu sacma bir istek olur ve olay asagiya devam edecektir
If Image2(es - 1).Left = Image2(es).Left And Image2(es - 1).Top = Image2(es).Top + 15 Then
'Eger yemle bas eleman ayni koordinattaysa(yem alinmissa)
    Timer2.Enabled = True: b = 1: puan = puan + pkat: Label4.Caption = puan
    'Yemi atan timer i calistir, puani arttir, puan labelini guncelle
End If
For i = 0 To es - 2 'Asagida yem alindigi zaman yanmamak icin gerekli kod bulunuyor
    If (Image2(es - 1).Left = Image2(i).Left) And (Image2(es - 1).Top = Image2(i).Top) Then
        If (Image2(es - 2).Left = Image2(es - 1).Left) And (Image2(es - 2).Top = Image2(es - 1).Top) Then
            GoTo ifk
        Else 'Eger yilan icinde kendine carparsa oyun bitmistir
        'Carpma olayi icin en basta giden bogumun herhangi birine carpmasi yani
        'Ayni koordinatta olmasi lazim
        s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
        'Oyunun bittigine dair uyari
    End If
    End If
Next i
ifk: 'Eger en bastaki bogum duvarlara carpmissa oyun yine biter
If Image2(es - 1).Left < 20 Or Image2(es - 1).Left > 455 Or Image2(es - 1).Top < 20 Or Image2(es - 1).Top > 455 Then
s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
'Oyunun bittigine dair uyari
End If
For i = 0 To es - 2 'Yilanin en sonunda tum kontroller sonu yurume mekanizmasi
'Her bogum onundeki bogumun yerine gecer
    Image2(i).Left = Image2(i + 1).Left
    Image2(i).Top = Image2(i + 1).Top
Next i
Image2(es - 1).Top = Image2(es - 1).Top - 15
'Istisna olarak en ondeki bogum kalir ve oda eski haline gore solu degismeden yukari alinir
eyon = 1 'Eski yon bayragi yukariyi temsil etmeli
Case 2 'Asagi tusu basilmissa yapilacaklar
2:
    If eyon = 1 Then GoTo 1 'Eger yilan yukari giderken asagiya gitmesi istenirse
    'bu sacma bir istek olur ve olay yukariya devam edecektir
If Image2(es - 1).Left = Image2(es).Left And Image2(es - 1).Top = Image2(es).Top - 15 Then
'Eger yemle bas eleman ayni koordinattaysa(yem alinmissa)
    Timer2.Enabled = True: b = 1: puan = puan + pkat: Label4.Caption = puan
    'Yemi atan timer i calistir, puani arttir, puan labelini guncelle
End If
For i = 0 To es - 2 'Asagida yem alindigi zaman yanmamak icin gerekli kod bulunuyor
    If (Image2(es - 1).Left = Image2(i).Left) And (Image2(es - 1).Top = Image2(i).Top) Then
        If (Image2(es - 2).Left = Image2(es - 1).Left) And (Image2(es - 2).Top = Image2(es - 1).Top) Then
            GoTo ifk1
        Else 'Eger yilan icinde kendine carparsa oyun bitmistir
        'Carpma olayi icin en basta giden bogumun herhangi birine carpmasi yani
        'Ayni koordinatta olmasi lazim
        s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
        'Oyunun bittigine dair uyari
    End If
    End If
Next i
ifk1: 'Eger en bastaki bogum duvarlara carpmissa oyun yine biter
If Image2(es - 1).Left < 20 Or Image2(es - 1).Left > 455 Or Image2(es - 1).Top < 20 Or Image2(es - 1).Top > 455 Then
s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
'Oyunun bittigine dair uyari
End If
For i = 0 To es - 2 'Yilanin en sonunda tum kontroller sonu yurume mekanizmasi
'Her bogum onundeki bogumun yerine gecer
    Image2(i).Left = Image2(i + 1).Left
    Image2(i).Top = Image2(i + 1).Top
Next i
Image2(es - 1).Top = Image2(es - 1).Top + 15
'Istisna olarak en ondeki bogum kalir ve oda eski haline gore solu degismeden asagi alinir
eyon = 2 'Eski yon bayragi asagiyi temsil etmeli
Case 3 'Sola tusu basilmissa yapilacaklar
3:
    If eyon = 4 Then GoTo 4 'Eger yilan saga giderken sola gitmesi istenirse
    'bu sacma bir istek olur ve olay saga devam edecektir
If Image2(es - 1).Left = Image2(es).Left + 15 And Image2(es - 1).Top = Image2(es).Top Then
'Eger yemle bas eleman ayni koordinattaysa(yem alinmissa)
    Timer2.Enabled = True: b = 1: puan = puan + pkat: Label4.Caption = puan
    'Yemi atan timer i calistir, puani arttir, puan labelini guncelle
End If
For i = 0 To es - 2 'Asagida yem alindigi zaman yanmamak icin gerekli kod bulunuyor
    If (Image2(es - 1).Left = Image2(i).Left) And (Image2(es - 1).Top = Image2(i).Top) Then
        If (Image2(es - 2).Left = Image2(es - 1).Left) And (Image2(es - 2).Top = Image2(es - 1).Top) Then
            GoTo ifk2
        Else 'Eger yilan icinde kendine carparsa oyun bitmistir
        'Carpma olayi icin en basta giden bogumun herhangi birine carpmasi yani
        'Ayni koordinatta olmasi lazim
        s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
        'Oyunun bittigine dair uyari
    End If
    End If
Next i
ifk2: 'Eger en bastaki bogum duvarlara carpmissa oyun yine biter
If Image2(es - 1).Left < 20 Or Image2(es - 1).Left > 455 Or Image2(es - 1).Top < 20 Or Image2(es - 1).Top > 455 Then
s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
'Oyunun bittigine dair uyari
End If
For i = 0 To es - 2 'Yilanin en sonunda tum kontroller sonu yurume mekanizmasi
'Her bogum onundeki bogumun yerine gecer
    Image2(i).Left = Image2(i + 1).Left
    Image2(i).Top = Image2(i + 1).Top
Next i
Image2(es - 1).Left = Image2(es - 1).Left - 15
'Istisna olarak en ondeki bogum kalir ve oda eski haline gore yukarisi degismeden sola alinir
eyon = 3 'Eski yon bayragi solu temsil etmeli
Case 4 'Saga tusu basilmissa yapilacaklar
4:
    If eyon = 3 Then GoTo 3 'Eger yilan sola giderken saga gitmesi istenirse
    'bu sacma bir istek olur ve olay sola devam edecektir
If Image2(es - 1).Left = Image2(es).Left - 15 And Image2(es - 1).Top = Image2(es).Top Then
'Eger yemle bas eleman ayni koordinattaysa(yem alinmissa)
    Timer2.Enabled = True: b = 1: puan = puan + pkat: Label4.Caption = puan
     'Yemi atan timer i calistir, puani arttir, puan labelini guncelle
End If
For i = 0 To es - 2 'Asagida yem alindigi zaman yanmamak icin gerekli kod bulunuyor
    If (Image2(es - 1).Left = Image2(i).Left) And (Image2(es - 1).Top = Image2(i).Top) Then
        If (Image2(es - 2).Left = Image2(es - 1).Left) And (Image2(es - 2).Top = Image2(es - 1).Top) Then
            GoTo ifk3
        Else 'Eger yilan icinde kendine carparsa oyun bitmistir
        'Carpma olayi icin en basta giden bogumun herhangi birine carpmasi yani
        'Ayni koordinatta olmasi lazim
        s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
        'Oyunun bittigine dair uyari
    End If
    End If
Next i
ifk3: 'Eger en bastaki bogum duvarlara carpmissa oyun yine biter
If Image2(es - 1).Left < 20 Or Image2(es - 1).Left > 455 Or Image2(es - 1).Top < 20 Or Image2(es - 1).Top > 455 Then
s = MsgBox("Oyun Bitti", vbOKOnly, "Dikkat"): son = True: GoTo bitti
'Oyunun bittigine dair uyari
End If
For i = 0 To es - 2 'Yilanin en sonunda tum kontroller sonu yurume mekanizmasi
'Her bogum onundeki bogumun yerine gecer
    Image2(i).Left = Image2(i + 1).Left
    Image2(i).Top = Image2(i + 1).Top
Next i
Image2(es - 1).Left = Image2(es - 1).Left + 15
'Istisna olarak en ondeki bogum kalir ve oda eski haline gore yukarisi degismeden saga alinir
eyon = 4 'Eski yon bayragi sagi temsil etmeli
End Select 'Yon tuslarina gore hareket degerlendirmesini bitir
bitti: 'Oyun bittiginde yapilacaklar
If son = True Then 'Eger bitti degiskeni true ise ozaman
    Timer1.Enabled = False: d = 0 'Timer1 i durdur (Yilani durdur)
    Command1.Visible = True: Command2.Visible = True
    Command3.Visible = True: Command4.Visible = True
    'Menude gosterilmesi gereken elmanlari goster
    Call puan_kontrol 'Yapilan yeni puanin listeye girip giremeyecegini kotrol et
End If
End Sub

Private Sub Timer2_Timer() 'Yemi gosteren timer
If b = 1 Then es = es + 1 'Eger oyun yeni baslamanissa eleman sayisini 1 arttir
yeniden: 'Eger yem yilanin ustune duserse yeniden koordinat belirlem icin gelinmesi gereken yer
Randomize
l = Int(Rnd * 450): xa = l Mod 15: lx = l - xa + 20 'Yemin sol ayari
t = Int(Rnd * 450): ya = t Mod 15: ty = t - ya + 20 'Yemin yukari ayari
For i = 0 To es - 1 'Yemin yilanin ustunde olup olmadigini anlama mekanizmasi
    If lx = Image2(i).Left And ty = Image2(i).Top Then GoTo yeniden
    'Eger yem yilanin uzerindeyse yeniden isleme gir
Next i
Image2(es).Visible = True: Image2(es).Left = lx: Image2(es).Top = ty
'Yemi goster ekrandaki yerine koy
Timer2.Enabled = False 'Yem koyma isi bitti timer i kapa
If es Mod 9 = 0 Then 'Her 9 eleman sayisi yuzde bir eder
    Shape5.Height = Shape5.Height + 2 'Yuzde cubugunu arttir
    Shape5.Top = Shape5.Top - 2 'Yuzde cubugunun yukari hizasini ayarla
    yuzde = yuzde + 1 'Yuzdeyi tutan degiskeni arttir
    Label9.Caption = yuzde 'Yuzde labelini guncelle
End If
End Sub

Private Sub Timer3_Timer()
Label7.Caption = Time 'Label7 ye saati yaz
End Sub

Private Sub esc() 'Escape tusu basidiginda yapilmasi gerekenler
Timer1.Enabled = False: Timer2.Enabled = False 'Yilani durdur
Command1.Visible = True 'Yeni Oyun butonunu goster
If d = 1 Then 'Eger oyun baslamissa devam butnunu da gostermelisin
Command6.Visible = True
End If
Command2.Enabled = True: Command3.Enabled = True: Command4.Enabled = True
'Liste, hazirlayan, kapat butonlarini goster
Label8.Visible = False: Label9.Visible = False: Label10.Visible = False
'Tamamlama yuzdesi bolumu bilesenlerini sakla
Shape6.Visible = False: Shape5.Visible = False
'Tamamlama yuzdesi cercevesini ve yuzde cubugunu gizle
End Sub



Kod: 
FORM2 İCİN KOD:
Private Sub Command1_Click()
Call kaydet 'Listeyi kapatirken kaydetmelisin
Form1.Command2.Enabled = True 'Puan listesi butonu aktif olsun
Form1.Command3.Enabled = True 'Hazirlayan butonu aktif olsun
Form1.Command4.Enabled = True 'Kapat butonu aktif olsunUnload Me 'Listeyi kapa
Form1.Show 'Oyuna don
End Sub

Private Sub Command2_Click()
Call kaydet 'Listeyi kapatirken kaydetmelisin
End 'Programi kapat
End Sub

Private Sub Form_Load()
For i = 0 To 19 'Liste acilirken diziden gerekli yuklemeyi yap
    Label3(i).Caption = x(i) 'Isimler kismi
    Label4(i).Caption = y(i) 'Puanlar kismi
Next i
End Sub



[CODE]

MODULE1 İN KODLARI:
Public son As Boolean 'Oyunun bitip bitmedigini belirleyen degisken
Public es, yon, eyon, b, pkat, puan, yuzde, d, pux As Integer
'es = eleman sayisi, yon = yon degiskeni, eyon = eski yon degiskeni,b = timer2 de kullanilan
'oyunun ilk kez baslayip baslamadigini saptayan degisken, pkat = puan katsayisi degiskeni
'puan = puan degiskeni, yuzde = tamamlanma yuzdesi degiskeni, d = escape olayinda kullanilan
'degisken, pux = puanlarin dizilere aktarilmasinda kullanilan degisken
Public x(0 To 19) As String 'Isimleri tutan dizi
Public y(0 To 19) As Integer 'Puanlari tutan dizi
Public adx As String 'isimlerin dizilere aktarilmasinda kullanilan degisken
Public Sub yukle() 'Dosyadan yukleme islemini yapan kod
Static i
i = 0
Dim ad, pu 'ad ve puan degiskenleri
    If Dir("puan.dat") <> "" Then 'Dosyayi ac
        Open "puan.dat" For Input As #1
        While Not EOF(1) 'Dosya sonuna gelinceye kadar islemi yap
            Input #1, ad, pu 'ad ve puani diziye aktar
            x(i) = ad: y(i) = pu
            i = i + 1
        Wend
        Close #1 'Dosyayi kapa
    End If
End Sub
Public Sub kaydet() 'Dosyayi kaydeden kod
Dim ady, puy 'ad ve puan degiskenleri
    Open "puan.dat" For Output As #1 'Dosyayi okumak icin ac
        For i = 0 To 19
            ady = Form2.Label3(i).Caption 'Liste bolumunden adlari al
            puy = Form2.Label4(i).Caption 'Liste bolumunden puanlari al
            x(i) = ady: y(i) = puy 'ad ve puan diziye aktar yani guncelle
        Write #1, ady, puy 'Dosyaya hepsini yaz
        Next i
    Close #1
End Sub
Public Sub puan_kontrol() 'Oyun bittiginde cagrilan ve alinan son puanin listeye girip
'giremeyecegini sorgulayan kod
Static e
e = 0
Form1.Hide: Form2.Show 'Listeyi ac
    For i = 0 To 19
        If puan >= y(i) Then 'Eger son puan listedeki herhangi bir puandan büyük ya da esitse
            a = InputBox("Isminizi yaziniz") 'Kullanicidan ismini iste
            adx = Form2.Label3(i).Caption 'Gecilen ismii kaydet
            pux = Val(Form2.Label4(i).Caption) 'Gecilen puani kaydet
            Form2.Label4(i).Caption = puan 'Yeni puani yaz
            Form2.Label3(i).Caption = a 'Yeni ismi yaz
            e = e + 1
                For s = 19 To e + 1 Step -1 'Tersten donguyle listeyi yenile
                    Form2.Label3(s).Caption = Form2.Label3(s - 1).Caption
                    Form2.Label4(s).Caption = Form2.Label4(s - 1).Caption
                    'Alttaki bir ustundeki degeri alacak
                Next s
                Form2.Label3(e).Caption = adx 'alinan isim degerini yeni eklenenin altina koy
                Form2.Label4(e).Caption = pux 'alinan puan degerini yeni eklenenin altina koy
            GoTo tmm 'if ten cikmalisin
        End If
    e = e + 1
    Next i
tmm:
End Sub


:vurUMARIM YARDIMCI OLABILMISIMDIR
[/CODE]



:vurUMARIM YARDIMCI OLABILMISIMDIR
 
COK TESEKKUR EDERİM YILAN YAPICAGIM
ODEV NİSANA
KONU PAZARTESİNE İDİ
SAOL İNTERNETTE YOK BENDE CEVAP YAZ: İÇ. saol

biraz daha yardımcı olabilirsen iyi olur?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst