Рисунок 14 – Сообщение о победе.
В ходе курсового проектирования была разработана игровая программа «Нарды».
Данная программа является аналогом популярной настольной игры, содержит подробную справку о правилах игры, а также автоматический механизм слежения за их соблюдением, поэтому даже неопытный пользователь может без проблем играть в нарды.
Решение задачи получено с помощью методов нелинейного программирования.
Программным решением была выбрана: среда программирования BorlandDelphi 7. Используемые средства разработки позволили создать качественный программный продукт, который можно использовать в развлекательных и развивающих целях.
В процессе создания программы использовались приложения:
- Adobe Photoshop CS3;
- Microsoft FrontPage 2003;
- Microsoft Office Word 2003;
- Adobe Indesign CS3.
Возможна модернизация интерфейса программы в виде дополнительных цветовых схем, а также создание технологии клиент-сервер для игры в локальных сетях и искусственного интеллекта различных уровней сложности для возможности однопользовательской игры.
Разработанная программа обладает следующими свойствами:
- простота в использовании;
- имеет наглядный и понятный интерфейс;
- позволяет сохранять и загружать данные.
Так же в свою очередь программа обладает некоторым недостатком. Механизм проверки возможных ходов в исключительных ситауциях выдает неверные данные по невыясненным причинам.
1 http://www.fpclub.ru/games/nardy/nardylong.php
2 Боровский А Н Программирование в Delphi 2005
3 Банкел Джулиан М. Фундаментальные алгоритмы и структуры данных в Delphi
4 Дерахвелидзе П. Г., Марков Е. П. Программирование в Delphi 7
5 Кенту М. Delphi7 для профессионалов
6 Фленов М. Е. Библия Delphi
7 Культин Н. Б. Основы программирования в Delphi 8 для Microsoft.NET Framework
(обязательное)
Текст программы
Модуль MAINсодержит главную форму и вызов основных процедур программы
uses draw, game, save, load, exit, help, about;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
getdir(0,path);
status:=0;
for i:=1 to 4 do bones[i]:=0;
for i:=1 to 4 do bones2[i]:=0;
varbones(sender);
for i:=1 to 26 do mas[i,1]:=0;
for i:=1 to 26 do mas[i,2]:=0;
for i:=1 to 26 do mas2[i,1]:=0;
for i:=1 to 26 do mas2[i,2]:=0;
mas[1,1]:=1;
mas[1,2]:=15;
mas[13,1]:=2;
mas[13,2]:=15;
mas[25,1]:=1;
mas[26,1]:=2;
mas2[1,1]:=1;
mas2[1,2]:=15;
mas2[13,1]:=2;
mas2[13,2]:=15;
mas2[25,1]:=1;
mas2[26,1]:=2;
draw.visible(sender);
draw.redraw(sender);
end;
procedure TForm1.niClick(Sender: TObject); // i – от 1 до 24
begin
game.variants(sender,1);
end;
procedure TForm1.miClick(Sender: TObject); // i - от 1 до 24
begin
game.move(sender,1);
end;
procedure TForm1.bldomclickClick(Sender: TObject);
begin
game.movehouse(Sender,26,zar);
end;
procedure TForm1.bones_clickClick(Sender: TObject);
begin
game.bonesclick(sender);
end;
procedure TForm1.Button1Click(Sender: TObject);
var z1,z2:integer;
begin
If messagedlg('Выдействительнохотитеначатьновуюигру?',mtinformation,[mbOk,mbCancel],0)=1 then begin
formcreate(sender);
z1:=random(6)+1;
z2:=random(6)+1;
if z1=z2 then form1.Button1Click(sender)
else begin
if z1>z2 then player:=2;
if z2>z1 then player:=1;
if z1<>z2 then status:=2;
wf:=0;
blf:=0;
messagedlg('Начинающий игрок определен случайным образом, бросьте зары',mtinformation,[mbok],0);
bones_click.Enabled:=true;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
for i:= 1 to 26 do
for j:= 1 to 2 do mas[i,j]:=mas2[i,j];
for i:=1 to 4 do bones[i]:=bones2[i];
golova:=0;
draw.visible(sender);
draw.redraw(sender);
varbones(sender);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
form2.ShowModal;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
form3.ShowModal;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
form4.ShowModal;
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
form5.showmodal;
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
form4.ShowModal;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
application.Minimize;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Form1.Handle, WM_SysCommand,$F012, 0);
end;
procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
form6.showmodal;
end;
procedure TForm1.wdomclickClick(Sender: TObject);
begin
game.movehouse(Sender,25,zar);
end;
end.
Модуль GAME содержит процедуры реализации игрового процесса
uses main, draw;
procedure variants(Sender: TObject; num:integer);
var x,sum,i,j:integer;
begin
if status=2 then begin
messagedlg('Бросьтезары',mtinformation,[mbok],0);
exit;
end;
if (status=1) and (mas[num,1]=player) then begin
if player=1 then begin
sum:=0;
for i:=19 to 25 do
if mas[i,1]=1 then sum:=sum+mas[i,2];
if sum=15 then begin
draw.visible(Sender);
nomer:=num;
for i:=1 to 4 do if bones[i]<>0 then begin
x:=num+bones[i];
sum:=0;
for j:=18 to num-1 do if mas[j,1]=player then sum:=sum+mas[j,2];
if (sum=0) and (x>25) then x:=25;
if x=25 then zar:=i;
if x<26 then if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender,x);
end;
exit;
end;
end;
if player=2 then begin
sum:=0;
for i:=7 to 12 do
if mas[i,1]=2 then sum:=sum+mas[i,2];
sum:=sum+mas[26,2];
if sum=15 then begin
visible(Sender);
nomer:=num;
for i:=1 to 4 do if bones[i]<>0 then begin
x:=num+bones[i];
sum:=0;
for j:=6 to num-1 do if mas[j,1]=player then sum:=sum+mas[j,2];
if (sum=0) and (x>13) then x:=13;
if x=13 then x:=26;
if x=26 then zar:=i;
if x<27 then if (mas[x,1]=player) or (mas[x,1]=0) then if (x<13) or (x=26) then arrow(sender,x);
end;
exit;
end;
end;
end;
if (status=1) and (mas[num,1]=player) then
if ((mas[num,1]=1) and (num=1) and (golova=2)) or ((mas[num,1]=2) and (num=13) and (golova=2)) then else begin
visible(Sender);
nomer:=num;
if bones[1]<>0 then begin
x:=num+bones[1];
if (mas[num,1]=2) and (x>24) then x:=x-24;
if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
end;
if bones[2]<>0 then begin
x:=num+bones[2];
if (mas[num,1]=2) and (x>24) then x:=x-24;
if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
end;
if main.bones[3]<>0 then begin
x:=num+bones[3];
if (mas[num,1]=2) and (x>24) then x:=x-24;
if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
end;
if bones[4]<>0 then begin
x:=num+bones[4];
if (mas[num,1]=2) and (x>24) then x:=x-24;
if (x>24) or ((mas[num,1]=2) and (num<=12) and (x>12)) then else
if (mas[x,1]=player) or (mas[x,1]=0) then arrow(sender, x);
end;
end;
end;
function proverka(m:integer; zz:integer):integer;
var i,j,nn,x:integer;
begin
nn:=0;
case player of
1: begin
if mas[m,1]=player then for j:=1 to 4 do
if m+zz*j<=24 then
if (mas[m+zz*j,1]=player)or (mas[m+zz*j,1]=0) then begin nn:=nn+mas[m,2];
end
else begin
result:=nn;
exit;
end;
end;
2: if (m>=13) and (m<=24) then
if mas[m,1]=player then for j:=1 to 4 do begin
x:=m+zz*j;
if x>24 then x:=x-24;
if (mas[x,1]=player)or (mas[x,1]=0) then nn:=nn+mas[m,2]
else begin
result:=nn;
exit;
end; end else begin
if mas[m,1]=player then for j:=1 to 4 do
if m+zz*j<=12 then
if (mas[m+zz*j,1]=player)or (mas[m+zz*j,1]=0) then nn:=nn+1*mas[m,2]
else
begin
result:=nn;
exit;
end;
end;
end;
result:=nn;
end;
procedure doublebones(sender:tobject);
var i,j,n,z,x:integer;
begin
z:=bones[1];
n:=0;
case player of
1: begin
for i:=1 to 24-bones[1] do begin
x:=proverka(i,z);
n:=n+x;
end;
if mas[1,2]>=1 then begin
if mas[1,2]=15 then n:=n-13 else n:=n+1-mas[1,2];
end;
end;
2: begin
for i:=13 to 24 do n:=n+proverka(i,z);
for i:=1 to 12-bones[1] do n:=n+proverka(i,z);
if mas[13,2]>=1 then begin
if mas[13,2]=15 then n:=n-13 else n:=n+1-mas[13,2];
end; //else
end;
end;
if n>=4 then exit else case n of
0: for i:=1 to 4 do bones[i]:=0;
1: for i:=4 downto 2 do bones[i]:=0;
2: for i:=4 downto 3 do bones[i]:=0;
3: bones[4]:=0;
end;
end;
procedure ablemove(sender:tobject);
var z:array[1..2] of boolean;
p:boolean;
i,j,x,z1,z2,s1,s2,sum:integer;
begin
if player=1 then begin
for i:=19 to 25 do
if mas[i,1]=1 then sum:=sum+mas[i,2];
if sum=15 then exit;
end;
if player=2 then begin
for i:=7 to 12 do
if mas[i,1]=2 then sum:=sum+mas[i,2];
sum:=sum+mas[26,2];
if sum=15 then exit;
end;
z1:=bones[1];
z2:=bones[2];
s1:=mas[24,2]+mas[23,2]+mas[22,2]+mas[21,2]+mas[20,2]+mas[19,2];
s2:=mas[7,2]+mas[8,2]+mas[9,2]+mas[10,2]+mas[11,2]+mas[12,2];
z[1]:=false;
z[2]:=false;
p:=false;
case player of
1: begin if bones[1]<>main.bones[2] then begin
for j:=1 to 2 do begin
for i:=1 to 24-bones[j] do
if (mas[i,1]=player) and (p=false) then
if (mas[i+bones[j],1]=player) or (mas[i+bones[j],1]=0) then begin
p:=true;
z[j]:=true;
end;
p:=false;
end;
case z[1] of
true: begin
if z[1]=z[2] then exit else
for i:= 1 to 24-bones[1]-bones[2] do
if (mas[i,1]=player) and (z[2]=false) then
if (mas[i+bones[1]+bones[2],1]=player) or (
mas[i+bones[1]+bones[2],1]=0) then z[2]:=true;
if z[2]=false then bones[2]:=0;
end;
false: begin
if z[1]=z[2] then begin
bones[1]:=0;
bones[2]:=0;
end else
for i:= 1 to 24-bones[1]-bones[2] do
if (mas[i,1]=player) and (z[1]=false) then
if (mas[i+bones[1]+bones[2],1]=player) or (
mas[i+bones[1]+bones[2],1]=0) then z[1]:=true;
if z[1]=false then bones[1]:=0;
end;
end;
if s1=15 then begin
if mas[z1+18,2]>=1 then bones[1]:=z1;
if mas[z2+18,2]>=1 then bones[2]:=z2;
end; end else doublebones(sender);
end;
2: begin if bones[1]<>bones[2] then begin
for j:=1 to 2 do begin
for i:=13 to 24 do
if (mas[i,1]=player) and (p=false) then begin
x:=i+main.bones[j];
if x>24 then x:=x-24;
if (mas[x,1]=player) or (mas[x,1]=0) then begin
p:=true;
z[j]:=true;
end;
end;
for i:=1 to 12-bones[j] do
if (mas[i,1]=player) and (p=false) then begin
x:=i+main.bones[j];
if (mas[x,1]=player) or (mas[x,1]=0) then begin
p:=true;
z[j]:=true;
end;
end;
p:=false;
end;
case z[1] of
true: begin
if z[1]=z[2] then exit else
for i:= 13 to 24 do
if (mas[i,1]=player) and (z[2]=false) then begin
x:=i+bones[1]+bones[2];
if x>24 then x:=x-24;
if (mas[x,1]=player) or (mas[x,1]=0) then z[2]:=true;
end;
for i:=1 to 12-bones[1]-bones[2] do
if (mas[i,1]=player) and (z[2]=false) then
if (mas[i+bones[1]+bones[2],1]=player) or (
mas[i+bones[1]+bones[2],1]=0) then z[2]:=true;
if z[2]=false then bones[2]:=0;
end;
false: begin
if z[1]=z[2] then begin
bones[1]:=0;
bones[2]:=0;
end else
for i:= 13 to 24 do
if (mas[i,1]=player) and (z[1]=false) then begin
x:=i+bones[1]+bones[2];
if x>24 then x:=x-24;
if (mas[x,1]=player) or (mas[x,1]=0) then z[1]:=true;
end;
for i:=1 to 12-bones[1]-bones[2] do
if (mas[i,1]=player) and (z[1]=false) then
if (mas[i+bones[1]+bones[2],1]=player) or (
mas[i+bones[1]+bones[2],1]=0) then z[1]:=true;
if z[1]=false then bones[1]:=0;
end;
end;
if s2=15 then begin
if mas[z1+6,2]>=1 then bones[1]:=z1;
if mas[z2+6,2]>=1 then bones[2]:=z2;
end; end else doublebones(sender);
end; end;
end;
procedure bonesclick(Sender: TObject);
var i,j:integer;
begin
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;
if (main.bones[1]=0) and (main.bones[2]=0) and (main.bones[3]=0) and
(main.bones[4]=0) then begin
status:=2;
if player=1 then begin
player:=2;
messagedlg('Ходятчерные',mtinformation,[mbok],0);
end else begin
player:=1;
messagedlg('Ходятбелые',mtinformation,[mbok],0);
end;
with form1 do begin
randomize;
z1:=random(6)+1;
case z1 of
1: leftbone.Picture:=b1.Picture;
…
6: leftbone.Picture:=b6.Picture;
end;
z2:=random(6)+1;
case z2 of
1: rightbone.Picture:=b1.Picture;
…
6: rightbone.Picture:=b6.Picture;
end;
golova:=0;
status:=1;
if z1<>z2 then begin
bones[1]:=z1;
bones[2]:=z2;
bones[3]:=0;
bones[4]:=0;
end else begin
bones[1]:=z1;
bones[2]:=z1;
bones[3]:=z2;
bones[4]:=z2;
end;
if (player=1) and (bones[3]<>0) and (mas[1,2]=15) then wf:=1;