"Fikstür Yönetim Programı"nı bir iki hafta önce okulumuzdaki Altan hocamız istedi. Maçları o düzenliyor.  Bayağı internette aradıktan sonra ücretsiz bir program buldum. "Match Generator" adında basit bir program.

8-10-12 veya 16 takım için haftalık fikstür hazırlıyor. Ama bizim istediğimiz "en az 2 takım veya istediğimiz kadar" idi. Yani tek veya çift adet farketmeden…

Sitelerinde uzun aramalardan sonra bir Türk forum (galatasaray takımının) sitesinde "fikstür hazırlama mantığını" anlatan yazı buldum. Ondan sonrası kolay oldu. Normalde algoritması çok karışık geldi.

(Link: http://www.cimbom.org/forum/viewtopic.php?p=49099&sid=b08d0cf876c6c654905decfb7dd94fd9 )

yunus.sf.net sitemde programın "Microsoft Access" ile yapılmış hali vardır. Masa tenisi, futbol, basketbol farketmeden istenildiği kadar takım yapılabiliyor. Maçlar ve sonuçları takip edilebiliyor. Şimdilik "puanlama" kısmı yok. Onu da siz halledersiniz.

www.fixturelist.com sitesinde ise ücretsiz olarak fikstür hazırlama var. 4-32 takım arası için işinizi görebilir.

İşte kendi yaptığım Basic dilindeki ana program:

Private Sub Komut8_Click()
Dim kacOyuncuSecili, oynayacaklar, turu, grubu, filtreDeyimi, i, j, k

If Me.Dirty Then Me.Dirty = False
turu = Me.OyunTuru
grubu = Me.OyuncununGrubu
filtreDeyimi = "[secili]=True and [oyunturu]=’" & turu & "’ and [oyuncunungrubu]=" & grubu
kacOyuncuSecili = DCount("*", "oyuncular", filtreDeyimi)
oynayacaklar = kacOyuncuSecili
If kacOyuncuSecili Mod 2 = 1 Then oynayacaklar = oynayacaklar + 1
If kacOyuncuSecili > 1 Then
If MsgBox(kacOyuncuSecili & " Oyuncu/takım Seçilidir. " & vbCrLf & vbCrLf & "Fikstür Hazırlansın Mı?", vbYesNo + vbDefaultButton2, "Fisktür") = vbYes Then
Dim rs, rs2 As DAO.Recordset
Dim haftaMacSayisi, haftaSayisi, joker, sayac As Integer
Dim oyuncuListesi() As String
Dim macListesi(), jokerinListesi(), macSiraListesi()
Dim MacTuru, oyuncuListesif As String
ReDim oyuncuListesi(oynayacaklar, 3)
Set rs = CurrentDb().OpenRecordset("oyuncular", dbOpenDynaset)
Set rs2 = CurrentDb().OpenRecordset("maclar", dbOpenDynaset)
With rs
.FindFirst filtreDeyimi
For i = 1 To kacOyuncuSecili
oyuncuListesi(i, 1) = i
oyuncuListesi(i, 2) = 0
oyuncuListesi(i, 3) = rs![OyuncuAdiVeyaTakimAdi]
MacTuru = rs![OyunTuru]
oyuncuListesif = oyuncuListesif & vbCrLf & i & ". " & oyuncuListesi(i, 3)
.FindNext filtreDeyimi
Next
End With
If kacOyuncuSecili Mod 2 = 1 Then
oyuncuListesi(oynayacaklar, 1) = oynayacaklar
oyuncuListesi(oynayacaklar, 2) = 0
oyuncuListesi(oynayacaklar, 3) = "silinecek"
‘oyuncuListesif = oyuncuListesif & vbCrLf & oynayacaklar & ". " & oyuncuListesi(oynayacaklar, 3)
End If
rs.Close
If oynayacaklar Mod 2 = 0 Then haftaSayisi = oynayacaklar – 1 Else haftaSayisi = oynayacaklar
If oynayacaklar Mod 2 = 0 Then haftaMacSayisi = oynayacaklar 2 Else haftaMacSayisi = (oynayacaklar – 1) 2
MsgBox "Fikstür Tamamlandı!" & vbCrLf & vbCrLf & "Oynayacakların Listesi:" & vbCrLf & oyuncuListesif & vbCrLf & vbCrLf & "Oynanacak Hafta Sayısı: " & haftaSayisi & vbCrLf & vbCrLf & "Bir Haftadaki Maç Sayısı: " & haftaMacSayisi & vbCrLf & vbCrLf & "Toplam Yapılacak Maç Sayısı: " & (haftaSayisi * haftaMacSayisi)
ReDim macListesi(haftaSayisi, haftaSayisi, 2) ‘ maçların dizisi
ReDim macSiraListesi(oynayacaklar – 1, oynayacaklar – 1) ‘ maç sıra listesi
ReDim jokerinListesi(oynayacaklar – 1)
joker = Int(oyuncuListesi(oynayacaklar, 1))
sayac = 0
For i = 1 To oynayacaklar – 1
‘ jokerin maçları tekler
If i Mod 2 = 1 Then
sayac = sayac + 1
jokerinListesi(i) = sayac
End If
Next i
For i = 1 To oynayacaklar – 1
‘ jokerin maçları çiftler
If i Mod 2 = 0 Then
sayac = sayac + 1
jokerinListesi(i) = sayac
End If
Next i
sayac = 0
Dim yeri
‘ oyuncu sıralarına göre maç listesi
For j = 1 To haftaSayisi ‘ satır döngüsü
For k = 1 To haftaSayisi
If k = j Then
yeri = k: Exit For
End If
Next k
For i = 1 To haftaSayisi ‘ sütun döngüsü
If i + sayac <= haftaSayisi Then
If i = yeri Then
macSiraListesi(j, i + sayac) = joker ‘joker ile oynarsa
Else
macSiraListesi(j, i + sayac) = i
End If
Else
If i = yeri Then
macSiraListesi(j, ((i + sayac) Mod joker) + 1) = joker ‘joker ile oynarsa
Else
macSiraListesi(j, ((i + sayac) Mod joker) + 1) = i
End If
End If
Next i
sayac = sayac + 1
Next j
For i = 1 To haftaSayisi ‘ 6 kişi için 5 hafta maç
For j = 1 To haftaSayisi ‘ 5 X 5 liste
If i < macSiraListesi(i, j) Then
macListesi(j, i, 1) = i
macListesi(j, i, 2) = macSiraListesi(i, j)
End If
Next j
Next i
For j = 1 To haftaSayisi ‘ maclar tablosuna kayıt
For i = 1 To haftaSayisi
If macListesi(j, i, 1) <> "" Then
If oyuncuListesi(macListesi(j, i, 1), 3) <> "silinecek" Then
If oyuncuListesi(macListesi(j, i, 2), 3) <> "silinecek" Then
rs2.AddNew
rs2![IlkOyuncuVeyaTakim] = oyuncuListesi(macListesi(j, i, 1), 3)
rs2![IkinciOyuncuVeyaTakim] = oyuncuListesi(macListesi(j, i, 2), 3)
rs2![MacHaftasi] = j
rs2![MacTuru] = MacTuru
rs2.Update
End If
End If
End If
Next i
Next j
rs2.Close
Set rs = Nothing
Set rs2 = Nothing
End If ‘ vbYes
Set rs = Nothing
End If ‘ oynayacaklar > 1
End Sub

Link:

www.fixturelist.com

http://downloads.sourceforge.net/yunus/fix5.zip?use_mirror=osdn 

http://www.cimbom.org/forum/viewtopic.php?p=49099&sid=b08d0cf876c6c654905decfb7dd94fd9