Код
program proekt;
uses graph,crt;
const
nx=0;
ny=96;
dx=32;
dy=32;
left=#75;
right=#77;
esc=#27;
enter=#13;
up=#72;
down=#80;
up_left=#71;
up_right=#73;
down_left=#79;
down_right=#81;
n_strok=12;
n_stolb=20;
type mas_tabl=array[1..n_strok,1..n_stolb] of integer;
const a1:mas_tabl=((1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1),
(1,2,0,0,0,7,0,0,0,0,0,0,0,0,0,0,0,0,3,1),
(1,1,0,1,0,1,1,1,0,0,0,0,0,1,1,1,0,1,1,1),
(1,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,1),
(1,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,1),
(1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,1),
(1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,0,0,1),
(1,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,2,1),
(1,0,0,1,1,1,0,0,1,1,0,0,1,0,0,0,1,1,1,1),
(1,6,0,0,0,0,0,0,0,0,0,3,0,0,0,7,0,0,0,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1));
var gd,gm,z:integer;
a:mas_tabl;
i_ved,j_ved:integer;
ch:char;
p_menu,p_hero,p_kub,p_vrag,p_priz,p_priz2,p_priz3,p_priz4:pointer;
s_menu,s_hero,s_vrag,s_kub,s_priz,s_priz2,s_priz3,s_priz4:word;
type mas_strok=array[1..10] of string;
var str_rules:mas_strok;
n_str_rules:integer;
procedure load_image( n:string;var p:pointer;var size:word);
var f:file;
begin
assign(f,n);
reset(f,1);
size:=filesize(f);
getmem(p,size);
blockread(f,p^ ,size);
close(f);
end;
procedure fon(c:byte);
begin
setfillstyle(1,c);
bar(0,0,getmaxx,getmaxy);
end;
{-------Меню--------}
procedure menu(var ns:integer);
const n_strok=4;
type mas_strok=array [1..n_strok] of string;
const ss:mas_strok=('GAME','UROVNI','HELP','EXIT');
h=30;
y1=150;
var c,x,y,xc,yc,i:integer;
ch:char;
begin
fon(14);
x:=150;
y:=y1;
for i:=1 to n_strok do
begin
setcolor(4);
outtextxy(x,y,ss[i]);
y:=y+h;
end;
xc:=100;
yc:=y1;
putimage(xc,yc,p_menu^ ,xorput);
ns:=1;
repeat
ch:=readkey;
putimage(xc,yc,p_menu^,xorput);
case ch of
up:if ns>1 then
ns:=ns-1
else
ns:=n_strok;
down:if ns<n_strok then
ns:=ns+1
else
ns:=1;
end;
yc:=y1+(ns-1)*h;
putimage(xc,yc,p_menu^,xorput);
until (ch=esc) or (ch=enter);
if ch=esc then
ns:=0;
end;
{-------условия для "Правил"---------}
procedure out_file_in_massiv(name:string;var n:integer);
var k:integer;
f:text;
begin
assign(f,name);
reset(f);
n:=0;
while not eof (f) do
begin
n:=n+1;
if n>10 then
begin
setfillstyle(1,0);
bar(0,0,getmaxx,getmaxy);
clrscr;
writeln('В файле больше 10 строк.');
exit;
end;
readln(f,str_rules[n]);
end;
close(f);
end;
{--------Правила игры-----}
procedure pravila;
var x,y,n:integer;
begin
fon(14);
setcolor(1);
settextstyle(7,0,1);
x:=0;
y:=(getmaxy-31*n_str_rules) div 2;
for n:=1 to n_str_rules do
begin
outtextxy(x,y,str_rules[n]);
y:=y+15;
end;
readkey;
{repeat until keypressed};
end;
{-----Вывод начальной картинки на экран-----}
procedure picture;
var
i,j:integer;
x,y:integer;
begin
fon(0);
a:=a1;
for i:=1 to n_strok do
for j:=1 to n_stolb do
begin
x:=(j-1)*dx+nx;
y:=(i-1)*dy+ny;
case a[i,j] of
1:putimage(x,y,p_kub^,xorput);
2:putimage(x,y,p_priz^,xorput);
3:putimage(x,y,p_priz2^,xorput);
4:putimage(x,y,p_priz3^,xorput);
5:putimage(x,y,p_priz4^,xorput);
6:putimage(x,y,p_hero^,xorput);
7:putimage(x,y,p_vrag^,xorput);
end;
end;
end;
procedure moving_hero(var i,j:integer;p:pointer);
var
i_old,j_old:integer;
x,y:integer;
begin
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;
i_old:=i;
j_old:=j;
case ch of
left:x:=x-dx div 2;
right:x:=x+dx div 2;
up:y:=y-dy*3;
down:y:=y+dy*3;
end;
putimage(x,y,p^,xorput);
end;
end;
{----Главная программа - GAME----------}
procedure game;
var
i,j:integer;
x,y:integer;
begin
picture;
repeat
if keypressed then
moving_hero(i_ved,j_ved,p_hero);
until ch=esc;
end;
begin
Gd:=Detect;
initgraph(gd, gm, '');
load_image('hero',p_hero,s_hero);{---гланый герой----}
load_image('vrag1',p_vrag,s_vrag);{---враг----}
load_image('zvezda',p_menu,s_menu);{-----изображение курсора для меню----------}
load_image('priz',p_priz,s_priz);{----1приз----}
load_image('kub',p_kub,s_kub);{-----изображение стен и дорог------}
load_image('priz1',p_priz2,s_priz2);{------2приз----}
load_image('priz2',p_priz3,s_priz3);{------3приз-----}
load_image('priz3',p_priz4,s_priz4);{-----4приз----}
randomize;
out_file_in_massiv('rules.txt',n_str_rules);
repeat
menu(z);
case z of
1:game;
3:pravila;
end;
until (z=0) or (z=4);
readln
end.
uses graph,crt;
const
nx=0;
ny=96;
dx=32;
dy=32;
left=#75;
right=#77;
esc=#27;
enter=#13;
up=#72;
down=#80;
up_left=#71;
up_right=#73;
down_left=#79;
down_right=#81;
n_strok=12;
n_stolb=20;
type mas_tabl=array[1..n_strok,1..n_stolb] of integer;
const a1:mas_tabl=((1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1),
(1,2,0,0,0,7,0,0,0,0,0,0,0,0,0,0,0,0,3,1),
(1,1,0,1,0,1,1,1,0,0,0,0,0,1,1,1,0,1,1,1),
(1,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,1),
(1,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,1),
(1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,1),
(1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,0,0,1),
(1,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,2,1),
(1,0,0,1,1,1,0,0,1,1,0,0,1,0,0,0,1,1,1,1),
(1,6,0,0,0,0,0,0,0,0,0,3,0,0,0,7,0,0,0,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1));
var gd,gm,z:integer;
a:mas_tabl;
i_ved,j_ved:integer;
ch:char;
p_menu,p_hero,p_kub,p_vrag,p_priz,p_priz2,p_priz3,p_priz4:pointer;
s_menu,s_hero,s_vrag,s_kub,s_priz,s_priz2,s_priz3,s_priz4:word;
type mas_strok=array[1..10] of string;
var str_rules:mas_strok;
n_str_rules:integer;
procedure load_image( n:string;var p:pointer;var size:word);
var f:file;
begin
assign(f,n);
reset(f,1);
size:=filesize(f);
getmem(p,size);
blockread(f,p^ ,size);
close(f);
end;
procedure fon(c:byte);
begin
setfillstyle(1,c);
bar(0,0,getmaxx,getmaxy);
end;
{-------Меню--------}
procedure menu(var ns:integer);
const n_strok=4;
type mas_strok=array [1..n_strok] of string;
const ss:mas_strok=('GAME','UROVNI','HELP','EXIT');
h=30;
y1=150;
var c,x,y,xc,yc,i:integer;
ch:char;
begin
fon(14);
x:=150;
y:=y1;
for i:=1 to n_strok do
begin
setcolor(4);
outtextxy(x,y,ss[i]);
y:=y+h;
end;
xc:=100;
yc:=y1;
putimage(xc,yc,p_menu^ ,xorput);
ns:=1;
repeat
ch:=readkey;
putimage(xc,yc,p_menu^,xorput);
case ch of
up:if ns>1 then
ns:=ns-1
else
ns:=n_strok;
down:if ns<n_strok then
ns:=ns+1
else
ns:=1;
end;
yc:=y1+(ns-1)*h;
putimage(xc,yc,p_menu^,xorput);
until (ch=esc) or (ch=enter);
if ch=esc then
ns:=0;
end;
{-------условия для "Правил"---------}
procedure out_file_in_massiv(name:string;var n:integer);
var k:integer;
f:text;
begin
assign(f,name);
reset(f);
n:=0;
while not eof (f) do
begin
n:=n+1;
if n>10 then
begin
setfillstyle(1,0);
bar(0,0,getmaxx,getmaxy);
clrscr;
writeln('В файле больше 10 строк.');
exit;
end;
readln(f,str_rules[n]);
end;
close(f);
end;
{--------Правила игры-----}
procedure pravila;
var x,y,n:integer;
begin
fon(14);
setcolor(1);
settextstyle(7,0,1);
x:=0;
y:=(getmaxy-31*n_str_rules) div 2;
for n:=1 to n_str_rules do
begin
outtextxy(x,y,str_rules[n]);
y:=y+15;
end;
readkey;
{repeat until keypressed};
end;
{-----Вывод начальной картинки на экран-----}
procedure picture;
var
i,j:integer;
x,y:integer;
begin
fon(0);
a:=a1;
for i:=1 to n_strok do
for j:=1 to n_stolb do
begin
x:=(j-1)*dx+nx;
y:=(i-1)*dy+ny;
case a[i,j] of
1:putimage(x,y,p_kub^,xorput);
2:putimage(x,y,p_priz^,xorput);
3:putimage(x,y,p_priz2^,xorput);
4:putimage(x,y,p_priz3^,xorput);
5:putimage(x,y,p_priz4^,xorput);
6:putimage(x,y,p_hero^,xorput);
7:putimage(x,y,p_vrag^,xorput);
end;
end;
end;
procedure moving_hero(var i,j:integer;p:pointer);
var
i_old,j_old:integer;
x,y:integer;
begin
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;
i_old:=i;
j_old:=j;
case ch of
left:x:=x-dx div 2;
right:x:=x+dx div 2;
up:y:=y-dy*3;
down:y:=y+dy*3;
end;
putimage(x,y,p^,xorput);
end;
end;
{----Главная программа - GAME----------}
procedure game;
var
i,j:integer;
x,y:integer;
begin
picture;
repeat
if keypressed then
moving_hero(i_ved,j_ved,p_hero);
until ch=esc;
end;
begin
Gd:=Detect;
initgraph(gd, gm, '');
load_image('hero',p_hero,s_hero);{---гланый герой----}
load_image('vrag1',p_vrag,s_vrag);{---враг----}
load_image('zvezda',p_menu,s_menu);{-----изображение курсора для меню----------}
load_image('priz',p_priz,s_priz);{----1приз----}
load_image('kub',p_kub,s_kub);{-----изображение стен и дорог------}
load_image('priz1',p_priz2,s_priz2);{------2приз----}
load_image('priz2',p_priz3,s_priz3);{------3приз-----}
load_image('priz3',p_priz4,s_priz4);{-----4приз----}
randomize;
out_file_in_massiv('rules.txt',n_str_rules);
repeat
menu(z);
case z of
1:game;
3:pravila;
end;
until (z=0) or (z=4);
readln
end.