Oto cały kod, który może działać pod każdą wersją Delphi od 4 to x Może ktoś pomóc w przerobieniu kodu tak by działał pod Delphi 3 ? Tu trzeba użyć dynamicznej tablicy a wiadomo ze w Delphi 1,2,3 nie ma takiej możliwosci ... Z gry dzięki :)
Oto znaleziony przeze mnie kod:
unit uSupport;
interface
const
BYE_GAME : Integer = -1;
type
TPair = Record
Home : Integer;
Away : Integer;
Round : Integer;
Desc : String;
End;
TPairings = Array of TPair;
procedure MakeSchedule (var Pairings : TPairings; iTeams : Integer);
implementation
procedure MakeSchedule (var Pairings : TPairings; iTeams : Integer);
var
bAddedBye : Boolean;
iGamesPerRound : Integer;
iRounds : Integer;
Teams : Array of Integer;
I,J : Integer;
iRound : Integer;
iTeam : Integer;
iGame : Integer;
iTotalGames : Integer;
iPair : Integer;
iLastTeam : Integer;
iSaveTeam : Integer;
Pair : TPair;
begin
{
Protect against the absurd.
}
If iTeams Exit;
{
Do we need to add a BYE game for each round?
}
If iTeams Mod 2 = 0 Then
bAddedBye := False
Else
Begin
bAddedBye := True;
iTeams := iTeams + 1;
End;
iRounds := iTeams - 1;
iGamesPerRound := iTeams Div 2;
{
Determine the total number of games
}
iTotalGames := iRounds * iGamesPerRound;
SetLength (Pairings,iTotalGames);
{
Create an array with all the teams except the first one.
}
SetLength (Teams,iTeams - 1);
iTeam := 1;
iLastTeam := iTeams - 2;
For I := 0 To iLastTeam Do
Begin
iTeam := iTeam + 1;
If bAddedBye And (iTeam = iTeams) Then
Teams [I] := BYE_GAME
Else
Teams [I] := iTeam;
End;
{
Rotate the teams through in a counter-clockwise fasion. Team one is always a
constant. The example below shows 10 teams
1-10 1-9 1-8 1-7 1-6 1-5 1-4 1-3 1-2
2-9 10-8 9-7 8-6 7-5 6-4 5-3 4-2 3-10
3-8 2-7 10-6 9-5 8-4 7-3 6-2 5-10 4-9
4-7 3-6 2-5 10-4 9-3 8-2 7-10 6-9 5-8
5-6 4-5 3-4 2-3 10-2 9-10 8-9 7-8 6-7
The team in the first position is the home team. Since team one is always the
home team, I will swap that team. I always list the BYE_GAME as the visitor.
}
iPair := 0;
For iRound := 1 To iRounds Do
Begin
iTeam := 0;
For iGame := 1 To iGamesPerRound Do
Begin
With Pairings [iPair] Do
Begin
Round := iRound;
Desc := '';
If iTeam = 0 Then
{
Alternate home games for team one. Force BYE_GAME to be the away team.
}
If (iRound Mod 2 = 0) And (Teams [iLastTeam] 0) Then
Begin
Home := Teams [iLastTeam];
Away := 1;
End
Else
Begin
Home := 1;
Away := Teams [iLastTeam];
End
Else
{
Make sure the BYE_GAME is the away game.
}
If Teams [iTeam - 1] 0 Then
Begin
Home := Teams [iTeam - 1];
Away := Teams [iLastTeam - iTeam];
End
Else
Begin
Home := Teams [iLastTeam - iTeam];
Away := Teams [iTeam - 1];
End;
End;
iTeam := iTeam + 1;
iPair := iPair + 1;
End;
{
Circulate the teams.
}
iSaveTeam := Teams [iLastTeam];
For I := iLastTeam DownTo 1 Do
Teams [I] := Teams [I - 1];
Teams [0] := iSaveTeam;
End;
{
Simple bubble sort to put the lowest Home team first
}
For I := 0 To iTotalGames - 1 Do
For J := I + 1 To iTotalGames - 1 Do
If (Pairings [J].Round = Pairings [I].Round) And
(Pairings [J].Home Begin
Pair := Pairings [J];
Pairings [J] := Pairings [I];
Pairings [I] := Pair;
End;
end;
end.
Here is a simple way to print the round robin schedule.
procedure TfrmMain.btnMakeScheduleClick(Sender: TObject);
var
Pairings : TPairings;
I,J : Integer;
iRounds : Integer;
begin
RichEdit1.Clear;
iRounds := StrToIntDef (edtRounds.Text,2);
MakeSchedule (Pairings,iRounds);
J := 0;
For I := Low (Pairings) To High (Pairings) Do
Begin
{
Different Round
}
If Pairings [I].Round J Then
Begin
J := Pairings [I].Round;
RichEdit1.Lines.Add ('Round ' + IntToStr (J));
End;
If Pairings [I].Away RichEdit1.Lines.Add (' Home : ' + IntToStr (Pairings [I].Home) + ' Away : BYE')
Else
RichEdit1.Lines.Add (' Home : ' + IntToStr (Pairings [I].Home) + ' Away : ' +
IntToStr (Pairings [I].Away));
End;
end;