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

> Игра Лабиринт, Не могу найти ошибку
Eichhorn
сообщение 10.01.2011 15:56
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 50
Пол: Женский
Реальное имя: Сафиуллина Алёна

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


Помогите пожалуйста найти ошибку в игре, мне её сдать завтра надо. Она сначала запускается, а потом вылетает. И, если можете, подскажите как сделать отсчёт таймера от начала игры.
Вот текст игры:

program LABIRINT;
uses graph,wincrt;
type
Ttab=array[1..10,1..10] of integer;
var

grdriver, grmode, errcode:integer;
count:integer;
key:char;
p:pointer;
Prize:integer;
nx,ny,dx,dy,ik,jk,i,j:integer;
gd,gm:integer;


const
Left=#75;
Up=#72;
Down=#80;
Right=#77;
Esc=#27;
Enter=#13;
Tab1: Ttab=
((0,0,0,0,4,0,0,0,0,0),
 (0,3,0,0,1,0,0,0,3,4),
 (0,1,0,1,1,0,3,1,1,0),
 (0,1,1,1,0,0,0,0,1,0),
 (0,0,0,3,0,0,0,1,1,0),
 (0,1,1,1,1,0,1,1,0,0),
 (0,3,0,0,1,3,1,0,0,0),
 (0,1,1,0,0,1,0,0,1,0),
 (0,0,1,1,0,1,1,3,1,0),
 (0,0,0,2,0,0,0,0,0,0));
Tab2: Ttab=
((0,0,0,0,0,4,0,0,0,0),
 (0,0,0,0,0,1,0,0,0,0),
 (4,1,1,1,1,1,1,1,0,0),
 (0,1,0,0,0,0,0,1,0,0),
 (0,1,0,1,1,1,3,1,0,0),
 (0,3,0,1,0,0,0,0,0,0),
 (0,0,0,1,1,1,1,1,0,0),
 (0,0,0,3,0,1,0,1,0,0),
 (0,0,0,0,0,3,0,1,1,3),
 (0,0,0,0,0,0,0,2,0,0));



Procedure help;
var
f:text;
s:string;
y:integer;
begin
        assign(f,'help.pas');
        reset(f);
        setcolor(15);
        settextstyle(0,0,1);
        y:=20;
        cleardevice;
        while not(eof(f)) do
        begin
                readln(f,s);
                outtextxy(50,y,s);
                y:=y+20;
        end;
        close(f);
        readkey;
        cleardevice;
end;

 Procedure AnalyseKey(Var Key:char; Var i,j,ik,jk:integer);
 begin
        key:=readkey;
        if key=#0 then
        begin
                key:=readkey;
                case key of
                left:j:=jk-1;
                right:j:=jk+1;
                up:i:=ik-1;
                down:i:=ik+1;
                end;
        end;
        setcolor(0);
        settextstyle(0,0,3);
        outtextxy(450,200,'Стена');
 end;


Procedure Init;
Begin
	count:=0;
	Prize:=0;
	dx:=40;
	dy:=30;
	nx:=30;
	ny:=5;
end;


Procedure PrCount(count:integer);
 Var
 st:string[3];
 begin
        setcolor(14);
        STR(count,st);
        setfillstyle(1,0);
        bar(370,310,640,340);
        settextstyle(0,0,2);
        outtextxy(400,320,'‚ иЁ (r)зЄЁ-'+st);
 end;

 Procedure DrawCol;
 var
 size:integer;
 begin
        setcolor(Yellow);
        setfillstyle(1,Yellow);
        circle(round(dx/2),round(dy/2),round(dx/4));
        floodfill(round(dx/2),round(dy/2),Yellow);
        size:=imagesize(0,0,dx,dy);
        getmem(p,size);
        getimage(0,0,dx,dy,p^);
 end;


Procedure DrawLab(var ik,jk:integer);
 Var
 i,j:integer;
 x,y:integer;
 begin
        x:=nx+dx*10+5;
        y:=ny+dy*10+5;
        setfillstyle(1,Cyan);
        bar(nx-5,ny-5,x,y);
        for i:=1 to 10 do
           for j:=1 to 10 do
                begin
                x:=(j-1)*dx+nx;
                y:=(i-1)*dy+ny;
                case tab1[i,j] of

                        0:begin
                        setfillstyle(8,brown);
                        bar(x,y,x+dx,y+dy);
                        end;

                        1:begin
                        setfillstyle(1,White);
                        bar(x,y,x+dx,y+dy);
                        end;

                        2:begin
                        setfillstyle(i,White);
                        bar(x,y,x+dx,y+dy);
                        ik:=i;
                        jk:=j;
                        putimage(x,y,p^,xorput);
                        end;

                        3:begin
                        setfillstyle(1,LightGray);
                        bar(x,y,x+dx,y+dy);
                        Prize:=Prize+1;
                        end;

                        4:begin
                        setfillstyle(1,Yellow);
                        bar(x,y,x+dx,y+dy);
                        end;
                end;
                end;
end;

Procedure MoveLab(Var i,j,ik,jk:integer);
Var
x,y,xk,yk:integer;
Begin
        if (i=ik) and(j=jk) then Exit;
        x:=(j-1)*dx+nx;
        y:=(i-1)*dy+ny;
        xk:=(jk-1)*dx+nx;
        yk:=(ik-1)*dy+ny;
        case tab1[i,j] of
                0:begin
                sound(500);
                delay(20);
                count:=count-2;
                PrCount(count);
                setcolor(12);
                settextstyle(0,0,3);
                outtextxy(450,200,'Стена');
                i:=ik;
                j:=jk;
                nosound;
                end;

                1:begin
                putimage(x,y,p^,xorput);
                putimage(xk,yk,p^,xorput);
                tab1[ik,jk]:=1;
                tab1[i,j]:=2;
                ik:=i;
                jk:=j;
                end;

                3:begin
                count:=count+10;
                PrCount(count);
                setfillstyle(1,White);
                bar(x,y,x+dx-1,y+dy-1);
                putimage(x,y,p^,xorput);
                putimage(xk,yk,p^,xorput);
                tab1[ik,jk]:=1;
                tab1[i,j]:=2;
                ik:=i;
                jk:=j;
                end;

                4:begin
                putimage(x,y,p^,xorput);
                putimage(xk,yk,p^,xorput);
                setcolor(13);
                settextstyle(0,0,3);
                if count<Prize*9 then
                        begin
                        outtextxy(30,70,'Вы проиграли!');
                        outtextxy(30,70,'Вы не набрали очки!');
                        end
                else
                        begin
                        outtextxy(30,70,'Вы выиграли!');
                        outtextxy(30,70,'Нажмите клавишу Esc');
                        end;
                 end;
        end;
        tab1:=tab2;
end;


 Procedure game;
 begin
	init;
	DrawCol;
        cleardevice;
        PrCount(count);
        DrawLab(ik,jk);
	repeat
		i:=ik;
                j:=jk;
                AnalyseKey(Key,i,j,ik,jk);
                MoveLab(i,j,ik,jk);
        until key=Esc;
 	closegraph;
end;

 Procedure zastavka;
 Var c,n:integer;
 Begin
        Cleardevice;
        repeat
        c:=random(15)+1;
        n:=random(500)+500;
        sound(n);
        setcolor(c);
        Settextstyle(0,0,3);
        Outtextxy(250,40,'‹ ЎЁаЁ­в');
        Outtextxy(250,100,' ўв(r)а ‘ дЁг««Ё­  Ђ«с­ ');
        Outtextxy(250,150,'ЇаҐЇ(r)¤ ў вҐ«м ‡ «ҐўбЄЁ(c) Ђавс¬ Ђ«ҐЄб ­¤а(r)ўЁз');
        Outtextxy(250,300, '­ ¦¬ЁвҐ «оЎго Є« ўЁиг');
        delay(500);
        Nosound;
        Until keypressed;
        Cleardevice;
 End;


Procedure menu;
var
np:integer;
begin
        setcolor(12);
        settextstyle(0,0,3);
        outtextxy(250,40,'Меню');
        outtextxy(50,200,'1. Игра');
        outtextxy(50,240,'2. Помощь');
        outtextxy(50,280,'3. Выход');
        setcolor(14);
        settextstyle(0,0,2);
        outtextxy(150,400,'‚Выберите нужный пункт и нажмите enter');
        np:=1;
        putimage(400,200+(np-1)*40,p^,1);
        repeat
                key:=readkey;
                if key=#0 then
                begin
                   key:=readkey;
                   putimage(400,200+(np-1)*40,p^,1);
                   case key of
                     up:if np>1 then np:=np-1;
                     down:if np<3 then np:=np+1;
                   end;
                   putimage(400,200+(np-1)*40,p^,1);
                end;
        until key=enter;
        case np of
          1:game;
          2:help;
          3:halt;
        end;
end;


begin

        initgraph(grdriver,grmode,'c:\bgi');
	Randomize;
	zastavka;
	init;
	repeat 
	  menu;
	until 1=2;
        
End.




Сообщение отредактировано: Eichhorn - 10.01.2011 15:58


--------------------
Жизнь похожа на собачью упряжку: если не идёшь впереди, то всё время видишь одно и то же...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Eichhorn   Игра Лабиринт   10.01.2011 15:56
volvo   Разумеется. Вот тут вылет происходит: А теперь - ...   10.01.2011 16:38
Eichhorn   Спасибо!   10.01.2011 16:45
TarasBer   > setcolor©; Кстати, как от этой замены избави...   10.01.2011 16:45
Eichhorn   Это free paskal. У меня он тоже язык искажает при...   10.01.2011 16:52
TarasBer   > И не знаю как исправить.. Я же сказал, что д...   10.01.2011 16:58
volvo   Не понял... А. Ну да. Пользуюсь FF со своей подс...   10.01.2011 17:00
TarasBer   > Ну да. Пользуюсь FF со своей подсветкой синта...   10.01.2011 17:04
Eichhorn   А меню игры почему не открывается? Или там чего-то...   10.01.2011 17:35
volvo   Там слишком большие для FPC задержки. Попробуй уме...   10.01.2011 18:23
Eichhorn   Возражений вида "там где я буду сдавать нет э...   10.01.2011 19:01
Eichhorn   Я тут с уровнями ещё косяки пытаюсь исправить. Про...   10.01.2011 19:21
volvo   Показывай скриншот ошибки.   10.01.2011 19:21
Eichhorn   Вот:   10.01.2011 19:29
TarasBer   "Не удаётся найти указанный файл". Это о...   10.01.2011 19:44
Eichhorn   Программу сама пишу. А с текстовыми редакторами я ...   10.01.2011 19:54
volvo   Вот этот самый WinGraph: (тут мной было внесено ...   10.01.2011 20:15
Eichhorn   Что значит эта ошибка?:   10.01.2011 20:16
volvo   Где-то End пропущен, и по мнению компилятора ты вн...   10.01.2011 20:21
Eichhorn   О! Прогресс пошёл! Меню появилось! Тол...   10.01.2011 20:26
Eichhorn   Это была ошибка... В программе ничего не меняла-пе...   10.01.2011 21:40
volvo   "Так не бывает - тут помню, тут не помню...   10.01.2011 22:42
Eichhorn   Спасибо большое! Меню работает. Только игра гл...   11.01.2011 1:59
x2lk   Ну и код огромный Оо   6.02.2011 13:02


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

 

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