VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "StraightSeeding"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Implements Seeding
Private sd As Seeding
Private laneOrder As Collection
Private count As Integer
Private sw As Collection
Private numLanes As Integer
Private numheats As Integer
'-----
Private Sub Class_Initialize()
  Set sd = New Seeding
End Sub
'-----
Private Function Seeding_calcLaneOrder(lanes As Integer) As Collection
End Function
'-----
Private Function Seeding_getCount() As Integer
End Function
'-----
Private Function Seeding_getHeat() As Integer
End Function
'-----
Private Function Seeding_getHeats() As Integer
  Seeding_getHeats = numheats
End Function
'-----
Private Function Seeding_getSeeding() As Collection
  Set Seeding_getSeeding = sw
End Function
'-----
Private Function Seeding_getSwimmers() As Collection
  Set Seeding_getSwimmers = sw
End Function
'-----
Private Sub Seeding_seed()
  Dim lastHeat As Integer, lastlanes As Integer
  Dim heats As Integer, i As Integer, j As Integer
  Dim swmr As Swimmer
  
  Set sw = sd.sort(sw)
  Set laneOrder = sd.calcLaneOrder(numLanes)
  count = sw.count
  lastHeat = count Mod numLanes
  If (lastHeat < 3) And lastHeat > 0 Then
    lastHeat = 3                  'W ostatnim wyścigu musi wystartować co najmniej 3
  End If
  count = sw.count
  lastlanes = count - lastHeat
  numheats = lastlanes / numLanes
  If (lastHeat > 0) Then
    numheats = numheats + 1
  End If
  heats = numheats
  
  'Umieść numer wyścigu oraz toru w obiekcie Swimmer
  j = 1
  For i = 1 To lastlanes
    Set swmr = sw(i)
    swmr.setLane (laneOrder(j))
    j = j + 1
    swmr.setHeat (heats)
    If (j > numLanes) Then
      heats = heats - 1
      j = 1
    End If
  Next i
  
  'Utwórz częściowo obsadzony ostatni wyścig
  If (lastHeat > 0) Then
    If j > 1 Then
      heats = heats - 1
    End If
    j = 1
    For i = lastlanes + 1 To count
      Set swmr = sw(i)
      swmr.setLane laneOrder(j)
      j = j + 1
      swmr.setHeat (heats)
    Next i
  End If
End Sub
'-----
Private Sub Seeding_init(swmrs As Collection, lanes As Integer)
  Set sw = swmrs
  numLanes = lanes
End Sub
'-----
Public Function getHeats() As Integer
  getHeats = numheats
End Function
'-----
Private Function Seeding_sort(sw As Collection) As Collection
End Function
