Консультация № 169128
08.06.2009, 16:42
0.00 руб.
08.06.2009, 16:45
0 2 1
В приложении моя игра. Помогите разобраться, в ней есть несколько процедур. Процедура Меню объявлена самой последней. При выходе(или окончании) из игры нужно сделать выход в меню, а не в ОС. Также и при выходе из процедуры Instruct.

Приложение:
uses graph, crt;
const
d1000=1000;
d500=50;
var
grd,grm :integer;
s,l,d,x1,y1,x,y,dx,dy,m,h,p,a,e :integer;
j,o,m1,st,ma,am,os,pos,r,de :integer;
c :char;
ok,quit,instruction :boolean;

procedure key;
begin
if keypressed then c:=readkey;
if c=#0 then c:=readkey;
end;

procedure setupscreen;
begin
TextAttr:=(cyan*3)+darkgray;
ClrScr;
HighVideo;
end;
procedure igra;
var
a, ba, bo, bd, c, i, t, pilote, mode, size, ph, od, oh,
s1, s2, n: integer;
s: boolean;
palet, balle, blank: pointer;
r, paus: string;
begin
pilote:=detect;
initGraph(pilote,mode,'c:\tp7\bgi');
clearviewport;

size:=imagesize(50,50,60,60);
new(blank);
getmem(blank,size);
getimage(50,50,60,60,blank^);

setcolor(14);
rectangle(5,5,20,65);
setfillstyle(1,1);
floodfill(10,10,14);

size:=imagesize(4,3,21,67);
new(palet);
getmem(palet,size);
getimage(4,3,21,67,palet^);

setcolor(10);
circle(55,55,3);
setfillstyle(1,10);
floodfill(55,55,10);

size:=imagesize(50,50,60,60);
new(balle);
getmem(balle,size);
getimage(50,50,60,60,balle^);

clearviewport;

setcolor(5);
setbkcolor(0);
rectangle(1,478,638,479);
rectangle(1,20,638,21);

ba:=30;
bo:=random(200)+100;
bd:=3+6*random(2);

t:=0;
ph:=200;
oh:=400;
putimage(5,ph,palet^,normalput);
putimage(615,oh,palet^,normalput);

s1:=0;
s2:=0;
s:=true;
n:=6;

repeat
case bd of
1: begin ba:=ba-1-n div 4; bo:=bo+1+n div 4; end;
3: begin ba:=ba+1+n div 4; bo:=bo+1+n div 4; end;
7: begin ba:=ba-1-n div 4; bo:=bo-1-n div 4; end;
9: begin ba:=ba+1+n div 4; bo:=bo-1-n div 4; end;
end;

putimage(ba,bo,balle^,normalput);

if ba<5 then
begin
putimage(4,bo,blank^,normalput);
s2:=s2+1;
if s=true then
begin
sound(200);
delay(d1000);
nosound;
end;
ba:=590;
bo:=100+random(200);
bd:=1+6*random(2);
settextstyle(0,0,0);
setcolor(0);
str(s1,r);
outtextxy(305,5,r);
outtextxy(315,5,'-');
str((s2-1),r);
outtextxy(325,5,r);

setcolor(4);
str(s1,r);
outtextxy(305,5,r);
outtextxy(315,5,'-');
str(s2,r);
outtextxy(325,5,r);
if s2=5 then
begin
setcolor(4);
settextstyle(8,0,4);
outtextxy(270,200,'Game Over!!!');
outtextxy(130,240,'Press any key for exit!');
if s=true then
begin
for i:=1 to 3 do
begin
sound(200);
delay(d1000);
nosound;
delay(d500);
end;
sound(200);
delay(d1000);
nosound;
end;
repeat until keypressed;
halt;
end;
end;

if ba>625 then
begin
putimage(625,bo,blank^,normalput);
s1:=s1+1;
if s=true then
begin
sound(2000);
delay(d1000);
nosound;
end;
ba:=30;
bo:=random(200)+100;
bd:=3+6*random(2);
setcolor(0);
str((s1-1),r);
outtextxy(305,5,r);
outtextxy(315,5,'-');
str(s2,r);
outtextxy(325,5,r);

setcolor(4);
str(s1,r);
outtextxy(305,5,r);
outtextxy(315,5,'-');
str(s2,r);
outtextxy(325,5,r);
if s1=5 then
begin
setcolor(4);
settextstyle(8,0,4);
outtextxy(270,200,'Congratulations!!!');
outtextxy(130,240,'Press any key for exit!');
if s=true then
begin
for i:=1 to 3 do
begin
sound(2000);
delay(d1000);
nosound;
delay(d500);
end;
sound(2000);
delay(d1000);
nosound;
end;
repeat until keypressed;
halt;
end;

end;

if (n=1)or(n=4) then delay(20);
if (n=2)or(n=5) then delay(10);

if (ba<20)and(bo>ph)and(bo<ph+45) then
begin
ba:=27;
bd:=3+6*random(2);
end;
if (ba>616)and(bo>oh)and(bo<oh+45) then
begin
ba:=610;
bd:=1+6*random(2);
end;

c:=getpixel(ba+5,bo-2);
if (c=5)or(c=14)or(c=1) then
if bd=9 then bd:=3
else bd:=1;
c:=getpixel(ba+11,bo+5);
if (c=14)or(c=1) then
if bd=9 then bd:=7
else bd:=1;
c:=getpixel(ba-2,bo+5);
if (c=5)or(c=1) then
if bd=7 then bd:=9
else bd:=3;
c:=getpixel(ba+5,bo+12);
if (c=5)or(c=14)or(c=1) then
if bd=3 then bd:=9
else bd:=7;

{Joueu}
if keypressed then
t:=ord(readkey)-ord('0');
if (t=3)and(ph>22) then ph:=ph-1- n div 4;
if (t=1)and(ph<412) then ph:=ph+1+n div 4;
if t=ord('p')-ord('0') then
repeat
paus:='PAUSE';
setcolor(4);
settextstyle(8,0,2);
outtextxy(270,240,paus);
settextstyle(2,0,4);
outtextxy(200,290, 'Pravila igri: ');
outtextxy(200,320,'Dvigaya raketku, otbivat myach. ');
outtextxy(200,350,'Igra do 5 ochkov. Upravlenie: ');
outtextxy(200,380,'3-vverh, 2-stop, 1-vniz');
outtextxy(200,410,'P-pausa');
outtextxy(200,440,'Press O for continue!');
until keypressed;
if t=ord('o')-ord('0') then
repeat
paus:='PAUSE';
setcolor(0);
settextstyle(8,0,2);
outtextxy(270,240,paus);
settextstyle(2,0,4);
outtextxy(200,290, 'Pravila igri: ');
outtextxy(200,320,'Dvigaya raketku, otbivat myach. ');
outtextxy(200,350,'Igra do 5 ochkov. Upravlenie: ');
outtextxy(200,380,'3-vverh, 2-stop, 1-vniz');
outtextxy(200,410,'P-pausa');
outtextxy(200,440,'Press O for continue!');
break;
until keypressed;
if t=ord('s')-ord('0') then s:=(s=false);

putimage(5,ph,palet^, normalput);

if (bd=3)or(bd=9) then
begin
if (bd=3)and(ba>385) then if (oh>bo+(595-bo))and(oh>22) then oh:=oh-1-n div 4;
if (bd=3)and(ba>385) then if (oh<bo-30)and(oh<412) then oh:=oh+1+n div 4;
if (bd=9)and(ba>385) then if (oh>bo-(620-ba))and(oh>22) then oh:=oh-1-n div 4;
if (bd=9)and(ba>385) then if (oh<bo-(620-ba))and(oh<412) then oh:=oh+1+n div 4;

end;
putimage(615,oh,palet^, normalput);

until t=ord('q')-ord('0');
closegraph;

dispose(palet);
dispose(balle);
dispose(blank);
end;
procedure instruct;
begin
keypressed;
repeat
settextstyle(2,0,8);
textcolor(4);
outtextxy(100,110,'!!! PING PONG !!!');
outtextxy(100,140, 'Pravila igri: ');
outtextxy(100,170,'Dvigaya raketku, otbivat myach. ');
outtextxy(100,200,'Igra do 5 ochkov. Upravlenie: ');
outtextxy(100,230,'3-vverh, 2-stop, 1-vniz');
outtextxy(100,260,'P-pausa');
outtextxy(100,290,'YDASCHI DRUSIJA');
outtextxy(120,350,'Press ENTER for begin!');
until keypressed;
clearviewport;
end;
procedure menu;
var
x,y,i,j :integer;
s :string;
men :boolean;
begin
x:=120;
y:=120;
j:=1;
setcolor(2);
settextstyle(1,0,3);
setfillstyle(8,11);
bar(x,y,x+370,y+220);
setfillstyle(1,red);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');
setfillstyle(1,1);
bar(x+100,y+95,x+250,y+130);
outtextxy(x+151,y+98,'Info');
setfillstyle(1,1);
bar(x+100,y+155,x+250,y+190);
outtextxy(x+155,y+158,'Exit');
repeat
if c=#80 then j:=j+1;
if c=#72 then j:=j-1;
if (c=#80) and (j=2) then
begin
setfillstyle(1,1);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');
setfillstyle(1,red);
bar(x+100,y+95,x+250,y+130);
outtextxy(x+151,y+98,'Info');
setfillstyle(1,1);
bar(x+100,y+155,x+250,y+190);
outtextxy(x+155,y+158,'Exit');
end;
if (c=#80) and (j=3) then
begin
setfillstyle(1,1);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');
setfillstyle(1,1);
bar(x+100,y+95,x+250,y+130);
outtextxy(x+151,y+98,'Info');
setfillstyle(1,red);
bar(x+100,y+155,x+250,y+190);
outtextxy(x+155,y+158,'Exit');
end;

if (c=#72) and (j=1) then
begin
setfillstyle(1,red);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');
setfillstyle(1,1);
bar(x+100,y+95,x+250,y+130);
outtextxy(x+151,y+98,'Info');
setfillstyle(1,1);
bar(x+100,y+155,x+250,y+190);
outtextxy(x+155,y+158,'Exit');
end;
if (c=#72) and (j=2) then
begin
setfillstyle(1,1);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');
setfillstyle(1,red);
bar(x+100,y+95,x+250,y+130);
outtextxy(x+151,y+98,'Info');
setfillstyle(1,1);
bar(x+100,y+155,x+250,y+190);
outtextxy(x+155,y+158,'Exit');
end;
if j<=1 then j:=1;
if j>=3 then j:=3;
If (c=#13) and (j=1)then
begin
clearviewport;
igra;
menu;
end;
if (c=#13) and (j=2) then
begin
clearviewport;
instruct;
igra;
end;
if (c=#13) and (j=3) then quit:=true;
c:='_';
key;
ok:=(c=#27);
until quit ;
end;

procedure exit;
begin
setcolor(1);
settextstyle(2,0,8);
outtextxy(100,110,'Igru sozdal student MATI');
outtextxy(100,140,'Sergey Tyan. 3Cay-169');
outtextxy(100,170,'Versia 1.1');
outtextxy(100,200,'GOOD LUCK! ;-)');
repeat
if (c=#13) then
begin
menu;
end;
until keypressed;
end;
{--------------------------------------------------------------------------------}
begin
grd:=detect;
initgraph(grd,grm,'bgi'); setupscreen;
repeat
quit:=false;
setRGBpalette(7,1,30,20);
menu;
setfillstyle(0,0);
clearviewport;
exit;

until quit;
closegraph;
end.

Обсуждение

давно
Старший Модератор
31795
6196
09.06.2009, 23:15
общий

Странная у Вас манера экономить байты, переменную С определяете как глобальный char, но при этом несколько раз переписываете один код:
Код:

setfillstyle(1,1);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');
setfillstyle(1,red);
bar(x+100,y+95,x+250,y+130);
outtextxy(x+151,y+98,'Info');
setfillstyle(1,1);
bar(x+100,y+155,x+250,y+190);
outtextxy(x+155,y+158,'Exit');

Можете посчитать, сколько это занимает байт, не утруждайтесь 205.
Теперь посчитайте сколько у Вас таких участков или похожих? После этого посчитайте, сколько Вы с экономили.

Теперь посчитайте, солько у Вас таких или подобных участков(процедура ShowPunk):
Код:

setfillstyle(1,1);
bar(x+100,y+35,x+250,y+70);
outtextxy(x+120,y+38,'Play Ping-Pong');

Каждый из таких участков занимает приблизительно по 70 байт.
Красным выделено те места, которые различны для каждого пункта меню. Практически это цвет заливки, строка и поправочные коэфициэнты кратные 60 по вертикали.
Код:
procedure ShowMenu(z:integer);
begin
for i:=0 to 2 do
case (i=z)of
true :ShowPunk(zz*i,red,'xx[i]');
false:ShowPunk(zz*i, 1,'xx[i]');
end;
end;
procedure menu;
var
c:char;
j:integer;{можно и байт}
begin
j:=2;
repeat
showMenu(j);
c:=readKey;{лучше делать так, т.к. процедура нацелена только на игру}
case c of
'стрелка вниз':j:=(j+2)mod 3;(типа -1)
'стрелка вверх':j:=(j+4)mod 3;(типа +1)
'enter':{дальше все зависит от J}
end;
until (c=#13)and(j=0);
end;

Посмотрите насколько короче выглядит код, думаю процедуру ShowPunk Вы напишите сами.

Основная Ваша ошибка: Вы соединили "движок игры"-(отвечающий за реакцию на нажатие клавиш) и "визуализатор"-(отображение информации на экране). Первый пунт просто управляет(задает значения), второй только выводит информацию которую задал первый пункт. Можно усовершенствовать Вашу программу, но не знаю разрешено ли использовать ассемблер?
Жду Вашей реакции.
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

давно
Старший Модератор
31795
6196
12.06.2009, 20:54
общий
это ответ
Здравствуйте, DeanWin.

В приложении меню программы. С процедурой igra я не разбирался, но рекомендую все переменные которые определены в как глобальные перенести в саму процедуру, оставить только используемые. Советую ещё обратить внимание на обработчик клавиатуры, вопрос № 162110, он позволит Вам избавится от процедуры key, которая при вводе инструкции P-pausa должна реагировать только на нажатие клавиши "Р"(латинская раскладка, верхний регистр), если будете использовать обработчик, Вам только остаётся прореагировать, что эта клавиша вообще нажата. Визуальную часть(отображение информации) я бы переложил на другой обработчик, который будет вызыватся каждые 18,2 раза в секунду. и выводить нужную информацию. За Вами остается только исполнительная часть, которая будет только менять нужные параметры(положение ракеток, положение шарика, текущий счёт) остальное за Вас сделает MS-DOS.

Вопросы задавайте в мини-форум.
Удачи!

Приложение:
uses Graph,Crt;
const
ArrowUp=#72;
ArrowDown=#80;
var
grD,grM,j:integer;
c:char;
procedure ShowPoint(dY,dColor:integer;z:string);
begin
setfillstyle(1,3*dColor+1);
bar(220,120+dY+35,370,120+dY+70);
outtextxy(240,120+dY+38,z);
end;
procedure ShowMenu(z:integer);
var
y:integer;
x:array[0..2]of string;
begin
x[2]:='Play Ping-Pong';
x[1]:='Info';
x[0]:='Exit';
ClearDevice;
setcolor(2);
settextstyle(1,0,3);
setfillstyle(8,11);
bar(120,120,490,340);
for y:=0 to 2 do
ShowPoint(60*y,ord((2-y)=z),x[2-y]);
end;
procedure igra;
begin
ClearDevice;
outtextxy(100,110,'Game');
readKey
end;
procedure exit;
begin
ClearDevice;
setcolor(1);
settextstyle(2,0,8);
outtextxy(100,110,'Igru sozdal student MATI');
outtextxy(100,140,'Sergey Tyan. 3Cay-169');
outtextxy(100,170,'Versia 1.1');
outtextxy(100,200,'GOOD LUCK! ;-)');
ReadKey;
end;
procedure instruct;
begin
ClearDevice;
settextstyle(2,0,8);
textcolor(4);
outtextxy(100,110,'!!! PING PONG !!!');
outtextxy(100,140, 'Pravila igri: ');
outtextxy(100,170,'Dvigaya raketku, otbivat myach. ');
outtextxy(100,200,'Igra do 5 ochkov. Upravlenie: ');
outtextxy(100,230,'3-vverh, 2-stop, 1-vniz');
outtextxy(100,260,'P-pausa');
outtextxy(100,290,'YDASCHI DRUSIJA');
outtextxy(120,350,'Press any key!');
ReadKey;
end;
{--------------------------------------------------------------------------------}
begin
grd:=detect;
initgraph(grd,grm,'bgi');
j:=2;
repeat
{визуальная часть}
ShowMenu(j);
repeat
c:=ReadKey;
until ord(c)<>0;
{исполнительная часть}
if c=ArrowUp then j:=(j+4)mod 3;
if c=ArrowDown then j:=(j+2)mod 3;
if c=#13 then
case j of
2:igra;
1:instruct;
0:exit;
end;
until (c=#13)and(j=0);
closegraph;
end.
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

Форма ответа