myamanda

博客园 首页 新随笔 联系 订阅 管理
通过使用Delphi动态数组,数组大小不是在设计时而是在运行时确定的。
此处是用于建立循环赛程安排的单元,

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
  {
    防止低级错误
  }
  If iTeams < 2 Then
    Exit;
  {
是否每次都有一场轮空?
  }
  If iTeams Mod 2 = 0 Then
    bAddedBye := False
  Else
  Begin
    bAddedBye := True;
    iTeams := iTeams + 1;
  End;
  iRounds := iTeams - 1;
  iGamesPerRound := iTeams Div 2;
  {
确定比赛总场数
  }
  iTotalGames := iRounds * iGamesPerRound;
  SetLength (Pairings,iTotalGames);
  {
为除第一队外的所有队伍建立数组。
  }
  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;
  {
按逆时针方向使队伍循环。第一队保持不变。下面的例子示范10支队伍的情形。
    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

处于第一位的是主队。因为第一队总是主队,所以我会交换那支队伍。我通常在表中把轮空当成是一支客队。
  }
  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
          {
      把第一队换成主场,强行使轮空当成是客队。
          }
          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
        {
          保证轮空是客队。
        }
          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;
    {
      使队伍循环
    }
    iSaveTeam := Teams [iLastTeam];
    For I := iLastTeam DownTo 1 Do
      Teams [I] := Teams [I - 1];
    Teams [0] := iSaveTeam;
  End;
  {
用浮泡排序法把最低的主队放在前面。
  }
  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 < Pairings [I].Home) Then
      Begin
        Pair := Pairings [J];
        Pairings [J] := Pairings [I];
        Pairings [I] := Pair;
      End;
end;

end.


这里给出打印循环赛程的简易方法。

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
    {
      另一轮比赛
    }
    If Pairings [I].Round <> J Then
    Begin
      J := Pairings [I].Round;
      RichEdit1.Lines.Add ('Round ' + IntToStr (J));
    End;
    If Pairings [I].Away < 1 Then
      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;
posted on 2009-08-05 11:34  myamanda  阅读(256)  评论(0)    收藏  举报