5. Текст программы
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids;
type
TForm1 = class(TForm)
HeroList: TMemo;
Label1: TLabel;
StartButton: TButton;
StopButton: TButton;
ExitButton: TButton;
Timer: TTimer;
TrackBar: TTrackBar;
Progress: TProgressBar;
Label2: TLabel;
Hero1: TEdit;
Label3: TLabel;
Hero2: TEdit;
Label4: TLabel;
Res1: TLabel;
Res2: TLabel;
Label7: TLabel;
TimeM: TLabel;
ResGrid: TStringGrid;
SpeedBar: TTrackBar;
Label5: TLabel;
Label6: TLabel;
Guberniev: TRichEdit;
Label8: TLabel;
Label9: TLabel;
GameTable: TStringGrid;
LoadButton: TButton;
procedure TimerTimer(Sender: TObject);
procedure TrackBarChange(Sender: TObject);
procedure StartButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StopButtonClick(Sender: TObject);
procedure ExitButtonClick(Sender: TObject);
procedure LoadButtonClick(Sender: TObject);
procedure ResGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
Hero = record
score,battles,wins:integer;
name:string;
end;
var
Form1: TForm1;
TMin,TSec:integer;
GotWinner:boolean;
a:array[1..100] of Hero;
list:array[1..100] of Hero;
used:array[1..100,1..100] of boolean;
queue:array[1..10000] of integer;
Gbegin:array[1..10] of string;
Gmed:array[1..10] of string;
Gend:array[1..10] of string;
TT,tek1,tek2:integer;
n:integer;
ff:boolean;
implementation
{$R *.dfm}
procedure Solve;
var i,j:integer;
buf:Hero;
ss:string;
begin
{ResGRID}
for i:=1 to n do list[i]:=a[i];
for i:=n downto 2 do
for j:=1 to i-1 do
if (list[j].wins < list[i].wins)
or (list[j].wins=list[i].wins) and (list[j].score<list[i].score)
then
begin
buf := list[j];
list[j] := list[i];
list[i] := buf;
end;
for i:=1 to n do
begin
str(i,ss);
Form1.ResGrid.Cells[0,i]:=ss;
Form1.ResGrid.Cells[1,i]:=list[i].name;
str(list[i].battles,ss);
Form1.ResGrid.Cells[2,i]:=ss;
str(list[i].wins,ss);
Form1.ResGrid.Cells[3,i]:=ss;
str(list[i].score,ss);
Form1.ResGrid.Cells[4,i]:=ss;
end;
Form1.ResGrid.Cells[0,0]:='Место';
Form1.ResGrid.Cells[1,0]:='Имя';
Form1.ResGrid.Cells[2,0]:='Игр';
Form1.ResGrid.Cells[3,0]:='Побед';
Form1.ResGrid.Cells[4,0]:='Очки';
end;
Procedure MakePair;
begin
tek1:=random(n) + 1;
while (a[tek1].battles=n-1) do
begin
inc(tek1);
if (tek1>n) then tek1:=1;
end;
tek2:=random(n) + 1;
while (used[tek1][tek2]) do
begin
inc(tek2);
if (tek2>n) then tek2:=1;
end;
used[tek1][tek2]:=true;
used[tek2][tek1]:=true;
Form1.Hero1.Text:=a[tek1].name;
Form1.Hero2.Text:=a[tek2].name;
end;
Procedure comm_b;
begin
Form1.Guberniev.Text:=Form1.Guberniev.Text +
Gbegin[random(10)+1] + ' ' + a[tek1].name + ' против ' + a[tek2].name
+ #13 + #13;
Form1.Guberniev.Perform(wm_vscroll,sb_bottom,0)
end;
Procedure comm_e(p1,p2:integer);
var s1,s2:string;
begin
str(p1,s1);
str(p2,s2);
Form1.Guberniev.Text:=Form1.Guberniev.Text +
Gend[random(10)+1] + #13 + 'Окончательный счёт:' + #13
+ a[tek1].name + ' ' + s1 + ' ' +
a[tek2].name + ' ' + s2 + #13 + #13;
Form1.Guberniev.Perform(wm_vscroll,sb_bottom,0)
end;
Procedure comm_med;
var w:integer;
name:string;
begin
w:=random(2);
if w=0 then name:=a[tek1].name
else name:=a[tek2].name;
Form1.Guberniev.Text:=Form1.Guberniev.Text + name +
Gmed[random(10)+1] + #13 + #13;
Form1.Guberniev.Perform(wm_vscroll,sb_bottom,0)
end;
procedure TForm1.TimerTimer(Sender: TObject);
var s1,s2:string;
p1,p2,w:integer;
begin
if not GotWinner then
begin
w:=random(10000) + 1;
if (w mod 100 = 0) then comm_med;
progress.position := progress.position + SpeedBar.Position;
TSec:=TSec+SpeedBar.Position;
if (TSec>=60) then
begin
TSec:=0;
TMin:=TMin+1;
end;
str(TMin,s1);
str(TSec,s2);
if (length(s2)=1) then s2:='0' + s2;
TimeM.Caption:='Время: ' + s1 + ':' + s2;
if (progress.position >= progress.Max) then
begin
progress.position:=0;
TMin:=0;
TSec:=0;
p1:=random(15);
p2:=random(15);
w:=random(2);
if (w=0) then
begin
p1:=p1+10;
str(p1,s1);
str(p2,s2);
Res1.Font.Color:=clBlue;
Res2.Font.Color:=clRed;
rr[tek1,tek2]:=1;
rr[tek2,tek1]:=-1;
Form1.GameTable.Cells[tek2,tek1]:=s2 + ':' + s1;
Form1.GameTable.Cells[tek1,tek2]:=s1 + ':' + s2;
s1:='Победил ' + a[tek1].name + ' co cчётом ' + s1;
s2:='Проиграл ' + a[tek2].name + ' co cчётом ' + s2;
inc(a[tek1].wins);
end
else
begin
p2:=p2+10;
str(p1,s1);
str(p2,s2);
Res2.Font.Color:=clBlue;
Res1.Font.Color:=clRed;
rr[tek1,tek2]:=-1;
rr[tek2,tek1]:=1;
Form1.GameTable.Cells[tek2,tek1]:=s2 + ':' + s1;
Form1.GameTable.Cells[tek1,tek2]:=s1 + ':' + s2;
s2:='Победил ' + a[tek2].name + ' co cчётом ' + s2;
s1:='Проиграл ' + a[tek1].name + ' co cчётом ' + s1;
inc(a[tek2].wins);
end;
Res1.Caption:=s1;
Res2.Caption:=s2;
a[tek1].score := a[tek1].score + p1;
inc(a[tek1].battles);
a[tek2].score := a[tek2].score + p2;
inc(a[tek2].battles);
inc(TT);
str(p1,s1);
str(p2,s2);
Solve;
comm_e(p1,p2);
if (TT>n*(n-1)/2) then
begin
GotWinner:=true;
ff:=true;
MessageDlg('Соревнования окончились.' + #13 + 'Победил ' + list[1].name + '.',mtInformation,[mbOk],0);
end
else
begin
MakePair;
comm_b;
end;
end;
end;
end;
procedure TForm1.TrackBarChange(Sender: TObject);
begin
Timer.Interval:=1000 - TrackBar.Position * 20;
end;
Procedure Clear;
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
begin
rr[i,j]:=0;
GameTable.Cells[i,j]:='';
end;
end;
procedure TForm1.StartButtonClick(Sender: TObject);
var i,j,x:integer;
begin
Form1.ResGrid.RowCount:=0;
Form1.ResGrid.ColCount:=0;
Form1.GameTable.RowCount:=0;
Form1.GameTable.ColCount:=0;
Guberniev.Text:='';
for i:=0 to HeroList.Lines.Capacity - 1 do
begin
a[i+1].name:=HeroList.Lines[i];
a[i+1].score:=0;
a[i+1].battles:=0;
a[i+1].wins:=0;
end;
n:=HeroList.Lines.Capacity;
Clear;
if (n=0) then n:=1;
ResGrid.RowCount := n + 1;
ResGrid.ColCount := 5;
ResGrid.ColWidths[0]:=40;
ResGrid.ColWidths[1]:=150;
ResGrid.ColWidths[2]:=60;
ResGrid.ColWidths[3]:=60;
ResGrid.ColWidths[4]:=80;
ResGrid.Width:=400;
if (n>1) then
begin
ff:=false;
GotWinner:=false;
Solve;
{GameTABLE}
Form1.GameTable.ColCount:=n+1;
Form1.GameTable.RowCount:=n+1;
ResGrid.FixedCols:=1;
ResGrid.FixedRows:=1;
GameTable.FixedCols:=1;
GameTable.FixedRows:=1;
for i:=0 to n do
begin
Form1.GameTable.ColWidths[i]:=80;
Form1.GameTable.Cells[0,i]:=a[i].name;
Form1.GameTable.Cells[i,0]:=a[i].name;
end;
TT:=1;
for i:=1 to n do
for j:=1 to n do
used[i,j]:=false;
for i:=1 to n do used[i,i]:=true;
MakePair;
Comm_b;
end
else
MessageDlg('Количество спортсменов не может быть меньше 2', mtWarning, [mbOk],0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
ResGrid.ColCount := 5;
ResGrid.ColWidths[0]:=40;
ResGrid.ColWidths[1]:=150;
ResGrid.ColWidths[2]:=60;
ResGrid.ColWidths[3]:=60;
ResGrid.ColWidths[4]:=80;
ResGrid.Width:=400;
GameTable.ColCount := 5;
for i:=0 to 4 do GameTable.ColWidths[i]:=80;
end;
procedure TForm1.StopButtonClick(Sender: TObject);
begin
if Form1.StopButton.Caption='Стоп' then
begin
Form1.Timer.Enabled:=false;
Form1.StopButton.Caption:='Продолжить';
end
else
begin
Form1.Timer.Enabled:=true;
Form1.StopButton.Caption:='Стоп';
end;
end;
procedure TForm1.ExitButtonClick(Sender: TObject);
begin
if MessageDlg('Вы действительно хотите выйти?', mtInformation,
[mbYes,mbNo],0)=mrYes then
Form1.Close;
end;
procedure TForm1.LoadButtonClick(Sender: TObject);
begin
HeroList.Lines.LoadFromFile('in.txt');
end;
procedure TForm1.ResGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (ff) then
begin
if (ARow=1) then Form1.ResGrid.Canvas.Brush.Color:=clAqua;
if (ARow=2) then Form1.ResGrid.Canvas.Brush.Color:=clYellow;
if (ARow=3) then Form1.ResGrid.Canvas.Brush.Color:=clRed;
if (ARow<>0) and (ACol<>0) then
Form1.ResGrid.Canvas.FillRect(Rect);
Form1.ResGrid.Canvas.Font.Color:=clBlack;
Form1.ResGrid.Canvas.TextOut(Rect.Left+2,Rect.Top+2,
Form1.ResGrid.Cells[ACol,ARow]);
end;
end;
procedure TForm1.GameTableDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (rr[ACol,ARow]=1) then
Form1.GameTable.Canvas.Brush.Color:=clAqua
else
if (rr[acol,arow]=-1) then
Form1.GameTable.Canvas.Brush.Color:=clRed;
if (Arow<>0) and (acol<>0)
and (rr[Acol,arow]<>0)
then
begin
Form1.GameTable.Canvas.FillRect(rect);
Form1.GameTable.Canvas.Font.Color:=clBlack;
Form1.GameTable.Canvas.TextOut(Rect.Left+2,Rect.Top+2,
Form1.GameTable.Cells[ACol,ARow]);
end;
end;
begin
n:=4;
Gbegin[1]:='Игра обещает быть во многом захватывающей... Посмотрим.';
Gbegin[2]:='С вами я, Дмитрий Губерниев. А состязаться сейчас будут';
Gbegin[3]:='Битва за звание чемпиона по версии WWE.';
Gbegin[4]:='Титаны будут сотрясать эту бренную землю.';
Gbegin[5]:='Немедленно уберите от экранов слабонервных, беременных женщин и маленьких детей!';
Gbegin[6]:='Надежда русской вольной борьбы!';
Gbegin[7]:='Встречайте! Герои нашего времени!';
Gbegin[8]:='Во многом решающий для противников матч.';
Gbegin[9]:='Будет жарко...';
Gbegin[10]:='Да начнётся битва!';
Gend[1]:='Бой закончен.';
Gend[2]:='Победил сильнейший!';
Gend[3]:='Выдохни! Всё закончилось!';
Gend[4]:='Битва отшумела...';
Gend[5]:='Да здравствуют чемпионы!';
Gend[6]:='Да здравствует разум! Да сгинет маразм!';
Gend[7]:='Нет ничего невозможного!';
Gend[8]:='Противники были достойны друг друга, но...';
Gend[9]:='И вот он результат!';
Gend[10]:='Исход игры очень неожиданный.';
Gmed[1]:=' проводит опасный захват! неужели это победа?';
Gmed[2]:=' не так прост, как кажется! Хитро уселся на противника жмет его к полу.';
Gmed[3]:=' - это провал сезона. Я отказываюсь комментировать это неспортивное поведение!';
Gmed[4]:=' явно не хватает кальция! Я со своей рубки слышу, как у него хрустят кости!';
Gmed[5]:=' вновь поражает! Вырваться из столь сложного захвата! Мастерски!';
Gmed[6]:=' идёт к успеху, но бой еще не закончен.';
Gmed[7]:=' явно готовился к этому бою всю жизнь. Вы посмотрите на его атаки!';
Gmed[8]:=' нужно сделать лицо попроще. Хотя, находясь в таком захвате, это сделать...кгхм...проблематично.';
Gmed[9]:=' пора уносить с поля. Это уже провал.';
Gmed[10]:=' идёт к техничной, методической победе.';
Application.CreateForm(TForm1, Form1);
Solve;
GotWinner:=true;
end.