Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Теоретические вопросы _ Помогите найти ошибку в программе!

Автор: Sir 15.03.2003 14:47

Не могу понять почему квадраты стирают частично друг друга и почему при удалении от центра стираемая часть больше! Программировать я только начинаю, поэтому не судите строго.
Вот и сам исходник:

program tetris;
uses crt,graph;
const esc=#27; up=#72;
down=#80; left=#75;
right=#77; null=#0;
var dv,mv,a,b:integer;
ch:char;
procedure moveL;
begin
if (getpixel(a-1,B)=15) or (getpixel(a-1,b-38)=15)
then
begin
a:=a+20;b:=b+1;
end;
if (getpixel(a-1,B)=0) and (getpixel(a-1,b-38)=0)
then
begin
a:=a-20;b:=b+1;
end;
end;
procedure moveR;
begin
if (getpixel(a+41,B)<>0) or (getpixel(a+41,b-38)<>0) then
begin
a:=a-20; b:=b+1;
end;
if (getpixel(a+41,B)=0) and (getpixel(a+41,b-38)=0) then
begin
a:=a+20; b:=b+1;
end;
end;
procedure kvd;
begin
setfillstyle(1,15);
bar(a,b,a+40,b-40);
delay(700);
end;
procedure stakan;
begin
setlinestyle(solidln,0,thickwidth);
line(100,0,100,400);
line(100,400,540,400);
line(540,400,540,0);
setfillstyle(0,15);
delay(700);
end;
procedure zakrash;
begin
setfillstyle(0,15);
bar(a,b,a+40,b-40);
end;
procedure proverkaV;
begin
if a>497 then a:=497;
if a<103 then a:=103;
end;
procedure proverkaG;
begin
if b>397 then
begin
b:=397;
ch:=null;
end;
end;
begin
dv:=detect;
initgraph(dv,mv,'c:tpbgi');
a:=320;
b:=40;
kvd;
stakan;
repeat
a:=320;
b:=40;
while getpixel(a+20,b+3)=0
do begin
if keypressed=true then
begin
ch:=readkey;
zakrash;
case ch of
esc:halt(1);
left:moveL;
right:moveR;
end;
proverkaG;
proverkaV;
kvd;
end;
if keypressed=false then
begin
zakrash;
a:=a;
b:=b+1;
proverkaG;
proverkaV;
kvd;
end;
end;
until getpixel(320,40)=15;
end.

Автор: Sir 15.03.2003 14:49

Блин , тут не восьмерка , а 8) , ох уж эти смайлы!

Автор: Shadow 20.03.2003 4:30

:P погодь помотрю  :P

Автор: Shadow 20.03.2003 6:12

Отискал ошибку погодь трошки ;D :)

Автор: Shadow 20.03.2003 23:26

:D :-[ ОПАНЬКИ АГА ВОТ ОНА
В кратце если то размеры стакана не совпадают
и кубиков т.е. совпадают но несовсем
моно срубить что бы не моргал кубик при перемещени
ВОТ если надо по подробнее
то пиши на мыло shmv@inbox.ru :-*

Автор: Shadow 21.03.2003 1:54

:D ето опять я :P

{
Ню вот примерно так строго не сужу но BUG есче где-то 2-3
все целиком исправить не удалось Гм Гм а начало игры неплохое
мне ндравиться хорошая идея shmv@inbox.ru
}
program tetris;
uses crt,graph;
const esc=#27; up=#72;
down=#80; left=#75;
right=#77; null=#0;
var dv,mv,a,b:integer;
ch:char;

Procedure Sync; assembler;{Procedura Zaderjki lucha}
asm
mov dx, 3DAh
@@Wait:
in al, dx
test al, 08h
jz @@Wait
end;

procedure moveL;
begin
if (getpixel(a-1,B)=15) or (getpixel(a-1,b-3)=15)
then
begin
a:=a+20;b:=b+1;
end;
if (getpixel(a-1,B)=0) and (getpixel(a-1,b-3)=0)
then
begin
a:=a-20;b:=b+1;
end;
end;
procedure moveR;
begin
if (getpixel(a+41,B)<>0) or (getpixel(a+41,b-3)<>0) then
begin
a:=a-20; b:=b+1;
end;
if (getpixel(a+41,B)=0) and (getpixel(a+41,b-3)=0) then
begin
a:=a+20; b:=b+1;
end;
end;
procedure kvd;
begin
setfillstyle(1,15);
bar(a,b,a+40,b-40);
sync;
end;
procedure stakan;
begin
{setlinestyle(solidln,0,thickwidth);}
line(98,0,98,400);
line(98,400,542,400);
line(542,400,542,0);
setfillstyle(0,15);

end;
procedure zakrash;
begin
setfillstyle(0,15);
bar(a,b,a+40,b-40);
end;
procedure proverkaV;
begin
if a>502 then a:=501;
if a<98 then a:=99;
end;
procedure proverkaG;
begin
if b>397 then
begin
b:=397;
ch:=null;
end;
end;
begin
dv:=detect;
initgraph(dv,mv,'c:tpbgi');
a:=320;
b:=40;
kvd;
stakan;
repeat
a:=320;
b:=40;
while getpixel(a+20,b+3)=0
do begin
if keypressed=true then
begin
ch:=readkey;
zakrash;
case ch of
esc:halt(1);
left:moveL;
right:moveR;
end;
proverkaG;
proverkaV;
kvd;
end;
if keypressed=false then
begin
zakrash;
a:=a;
b:=b+1;
proverkaG;
proverkaV;
kvd;
end;
end;
until getpixel(320,40)=15;
end.