if (player=2) and (bones[3]<>0) and (mas[13,2]=15) then blf:=1;
ablemove(sender);
varbones(sender);
if (bones[1]=0) and (main.bones[2]=0) and (bones[3]=0) and (bones[4]=0) then begin
messagedlg('Вы не можете походиться!',mtinformation,[mbok],0);
end;
end;
for i:=1 to 26 do
for j:=1 to 2 do mas2[i,j]:=mas[i,j];
for i:=1 to 4 do bones2[i]:=bones[i];
end else messagedlg('Ходнезавершен!',mtinformation,[mbok],0)
end;
procedure move(Sender: TObject; number1:integer);
var i,k:integer;
begin
if (nomer=1) and (mas[nomer,1]=1) then golova:=2;
if (nomer=1) and (mas[nomer,1]=1) and (wf=1) then begin
golova:=1;
wf:=0;
end;
if (nomer=13) and (mas[nomer,1]=2) then golova:=2;
if (nomer=13) and (mas[nomer,1]=2) and (blf=1) then begin
golova:=1;
blf:=0;
end;
mas[nomer,2]:=mas[nomer,2]-1;
mas[number1,1]:=player;
mas[number1,2]:=mas[number1,2]+1;
if mas[nomer,2]=0 then mas[nomer,1]:=0;
draw.visible(sender);
draw.redraw(sender);
k:=number1-nomer;
if k<1 then k:=k+24;
i:=0;
repeat
i:=i+1;
if main.bones[i]=k then begin
main.bones[i]:=0;
k:=0;
end;
until k=0;
varbones(sender);
end;
procedure movehouse(Sender: TObject; number2,zar:integer);
begin
main.bones[zar]:=0;
mas[number2,2]:=mas[number2,2]+1;
mas[nomer,2]:=mas[nomer,2]-1;
if mas[nomer,2]=0 then mas[nomer,1]:=0;
draw.visible(sender);
draw.redraw(sender);
varbones(sender);
if (player=1) and (mas[25,2]=15) then begin
messagedlg('Игра закончена! Белые победили!',mtinformation,[mbok],0);
exit;
end ;
if (player=2) and (mas[26,2]=15) then begin
messagedlg('Игра закончена! Черные победили!',mtinformation,[mbok],0);
exit;
end;
end;
end.
Модуль DRAW содержит процедуры отображения игрового процесса
usesmain;
procedure visible(Sender: TObject);
begin
with form1 do begin
m1.Visible:=false;
…
m24.Visible:=false;
wdomclick.Visible:=false;
bldomclick.Visible:=false;
end;
end;
procedure arrow(Sender: TObject; number:integer);
begin
with form1 do
case number of
1: begin
m1.Visible:=true;
if mas[1,2]=0 then begin
m1.Left:=n1.Left;
m1.Top:=n1.Top;
end else begin
m1.Left:=n1.Left;
m1.Top:=n1.Top-20;
end;
end;
…
26: begin
bldomclick.Visible:=true;
if mas[26,2]=0 then begin
bldomclick.Left:=bldom.Left;
bldomclick.Top:=bldom.Top;
end else begin
bldomclick.Left:=bldom.Left;
bldomclick.Top:=bldom.Top-20;
end;
end;
end;
end;
procedure redraw(sender: TObject);
var i:integer;
pic:tpicture;
begin
with form1 do
for i:=1 to 26 do begin
if mas[i,1]=0 then
case i of
1: n1.Visible:=false;
…
26: bldom.Visible:=false;
end else begin
case i of
1: n1.Visible:=true;
…
26: bldom.Visible:=true;
end;
if mas[i,1]=1 then
case mas[i,2] of
0: pic:=picpusto.Picture;
…
15: pic:=w15.Picture;
end;
if mas[i,1]=2 then
case mas[i,2] of
0: pic:=picpusto.Picture;
…
15: pic:=bl15.Picture;
end;
case i of
1: n1.Picture:=pic;
…
26: bldom.Picture:=pic;
end;
end;
end;
end;
procedure varbones(sender: Tobject);
var pic:tpicture;
i:integer;
begin
with form1 do
for i:=1 to 4 do begin
case bones[i] of
0: pic:=picpusto.Picture;
…
6: pic:=image8.picture;
end;
case i of
1: v1.picture:=pic;
…
4: v4.picture:=pic;
end;
end;
end;
end.
Модуль LOAD содержит форму загрузки сохраненной игры
uses main, draw;
{$R *.dfm}
procedure TForm3.SpeedButton2Click(Sender: TObject);
begin
form3.Close;
end;
procedure TForm3.SpeedButton1Click(Sender: TObject);
var i,j:integer;
begin
if listbox1.Items.Count=0 then begin
form3.Close;
exit;
end;
form1.memo_save.Clear;
form1.memo_save.Lines.LoadFromFile(path+'\saves\'+listbox1.Items[listbox1.itemindex]+'.sav');
with form1 do begin
i:=0;
status:=strtoint(memo_save.Lines[i]);
i:=1;
player:=strtoint(memo_save.Lines[i]);
i:=2;
for j:=1 to 4 do begin
main.bones[j]:=strtoint(memo_save.Lines[i]);
i:=i+1;
end;
for j:=1 to 26 do begin
mas[j,1]:=strtoint(memo_save.Lines[i]);
i:=i+1;
end;
for j:=1 to 26 do begin
mas[j,2]:=strtoint(memo_save.Lines[i]);
i:=i+1;
end;
golova:=strtoint(memo_save.Lines[i]);
i:=i+1;
z1:=strtoint(memo_save.Lines[i]);
i:=i+1;
z2:=strtoint(memo_save.Lines[i]);
case z1 of
1: leftbone.Picture:=b1.Picture;
…
6: leftbone.Picture:=b6.Picture;
end;
case z2 of
1: rightbone.Picture:=b1.Picture;
…
6: rightbone.Picture:=b6.Picture;
end;
draw.visible(sender);
draw.redraw(sender);
varbones(sender);
end;
form3.Close;
end;
procedure TForm3.FormActivate(Sender: TObject);
var
s:string;
SearchRec: TSearchRec;// структура SearchRec содержит информацию
// о файле, удовлетворяющем условию поиска
begin
ListBox1.Clear;
// сформировать список sav файлов
if FindFirst(Path+'\saves\' + '*.sav', faAnyFile, SearchRec) =0 then
begin
// в каталоге есть файл с расширением sav
// добавим имя этого файла в список
s:=searchrec.Name;
Delete(s, length(S)-3,4);
ListBox1.Items.Add(s);
// есть еще sav-файлы ?
while (FindNext(SearchRec) = 0) do begin
s:=searchrec.Name;
Delete(s, length(S)-3,4);
ListBox1.Items.Add(s);
end;
end;
ListBox1.ItemIndex := 0;
if listbox1.Items.Count=0 then begin
messagedlg('Нет сохраненной игры',mtinformation,[mbok],0);
form3.Close;
end;
form1.bones_click.Enabled:=true;
end;
end.
Модуль SAVE содержит форму сохранения игры
uses main;
{$R *.dfm}
procedure TForm2.SpeedButton1Click(Sender: TObject);
begin
form1.memo_save.Lines.SaveToFile(path+'\saves\'+saveedit.Text+'.sav');
form2.Close;
end;
procedure TForm2.SpeedButton2Click(Sender: TObject);
begin
form2.Close;
end;
procedure TForm2.FormShow(Sender: TObject);
var i:integer;
begin
with form1 do begin
memo_save.Clear;
memo_save.Lines.Add(inttostr(status));
memo_save.Lines.Add(inttostr(player));
for i:=1 to 4 do memo_save.Lines.Add(inttostr(bones[i]));
for i:=1 to 26 do memo_save.Lines.Add(inttostr(mas[i,1]));
for i:=1 to 26 do memo_save.Lines.Add(inttostr(mas[i,2]));
memo_save.Lines.Add(inttostr(golova));
memo_save.Lines.Add(inttostr(z1));
memo_save.Lines.Add(inttostr(z2));
end;
end;
end.
Модуль EXIT содежит форму подтверждения выхода из программы
uses main, start;
{$R *.dfm}
procedure TForm4.SpeedButton1Click(Sender: TObject);
begin
form7.Close;
end;
procedure TForm4.SpeedButton2Click(Sender: TObject);
begin
form4.Close;
end;
end.