1. Reklam


    1. joysro
      ledas
      jungler
      keasro
      zeus
      karantina

Masa Tenisi Oyunu Kodu


  1. Black Rain

    Black Rain Aileden rank8

    Kayıt:
    17 Kasım 2007
    Mesajlar:
    10.698
    Beğenilen Mesajlar:
    2
    Ödül Puanları:
    38
    Meslek:
    Kamyon Şöförü
    Şehir:
    Bursa / Gemlik
    2 topun masa üzerinde ilerlemesi ve çubuklar ile karşılanması..
    FORM ÜZERİNDEKİ NESNELER

    2 Textbox
    (1. ve 2. oyuncu ad kutucukalrı)

    1 Line
    (Masanın üstünde, Masanın altında ve Orta saha çizgisi)

    4 Shape
    (Masa, Top, 1.Oyuncu Bloğu,2.Oyuncu Bloğu)

    3 Timer
    (Top hareketleri için, Blokların hareketleri için, Geri sayım türlü oyunda zamanın geri sayımı için)

    1 CommonDialog
    (Menu editor ile)
    Dosya > “Yeni oyun, Çıkış”
    Ayarlar > “Oyun Türü, Masa Rengi, Falso Verme”
    Yardım > “Bilgi, Hakkında, Mail Gönder”

    7 Label
    (Süre, Yukarı Falso “Max:100”, Yana Falso “Max:30”, Hız Yazısı, Hız Değeri, Sol Oyuncu Skoru, Sağ Oyuncu Skoru)

    1 CommandButton
    (Oyunu Başlatıp Bitirmek için)

    1 HorizontalScrollBar
    (Hızı ayarlamak için ; max:100)
    Kod:
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Dim Gidis As String
    Dim Hareket, X, Y As Byte
    Dim Süre As Single
    
    'Başla ve Bitir butonu yapılandırması ve uygulaması.
    Private Sub cmd_Click()
    If cmd.Caption = "B&aşla" Then
        cmd.Caption = "Biti&r"
        HS1.Enabled = False
        Hareket = 1
        txtAd(0).Locked = True
        txtAd(1).Locked = True
    Else
        cmd.Caption = "B&aşla"
        HS1.Enabled = True
        Hareket = 0
    End If
    End Sub
    
    'Program başlangıcında formun yüklenmesi.
    Private Sub Form_Load()
        cmd.Caption = "B&aşla"
        L1.Caption = "Hız: "
        L2.Left = L1.Left + L1.Width
        L2.Caption = HS1.Value
        HS1.Enabled = True
        Form1.Caption = "Masa Tenisi"
        Sonuc(0).Caption = 0
        Sonuc(1).Caption = 0
        lblSure.Caption = "Süre: "
        FalsoY.Caption = "Yukarı Falso: 0"
        FalsoA.Caption = "Yana   Falso: 0"
        
        L3.X1 = Shape1.Left + Shape1.Width / 2
        L3.X2 = Shape1.Left + Shape1.Width / 2
        
        txtAd(0).Text = "1.Oyuncu"
        txtAd(1).Text = "2.Oyuncu"
            
        HS1.Value = 40
        Hareket = 0
        X = 0
        Y = 0
        
        Rastgele_Top_Yerlesimi
    End Sub
    
    'Topun başlangıçta ve sayı olduktan sonra rastgele konumlanması ve gitmesi.
    Sub Rastgele_Top_Yerlesimi()
        'Topun rastgele yerleştirilmesi.
        P1.Left = Int(((Shape1.Left + Shape1.Width) - Shape1.Left) * Rnd + Shape1.Left)
        P1.Top = Int(((Shape1.Top + Shape1.Height) - Shape1.Top) * Rnd + Shape1.Top)
        
        'Topun yerleşimine göre hareket etmesi.
        If P1.Left < Shape1.Left + Shape1.Width / 2 And P1.Top < Shape1.Top + Shape1.Height / 2 Then
                Gidis = "SagA"
        ElseIf P1.Left < Shape1.Left + Shape1.Width / 2 And P1.Top > Shape1.Top + Shape1.Height / 2 Then
                Gidis = "SagY"
        ElseIf P1.Left > Shape1.Left + Shape1.Width / 2 And P1.Top < Shape1.Top + Shape1.Height / 2 Then
                Gidis = "SolA"
        Else
                Gidis = "SolY"
        End If
    End Sub
    
    'Hızın değiştirilmesi.
    Private Sub HS1_Change()
        L2.Caption = HS1.Value
    End Sub
    
    'Yardım > Bilgi butonun basınca.
    Private Sub mnuBilgi_Click(Index As Integer)
    MsgBox "Yardım için programın bulunduğu klasördeki <Yardım.htm> dosyasına bakın..", vbInformation, "Bilgi"
    End Sub
    
    'Programın sonlandırılması.
    Private Sub mnuCikis_Click(Index As Integer)
        End
    End Sub
    
    'Topa yana falso verme değeri.
    Private Sub mnuFalso_Asagi_Click(Index As Integer)
    X = -1
        If Index = 9 Then
            Do Until X >= 0 And X < 31 And IsNumeric(X) = True
                X = InputBox("Yana falso verme derecesini giriniz:" & Chr(13) & "(Max:30 - Min:0)", "Yukarı Falso Verme")
            Loop
            FalsoA.Caption = "Yana   Falso : " & X
        End If
    End Sub
    
    'Topa yukarı falso verme değeri.
    Private Sub mnuFalso_Yukari_Click(Index As Integer)
    Y = -1
        If Index = 8 Then
            Do Until Y >= 0 And Y < 101 And IsNumeric(Y) = True
                Y = InputBox("Yukarı falso verme derecesini giriniz:" & Chr(13) & "(Max:100 - Min:0)", "Yukarı Falso Verme")
            Loop
            FalsoY.Caption = "Yukarı Falso : " & Y
        End If
    End Sub
    
    'Geri saymalı oyun türü seçildiğinde.
    Private Sub mnuGeri_Sayim_Click(Index As Integer)
    Dim Sayi As Integer
        If mnuGeri_Sayim(4).Checked = False Then
            mnuStandart(3).Checked = False
            mnuGeri_Sayim(4).Checked = True
            mnuSureli(5).Checked = False
        End If
        
        Sayi = InputBox("Geri sayım yapılacak skoru giriniz:", "Skor Giriniz")
        Sonuc(0).Caption = Sayi
        Sonuc(1).Caption = Sayi
    
        Rastgele_Top_Yerlesimi
    End Sub
    
    'Program bilgisi.
    Private Sub mnuHakkinda_Click(Index As Integer)
        frmAbout.Show
    End Sub
    
    'Ayarlar > Masa Rengi butonun basıp masanın rengini değiştirilmesi.
    Private Sub mnuMasa_Renk_Click(Index As Integer)
        On Error GoTo Son
        CommonDialog1.Flags = cdlCCRGBInit
        CommonDialog1.ShowColor
        Shape1.BackColor = CommonDialog1.Color
    Son:
    End Sub
    
    Private Sub mnuStandart_Click(Index As Integer)
        If mnuStandart(3).Checked = False Then
            Oyun_Türü_Reset
        End If
    End Sub
    
    Private Sub mnuSureli_Click(Index As Integer)
        If mnuSureli(5).Checked = False Then
            mnuStandart(3).Checked = False
            mnuGeri_Sayim(4).Checked = False
            mnuSureli(5).Checked = True
        End If
        Süre = InputBox("Oyun süresini belirtiniz(sn):", "Oyun Süresi")
        lblSure.Caption = "Süre: " & Süre & " sn"
    
        Rastgele_Top_Yerlesimi
    End Sub
    
    
    'Dosya > Yeni Oyun butonun a basınca.
    Private Sub mnuYeni_Click(Index As Integer)
        HS1.Enabled = True
        cmd.Caption = "B&aşla"
        Sonuc(0).Caption = 0
        Sonuc(1).Caption = 0
        txtAd(0).Locked = False
        txtAd(1).Locked = False
        FalsoY.Caption = "Yukarı Falso : 0"
        FalsoA.Caption = "Yana   Falso : 0"
    
        HS1.Value = 40
        Hareket = 0
        X = 0
        Y = 0
        
        Oyun_Türü_Reset
    End Sub
    
    'Top un hareketi için.
    Private Sub Timer1_Timer()
    Dim X1, Y1 As Byte
    
    If Hareket = 0 Then Exit Sub
        'Dış kenara değme sonucu yönlendirme.
        Dis_Kenarlara_Degme
        
        X1 = Int(Rnd * X) 'Rastgele yana falso değeri türetme.
        Y1 = Int(Rnd * Y) 'Restgele yukarı falso değeri türetme.
        
        'Topun ilerlemesi.
        If Gidis = "SolA" Then
            P1.Top = P1.Top + HS1.Value + Y1: P1.Left = P1.Left - HS1.Value - X1
        ElseIf Gidis = "SagA" Then
            P1.Top = P1.Top + HS1.Value + Y1: P1.Left = P1.Left + HS1.Value + X1
        ElseIf Gidis = "SolY" Then
            P1.Top = P1.Top - HS1.Value - Y1: P1.Left = P1.Left - HS1.Value - X1
        ElseIf Gidis = "SagY" Then
            P1.Top = P1.Top - HS1.Value - Y1: P1.Left = P1.Left + HS1.Value + X1
        End If
        
        'Dış kenara tam degme sağlanması.
        Kenara_Tam_Deyme
        
        'Sol ve sağ oyuncunun blok ile topa vurması.
        Topa_Vurma
    End Sub
    
    Sub Topa_Vurma()
    If cmd.Caption = "B&aşla" Then Exit Sub
    'Bloğa tam değme sağlanması.
        'Sol taraf için.
        If P1.Left < Picture1(0).Left + Picture1(0).Width And ((P1.Top >= Picture1(0).Top And P1.Top <= Picture1(0).Top + Picture1(0).Height) Or _
           (P1.Top + P1.Height >= Picture1(0).Top And P1.Top + P1.Height <= Picture1(0).Top + Picture1(0).Height)) Then
                    P1.Left = Picture1(0).Left + Picture1(0).Width
       'Sağ taraf için.
        ElseIf P1.Left + P1.Width > Picture1(1).Left And ((P1.Top >= Picture1(1).Top And P1.Top <= Picture1(1).Top + Picture1(1).Height) Or _
           (P1.Top + P1.Height >= Picture1(1).Top And P1.Top + P1.Height <= Picture1(1).Top + Picture1(1).Height)) Then
                    P1.Left = Picture1(1).Left - P1.Width
                    
    'Topun blogu ıskalaması.
        'Sol taraf için.
        ElseIf ((P1.Top + P1.Height < Picture1(0).Top And P1.Left < Picture1(0).Left + Picture1(0).Width) Or _
                (P1.Top > Picture1(0).Top + Picture1(0).Height And P1.Left < Picture1(0).Left + Picture1(0).Width)) Then
                        Hareket = 0
                        Reset
                        MsgBox txtAd(1) & " isimli oyuncu sayı yaptı..", vbInformation, "2.Oyuncu Sayı Yaptı"
                        If mnuStandart(3).Checked = True Or mnuSureli(5).Checked = True Then Sonuc(1).Caption = Sonuc(1).Caption + 1
                        If mnuGeri_Sayim(4).Checked = True Then Sonuc(1).Caption = Sonuc(1).Caption - 1
                        
        'Sağ taraf için.
        ElseIf ((P1.Top + P1.Height < Picture1(1).Top And P1.Left + P1.Width > Picture1(1).Left) Or _
                (P1.Top > Picture1(1).Top + Picture1(1).Height And P1.Left + P1.Width > Picture1(1).Left)) Then
                        Hareket = 0
                        Reset
                        MsgBox txtAd(0) & " isimli oyuncu sayı yaptı..", vbInformation, "1.Oyuncu Sayı Yaptı"
                        If mnuStandart(3).Checked = True Or mnuSureli(5).Checked = True Then Sonuc(0).Caption = Sonuc(0).Caption + 1
                        If mnuGeri_Sayim(4).Checked = True Then Sonuc(0).Caption = Sonuc(0).Caption - 1
        End If
        
    'Blokların vurması.
        'Sol oyuncu için.
        If Gidis = "SolA" And P1.Left = Picture1(0).Left + Picture1(0).Width And _
           ((P1.Top >= Picture1(0).Top And P1.Top <= Picture1(0).Top + Picture1(0).Height) Or _
            (P1.Top + P1.Height >= Picture1(0).Top And P1.Top + P1.Height <= Picture1(0).Top + Picture1(0).Height)) Then
                    Gidis = "SagA"
        ElseIf Gidis = "SolY" And P1.Left = Picture1(0).Left + Picture1(0).Width And _
               ((P1.Top >= Picture1(0).Top And P1.Top <= Picture1(0).Top + Picture1(0).Height) Or _
                (P1.Top + P1.Height >= Picture1(0).Top And P1.Top + P1.Height <= Picture1(0).Top + Picture1(0).Height)) Then
                    Gidis = "SagY"
        'Sağ oyuncu için.
        ElseIf Gidis = "SagY" And P1.Left + P1.Width = Picture1(1).Left And _
              ((P1.Top >= Picture1(1).Top And P1.Top <= Picture1(1).Top + Picture1(1).Height) Or _
               (P1.Top + P1.Height >= Picture1(1).Top And P1.Top + P1.Height <= Picture1(1).Top + Picture1(1).Height)) Then
                    Gidis = "SolY"
        ElseIf Gidis = "SagA" And P1.Left + P1.Width = Picture1(1).Left And _
              ((P1.Top >= Picture1(1).Top And P1.Top <= Picture1(1).Top + Picture1(1).Height) Or _
               (P1.Top + P1.Height >= Picture1(1).Top And P1.Top + P1.Height <= Picture1(1).Top + Picture1(1).Height)) Then
                    Gidis = "SolA"
        End If
        
    'Geri sayım için sonucun açıklanması.
        'Sol tarafın kazanması durumu.
        If mnuGeri_Sayim(4).Checked = True And Sonuc(0).Caption = 0 Then
            MsgBox txtAd(0) & " adlı oyuncu kazandı..", vbInformation, txtAd(0) & " kazandı.."
            Oyun_Türü_Reset
        'Sağ tarafın kazanması durumu.
        ElseIf mnuGeri_Sayim(4).Checked = True And Sonuc(1).Caption = 0 Then
            MsgBox txtAd(1) & " adlı oyuncu kazandı..", vbInformation, txtAd(1) & " kazandı.."
            Oyun_Türü_Reset
        End If
    End Sub
    
    'Gol sonrası oyunun durması ve başlatılmanın beklenmesi.
    Sub Reset()
        Rastgele_Top_Yerlesimi
        
        HS1.Enabled = True
        cmd.Caption = "B&aşla"
    End Sub
    
    'Kenara tam deyme için.
    Sub Kenara_Tam_Deyme()
        If P1.Top < Line1.Y1 Then P1.Top = Line1.Y1
        If P1.Top + P1.Height > Line2.Y1 Then P1.Top = Line2.Y1 - P1.Height
    End Sub
    
    'Alan kenarlarına değme sonucu hareketin uygulanması.
    Sub Dis_Kenarlara_Degme()
        If P1.Top = Line1.Y1 And Gidis = "SolY" Then
            Gidis = "SolA"
        ElseIf P1.Top = Line1.Y1 And Gidis = "SagY" Then
            Gidis = "SagA"
        ElseIf P1.Top + P1.Height = Line2.Y1 And Gidis = "SolA" Then
            Gidis = "SolY"
        ElseIf P1.Top + P1.Height = Line2.Y1 And Gidis = "SagA" Then
            Gidis = "SagY"
        End If
    End Sub
    
    'Sol ve sağ oyuncuların blokları yönetmesi.
    Sub Yonlendirme()
    'Sol oyuncu için.
        'w(Yukarı) tuşuna basınca.
        If GetAsyncKeyState(vbKeyW) <> 0 Then
            Picture1(0).Top = Picture1(0).Top - HS1.Value - Y / 2
        's(Aşağı)tuşuna basınca.
        ElseIf GetAsyncKeyState(vbKeyS) <> 0 Then
            Picture1(0).Top = Picture1(0).Top + HS1.Value + Y / 2
        End If
        
        If Picture1(0).Top < Line1.Y1 Then Picture1(0).Top = Line1.Y1
        If Picture1(0).Top + Picture1(0).Height > Line2.Y1 Then Picture1(0).Top = Line2.Y1 - Picture1(0).Height
    
    'Sağ oyuncu için.
        'Klavye den Yukarı ok tuşuna basılırsa.
        If GetAsyncKeyState(vbKeyUp) <> 0 Then
            Picture1(1).Top = Picture1(1).Top - HS1.Value - Y / 2
        'Klavye den aşağı ok tuşuna basılırsa.
        ElseIf GetAsyncKeyState(vbKeyDown) <> 0 Then
            Picture1(1).Top = Picture1(1).Top + HS1.Value + Y / 2
        End If
        
        If Picture1(1).Top < Line1.Y1 Then Picture1(1).Top = Line1.Y1
        If Picture1(1).Top + Picture1(1).Height > Line2.Y1 Then Picture1(1).Top = Line2.Y1 - Picture1(1).Height
    End Sub
    
    'Oyuncuların yönetimleri için.
    Private Sub Timer2_Timer()
        Yonlendirme
    End Sub
    
    'Süreli oyun için süre nin geri sayımı ve maçı bitirme.
    Private Sub Timer3_Timer()
    If mnuSureli(5).Checked = True And Süre = 0 Then
        If Sonuc(0) > Sonuc(1) Then
            MsgBox txtAd(0) & " adlı oyuncu kazandı.." & Chr(13) & "(" & Sonuc(0) & "-" & Sonuc(1) & ")", vbInformation, "Maç Bitti"
        ElseIf Sonuc(0) < Sonuc(1) Then
            MsgBox txtAd(1) & " adlı oyuncu kazandı.." & Chr(13) & "(" & Sonuc(0) & "-" & Sonuc(1) & ")", vbInformation, "Maç Bitti"
        Else
            MsgBox "Maç berabera bitti.." & Chr(13) & "(" & Sonuc(0) & "-" & Sonuc(1) & ")", vbInformation, "Maç Bitti"
        End If
    
        Hareket = 0
        Reset
        Sonuc(0).Caption = 0
        Sonuc(1).Caption = 0
        
        Oyun_Türü_Reset
    End If
    
    If mnuSureli(5).Checked = True And cmd.Caption = "Biti&r" Then
        Süre = Süre - 1
        lblSure.Caption = "Süre : " & Süre & " sn"
    End If
    End Sub
    
    'Ad girişi için tıklama ile text pencerelerin içerinin silinmesi.
    Private Sub txtAd_Click(Index As Integer)
        If Index = 0 Then txtAd(0).Text = ""
        If Index = 1 Then txtAd(1).Text = ""
    End Sub
    
    'Oyunu resetleme , ayarları varsayılan yapma.
    Sub Oyun_Türü_Reset()
        mnuStandart(3).Checked = True
        mnuGeri_Sayim(4).Checked = False
        mnuSureli(5).Checked = False
        txtAd(0).Locked = False
        txtAd(1).Locked = False
        Sonuc(0).Caption=0
        Sonuc(1).Caption=0
        Rastgele_Top_Yerlesimi
    End Sub
     
  2. Statuss

    Statuss Bilgiliyim rank8

    Kayıt:
    25 Haziran 2008
    Mesajlar:
    1.178
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    36
    Şehir:
    the wrong place
    Bu oyunları hangi programdan yapıyorsun
     
  3. belirsizzzzz

    belirsizzzzz Aileden rank8

    Kayıt:
    21 Aralık 2007
    Mesajlar:
    7.655
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    0
    Meslek:
    CeyRRANNCI
    Şehir:
    Tokyo /Y.t
    VB ile yapılıyor.
     
  4. Statuss

    Statuss Bilgiliyim rank8

    Kayıt:
    25 Haziran 2008
    Mesajlar:
    1.178
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    36
    Şehir:
    the wrong place
  5. Redefine

    Redefine Old School olduser rank8

    Kayıt:
    21 Kasım 2007
    Mesajlar:
    3.152
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    36
    Bi deniyelim bakalım ^^
     
  6. addIcFb

    addIcFb Aileden rank8

    Kayıt:
    22 Eylül 2007
    Mesajlar:
    5.376
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    0
    Meslek:
    öğrenci
    Şehir:
    Okul
    Sonuç ? Furkanım :popcorn:
     
  7. Redefine

    Redefine Old School olduser rank8

    Kayıt:
    21 Kasım 2007
    Mesajlar:
    3.152
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    36
    Daha birşey başarabilmiş değilim. :D
     
  8. emrullahekinci

    emrullahekinci Yeni üye rank8

    Kayıt:
    27 Kasım 2014
    Mesajlar:
    1
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    0
    usta hazır hali varmı?