Menu
Yeni Mesajlar



Reklam anlaşmaları ile ilgili bilgi almak için tıklayın!


B

Black Rain

rank8
Kayıt
17 Kasım 2007
Mesajlar
10.379
Beğeniler
2
Şehir
istanbul / bomonti
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
 
Mesaj yazabilmek için giriş yapmalısınız
Yukarı Alt