IPB
ЛогинПароль:

> Правила раздела!

1. Заголовок или название темы должно быть информативным !
2. Все тексты фрагментов программ должны помещаться в теги [code] ... [/code] или [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ" и используйте ПОИСК !
4. НЕ используйте форум для личного общения!
5. Самое главное - это раздел теоретический, т.е. никаких задач и программ (за исключением небольших фрагментов) - для этого есть отдельный раздел!

 
 Ответить  Открыть новую тему 
> Помогите найти ошибку в программе!
Sir
сообщение 15.03.2003 10:47
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 95
Пол: Мужской

Репутация: -  1  +


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

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Sir
сообщение 15.03.2003 10:49
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 95
Пол: Мужской

Репутация: -  1  +


Блин , тут не восьмерка , а 8) , ох уж эти смайлы!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shadow
сообщение 20.03.2003 0:30
Сообщение #3


Lonely_Raven
****

Группа: Пользователи
Сообщений: 640
Пол: Мужской

Репутация: -  1  +


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


--------------------
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы.
МЕРФИ
---------------------
RTFM - Read the fucking manual
---------------------
http://www.livejournal.com/users/lonley_raven/
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shadow
сообщение 20.03.2003 2:12
Сообщение #4


Lonely_Raven
****

Группа: Пользователи
Сообщений: 640
Пол: Мужской

Репутация: -  1  +


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


--------------------
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы.
МЕРФИ
---------------------
RTFM - Read the fucking manual
---------------------
http://www.livejournal.com/users/lonley_raven/
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shadow
сообщение 20.03.2003 19:26
Сообщение #5


Lonely_Raven
****

Группа: Пользователи
Сообщений: 640
Пол: Мужской

Репутация: -  1  +


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


--------------------
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы.
МЕРФИ
---------------------
RTFM - Read the fucking manual
---------------------
http://www.livejournal.com/users/lonley_raven/
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shadow
сообщение 20.03.2003 21:54
Сообщение #6


Lonely_Raven
****

Группа: Пользователи
Сообщений: 640
Пол: Мужской

Репутация: -  1  +


: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.


--------------------
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы.
МЕРФИ
---------------------
RTFM - Read the fucking manual
---------------------
http://www.livejournal.com/users/lonley_raven/
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 28.07.2025 10:47
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"