- Ağdan Karşılıklı Oynanabilen XOX Oyunu

'GEREKLİ NESNELER:
'Command1,Command2,Command3,Command4,Command5
'8 adet Label1 index numaraları 0-1-2-3-4-5-6-7-8 olacak şekilde
'Label2,Label3,Label4,Label5,Label6,Label7
'Winsock1,Winsock2
'RichTextBox1
'Text1
'NASIL ÇALIŞIR?
'Gönderilen bilginin ilk 5 harfi komut kalan kısmı ise işlemdir
'Örneğin oynan2 bu mesajın komutu oynan işlemi 2 dir oyuncunun 2 numaralı labele oynadığını bildirir
'Oynanan labelin index numarasıdır.

Private Sub Command1_Click()
Dim isim
isim = InputBox("Adınızı girin", "İsim", Winsock1.LocalHostName)

If isim = "" Then Exit Sub
Label2 = isim

Winsock1.LocalPort = 2004
Winsock1.Listen

Label6 = "Bağlantı bekleniyor..."
Label7 = "sunucu"
Text1.ForeColor = vbBlue

Command1.Enabled = False
Command2.Enabled = False
End Sub

Private Sub Command2_Click()
On Error Resume Next
Dim isim, adres
isim = InputBox("Adınızı girin", "isim", Winsock2.LocalHostName)
If isim = "" Then Exit Sub
Label3 = isim

adres = InputBox("IP adresini yada bilgisayar adını girin", "IP", Winsock2.LocalIP)
If adres = "" Then Exit Sub
Winsock2.Connect adres, 2004

Label6 = "Bağlanıyor..."
Label7 = "istemci"
Text1.ForeColor = vbYellow

Command2.Enabled = False
Command1.Enabled = False

If Error <> "" Then
MsgBox "Hata " & Error, vbCritical, "HATA"
Command3_Click
End If

End Sub

Private Sub Command3_Click()
Winsock1.Close
Winsock2.Close
Label6 = "Ağ dan çıkıldı"
Label7 = "-"
Command1.Enabled = True
Command2.Enabled = True
Label2 = "X"
Label3 = "O"
Label4 = 0
Label5 = 0
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Command5_Click()
'yeni oyun başlat önce labelleri boşalt
Command5.Enabled = False
Dim say
For say = 0 To 8
Label1(say) = ""
Label1(say).Enabled = True
Next

'yeni oyun için karşı tarafa mesaj gönderiliyor...
Label6 = "Sıra sizde.."
Winsock1.SendData "yenio"
End Sub

Private Sub Form_Load()
'Nesneler yerleştiriliyor...
Command1.Caption = "Sunucu"
Command2.Caption = "İstemci"
Command3.Caption = "Ağdan Çık"
Command4.Caption = "Kapat"

Command1.Top = 0
Command2.Top = 0
Command3.Top = 0
Command4.Top = 0

Command1.Width = 975
Command2.Width = 975
Command3.Width = 975
Command4.Width = 975

Command1.Height = 495
Command2.Height = 495
Command3.Height = 495
Command4.Height = 495

Command1.Left = 0
Command2.Left = 960
Command3.Left = 1920
Command4.Left = 2880

Command5.Left = 1200
Command5.Top = 2640
Command5.Width = 1455
Command5.Height = 375

Command5.Enabled = False
Command5.Default = True

Label2.Left = 0
Label2.Top = 720
Label2.Width = 1695
Label2.Height = 255
Label2.FontBold = True
Label2.FontSize = 10
Label2.ForeColor = vbBlue
Label2.FontUnderline = True

Label3.Left = 1920
Label3.Top = 720
Label3.Width = 1695
Label3.Height = 255
Label3.FontBold = True
Label3.FontSize = 10
Label3.ForeColor = vbYellow
Label3.FontUnderline = True

Label2 = "X"
Label3 = "O"

Label4.Left = 120
Label4.Top = 1080
Label4.Width = 975
Label4.Height = 255
Label4.FontBold = True
Label4.FontSize = 12
Label4.ForeColor = vbGreen

Label5.Left = 2760
Label5.Top = 1080
Label5.Width = 975
Label5.Height = 255
Label5.FontBold = True
Label5.FontSize = 12
Label5.ForeColor = vbGreen

Label4 = 0
Label5 = 0

Label6 = "Durum..."
Label7 = "-"

Label6.Left = 0
Label6.Top = 4320
Label6.Width = 3015
Label6.Height = 255
Label6.BorderStyle = 1

Label7.Left = 3000
Label7.Top = 4320
Label7.Width = 855
Label7.Height = 255
Label7.BorderStyle = 1

Form1.Width = 3945
Form1.Height = 4965

Text1.Left = 0
Text1.Top = 3960
Text1.Width = 3855
Text1.Height = 285
Text1.ForeColor = vbYellow
Text1.BackColor = vbBlack

RichTextBox1.BackColor = vbBlack
RichTextBox1.Locked = True
RichTextBox1.Left = 0
RichTextBox1.Width = 3855
RichTextBox1.Height = 855
RichTextBox1.Top = 3120

Dim say
For say = 0 To 8
Label1(say).Height = 495
Label1(say).Width = 495
Next

Label1(0).Top = 1080
Label1(1).Top = 1080
Label1(2).Top = 1080

Label1(3).Top = 1560
Label1(4).Top = 1560
Label1(5).Top = 1560

Label1(6).Top = 2040
Label1(7).Top = 2040
Label1(8).Top = 2040

Label1(0).Left = 1200
Label1(3).Left = 1200
Label1(6).Left = 1200

Label1(1).Left = 1680
Label1(4).Left = 1680
Label1(7).Left = 1680

Label1(2).Left = 2160
Label1(5).Left = 2160
Label1(8).Left = 2160

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Label1_Click(Index As Integer)
If Label1(Index) = "" Then
'Label boşsa
'oyunan labelin index numarasını karşı tarafa yolla
Dim mesaj
mesaj = "oynan" & Index

If Label7 = "sunucu" Then

'oyuncu sunucu ise
Label1(Index) = "X"
Label1(Index).ForeColor = vbBlue
Winsock1.SendData mesaj
Label6 = "Sıra " & Label2 & " de."

Else

'oyuncu istemci ise
Label1(Index) = "O"
Label1(Index).ForeColor = vbYellow
Winsock2.SendData mesaj
Label6 = "Sıra " & Label3 & " de."

End If

'Boş labelleri tıklanmaması için pasif yap.
Dim say
For say = 0 To 8
If Label1(say) = "" Then
Label1(say).Enabled = False
End If
Next

'durumu kontrol et fonksiyonu
kontrol
End If

End Sub

Private Sub kontrol()
'Bu fonksiyon hangi oyuncunun kazandığını tespit eder

'0 1 2
'3 4 5
'6 7 8

Dim sonuc, say
sonuc = 0
'X in durumu

If Label1(0) = "X" And Label1(1) = "X" And Label1(2) = "X" Then Label1(0).ForeColor = vbRed: Label1(1).ForeColor = vbRed: Label1(2).ForeColor = vbRed: sonuc = 1
If Label1(3) = "X" And Label1(4) = "X" And Label1(5) = "X" Then Label1(3).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(5).ForeColor = vbRed: sonuc = 1
If Label1(6) = "X" And Label1(7) = "X" And Label1(8) = "X" Then Label1(6).ForeColor = vbRed: Label1(7).ForeColor = vbRed: Label1(8).ForeColor = vbRed: sonuc = 1

If Label1(0) = "X" And Label1(3) = "X" And Label1(6) = "X" Then Label1(0).ForeColor = vbRed: Label1(3).ForeColor = vbRed: Label1(6).ForeColor = vbRed: sonuc = 1
If Label1(1) = "X" And Label1(4) = "X" And Label1(7) = "X" Then Label1(1).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(7).ForeColor = vbRed: sonuc = 1
If Label1(2) = "X" And Label1(5) = "X" And Label1(8) = "X" Then Label1(2).ForeColor = vbRed: Label1(5).ForeColor = vbRed: Label1(8).ForeColor = vbRed: sonuc = 1

If Label1(0) = "X" And Label1(4) = "X" And Label1(8) = "X" Then Label1(0).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(8).ForeColor = vbRed: sonuc = 1
If Label1(2) = "X" And Label1(4) = "X" And Label1(6) = "X" Then Label1(2).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(6).ForeColor = vbRed: sonuc = 1

If sonuc = 1 Then
'Eğer üçlü varsa puan ekle
Label4 = Val(Label4) + 1
Label6 = Label2 & " kazandı."

'boş labelleri pasifleştir
For say = 0 To 8
If Label1(say) = "" Then Label1(say).Enabled = False
Next

'Eğer bu oyuncu sunucu ise command5 i aktif yap
If Label7 = "sunucu" Then Command5.Enabled = True
Exit Sub

End If

sonuc = 0

If Label1(0) = "O" And Label1(1) = "O" And Label1(2) = "O" Then Label1(0).ForeColor = vbRed: Label1(1).ForeColor = vbRed: Label1(2).ForeColor = vbRed: sonuc = 1
If Label1(3) = "O" And Label1(4) = "O" And Label1(5) = "O" Then Label1(3).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(5).ForeColor = vbRed: sonuc = 1
If Label1(6) = "O" And Label1(7) = "O" And Label1(8) = "O" Then Label1(6).ForeColor = vbRed: Label1(7).ForeColor = vbRed: Label1(8).ForeColor = vbRed: sonuc = 1

If Label1(0) = "O" And Label1(3) = "O" And Label1(6) = "O" Then Label1(0).ForeColor = vbRed: Label1(3).ForeColor = vbRed: Label1(6).ForeColor = vbRed: sonuc = 1
If Label1(1) = "O" And Label1(4) = "O" And Label1(7) = "O" Then Label1(1).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(7).ForeColor = vbRed: sonuc = 1
If Label1(2) = "O" And Label1(5) = "O" And Label1(8) = "O" Then Label1(2).ForeColor = vbRed: Label1(5).ForeColor = vbRed: Label1(8).ForeColor = vbRed: sonuc = 1

If Label1(0) = "O" And Label1(4) = "O" And Label1(8) = "O" Then Label1(0).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(8).ForeColor = vbRed: sonuc = 1
If Label1(2) = "O" And Label1(4) = "O" And Label1(6) = "O" Then Label1(2).ForeColor = vbRed: Label1(4).ForeColor = vbRed: Label1(6).ForeColor = vbRed: sonuc = 1

If sonuc = 1 Then
'Eğer üçlü varsa puan ekle
Label5 = Val(Label5) + 1
Label6 = Label3 & " kazandı."

'Boş labelleri pasif yap
For say = 0 To 8
If Label1(say) = "" Then Label1(say).Enabled = False
Next

If Label7 = "sunucu" Then Command5.Enabled = True
Exit Sub

End If

'Tüm labelleri kontrol et
sonuc = 1
For say = 0 To 8
If Label1(say) = "" Then
sonuc = 0
Exit For
End If
Next

'Eğer tüm labeller dolu ise berabere biter
If sonuc = 1 And Label7 = "sunucu" Then Command5.Enabled = True: Label6 = "Oyun berabere kaldı"

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Text1 <> "" Then
'Entere basıldıysa mesaj gönder
If Label7 = "sunucu" Then
'Oyuncu suncu ise rengi değiştir
RichTextBox1.SelColor = vbBlue
Else
RichTextBox1.SelColor = vbYellow
End If

'Mesajı ekle en alt satıra git
RichTextBox1.SelText = Chr(13) & Chr(10) & Text1
RichTextBox1.SelStart = Len(RichTextBox1.Text)

Dim mesaj
mesaj = "mesaj" & Text1

'Eğer winscok bağlı ise mesajı gönder
If Winsock1.State = 7 Then
Winsock1.SendData mesaj
End If

If Winsock2.State = 7 Then
Winsock2.SendData mesaj
End If

Text1 = ""
End If

End Sub

Private Sub Winsock1_Close()
MsgBox "Bağlantı kesildi", vbCritical, "Hata"
Command3_Click
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID
'Bağlantıyı kabul et
Label6 = Winsock1.RemoteHostIP & "Bağlandı"

Dim mesaj
mesaj = "ismin" & Label2
Winsock1.SendData mesaj
'Karşı tarafın ismini sor kendi ismini gönder
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim gelen As String, komut, ifade, mesaj, say

Winsock1.GetData gelen
'Mesajı al

'Mesajın komut ve işlem kısmını ayır
komut = Left(gelen, 5)
ifade = Mid(gelen, 6, Len(gelen))

Select Case komut

Case "ismim":
'ismi al
Label3 = ifade
Command5.Enabled = True

Case "oynan":
'Oynan noktaya yerleştir
Label1(ifade) = "O"
Label1(ifade).ForeColor = vbYellow
Label6 = "Sıra sizde.."
For say = 0 To 8
Label1(say).Enabled = True
Next

kontrol

Case "mesaj"
'mesajı al
RichTextBox1.SelColor = vbYellow
RichTextBox1.SelText = Chr(13) & Chr(10) & ifade
RichTextBox1.SelStart = Len(RichTextBox1.Text)

End Select
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox "Bağlantı hatası" & Description, vbCritical, "Hata"
Command3_Click
End Sub

Private Sub Winsock2_Close()
MsgBox "Bağlantı kesildi", vbCritical, "Hata"
Command3_Click
End Sub

Private Sub Winsock2_Connect()
Label6 = "Bağlantı sağlandı"
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
Dim gelen As String, komut, ifade, mesaj, say

Winsock2.GetData gelen
'mesajı al
'mesajı ayrıştır
komut = Left(gelen, 5)
ifade = Mid(gelen, 6, Len(gelen))

Select Case komut

Case "ismin":
'Sunucunun adını al kendi ismini yolla
Label2 = ifade
mesaj = "ismim" & Label3
Winsock2.SendData mesaj

Case "oynan":
'sunucu oynadı
Label1(ifade) = "X"
Label1(ifade).ForeColor = vbBlue
Label6 = "Sıra sizde.."
For say = 0 To 8
Label1(say).Enabled = True
Next

kontrol

Case "yenio":
'yeni oyun talebi
For say = 0 To 8
Label1(say) = ""
Label1(say).Enabled = False
Next
Label6 = "Sıra " & Label2 & " de"

Case "mesaj"
'mesajı al
RichTextBox1.SelColor = vbBlue
RichTextBox1.SelText = Chr(13) & Chr(10) & ifade
RichTextBox1.SelStart = Len(RichTextBox1.Text)

End Select

End Sub

Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox "Bağlantı hatası " & Description, vbCritical, "Hata"
Command3_Click
End Sub

Yazar: Turk_Ajan

Biraz Uzun oldu Ama idare edin