Форум программистов
 
О проблемах, например, с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Delphi > Lazarus, Free Pascal, CodeTyphon
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 06.03.2020, 21:55   #1
Knicker
Новичок
Джуниор
 
Регистрация: 27.12.2019
Сообщений: 2
По умолчанию exitcode 1

При запуске 5 пункта меню вылетает exitcode 1. В чем причина?

program hm;
uses graph,Crt,sysutils;
function f(x:real):real;
begin
f:=x*x*x-4*x+12;
end;

procedure grafik(xk,xn:real; var a,b,kf,max:real; var x1,x2,y1,y2:integer);
var
i,xle,xr,yt,yb,x0,y0: integer;
g1,g2,mx,my,x,dx: real;
begin
g1:= f(a);
g2:= f(b);
x0:= (x1+x2) div 2;
y0:= (y1+y2) div 2;
mx:= (x2-x1)/(xk-xn);
my:= (y0-y1)/max;
dx:= 0.1;
xle:= x0-round(trunc(xk)*mx*kf);
xr:= x0+round(trunc(xk)*mx*kf);
yt:= y0-round(f(xk)*my*kf);
yb:= y0+round(f(xk)*my*kf);
settextstyle(0,0,2);
setcolor(14);
outtextXY(x0-300,10,'(key up)-bolshe (key down)-menshe (Esc)-vyhod');
outtextXY(x0+200,100, 'x^3-4x+12');
settextstyle(0,0,1);
setcolor(10);
setlinestyle(0,0,1);
dx:= 0.1;
x:= xn;
while x <= xk do
begin
if x = xn then
moveto(x0+round(x*mx*kf),y0-round(f(x)*my*kf))
else
lineto(x0+round(x*mx*kf),y0-round(f(x)*my*kf));
x:= x+dx;
end;
if (a>5) and (b>5) then begin
setcolor(0);
line(x0+round(trunc(a)*mx*kf),y0,x0 +round(trunc(a)*mx*kf),y0-round(g1*my*kf));
line(x0+round(trunc(b)*mx*kf),y0,x0 +round(trunc(b)*mx*kf),y0-round(g2*my*kf));
end
else if (a<5) and (b>=5) then begin
setcolor(10);
line(x0+round(trunc(a)*mx*kf),y0,x0 +round(trunc(a)*mx*kf),y0-round(g1*my*kf));
line(x0+round(trunc(5)*mx*kf),y0,x0 +round(trunc(5)*mx*kf),y0-round(f(5)*my*kf));
line(x0+round(trunc(a)*mx*kf),y0,x0 +round(trunc(b)*mx*kf),y0);
setfillstyle(1,10);
floodfill(x0+round(trunc(a)*mx*kf)+ 10,y0-10,10);
end
else if (a=5) and (b>5) then begin
setcolor(0);
line(x0+round(trunc(a)*mx*kf),y0,x0 +round(trunc(a)*mx*kf),y0-round(g1*my*kf));
line(x0+round(trunc(b)*mx*kf),y0,x0 +round(trunc(b)*mx*kf),y0-round(g2*my*kf));
end
else if (round(a)<=-3) and (b=0) then
begin
line(xle,y0,x0,y0);
line(x0,y0,x0+round(trunc(b)*mx*kf) ,y0-round(g2*my*kf));
setfillstyle(1,10);
floodfill(x0-10,y0-10,10);
end
else
if round(a) <= -3 then
begin
line(xle,y0,xr,y0);
line(x0+round(trunc(b)*mx*kf),y0,x0 +round(trunc(b)*mx*kf),y0-round(g2*my*kf));
setfillstyle(1,10);
floodfill(x0+10,y0-10,10);
end
else
begin
line(x0+round(trunc(a)*mx*kf),y0,x0 +round(trunc(a)*mx*kf),y0-round(g1*my*kf));
line(x0+round(trunc(b)*mx*kf),y0,x0 +round(trunc(b)*mx*kf),y0-round(g2*my*kf));
line(x0+round(trunc(a)*mx*kf),y0,x0 +round(trunc(b)*mx*kf),y0);
setfillstyle(1,10);
floodfill(x0+round(trunc(a)*mx*kf)+ 10,y0-10,10);
end;
setcolor(9);
line(xle,y0,xr,y0);
outtextXY(x2-20,y0-20,'X');
line(x0,yt,x0,yb);
outtextXY(x0+15,yt-20,'Y');
outtextXY(x0+5,y0+10,'0');
for i:= 1 to trunc(xk) do
begin
line(x0+round(i*mx*kf),y0-3,x0+round(i*mx*kf),y0+3);
line(x0-round(i*mx*kf),y0-3,x0-round(i*mx*kf),y0+3);
outtextXY(x0+round(i*mx*kf),y0+10,i nttostr(i));
outtextXY(x0-round(i*mx*kf),y0+10,inttostr(-i));
end;
for i:=1 to trunc(max/20)+1 do
begin
line(x0-5,y0-round(i*my*20*kf),x0+5,y0-round(i*my*20*kf));
line(x0-5,y0+round(i*my*20*kf),x0+5,y0+roun d(i*my*20*kf));
outtextXY(x0-30,y0-round(i*my*20*kf)-5,inttostr(i*20));
outtextXY(x0-35,y0+round(i*my*20*kf)-5,inttostr(-i*20));
end;
setlinestyle(0,0,3);
x:= xn;
while x <= xk do
begin
if x = xn then
moveto(x0+round(x*mx*kf),y0-round(f(x)*my*kf))
else
lineto(x0+round(x*mx*kf),y0-round(f(x)*my*kf));
x:= x+dx;
end;
end;

function simpson(a,b: real; k: integer): real;
var
h,x,s: real;
begin
h:= (b-a)/k;
s:= 0;
x:= a+h;
while (x < b) and (x > -2.862) do
begin
s:= s+4*f(x);
x:= x+h;
s:= s+2*f(x);
x:= x+h;
end;
s:= h/3 * (s+f(a)-f(b));
simpson:=s ;
end;

function Runge(a,b: real; k: integer): real;
var
s1,s2: real;
begin
s1:= simpson(a, b, k);
s2:= simpson(a, b, 2*k);
Runge:= 1/15 * abs(s2-s1);
end;

procedure punct1;
begin
writeln('Function x^3-4x+12 , Simpson method');
end;

procedure punct5;
begin
writeln('Punkt 5');
end;



procedure Menu;

procedure writemenu(var h: integer);
const
menu: array[1..6] of string =
('Function',
'Borders',
'Area',
'Error',
'Graph',
'Exit');
var
item: integer;
pressedkey: char;
begin
clrscr();
for item:= 1 to length(menu) do
begin
if item = h
then
begin
TextBackground(Blue);
TextColor(White);
end
else
begin
TextBackground(Black);
TextColor(White);
end;
writeln(item,'.',menu[item]);
end;
TextBackground(black);
TextColor(White);

pressedkey:= ReadKey();
if pressedkey = char(13)
then
exit;
if pressedkey <> char(0)
then
begin
writemenu(h);
exit;
end;
pressedkey:= readkey();

if pressedkey = char(72)
then
h:= h-1;
if pressedkey = char(80)
then
h:= h+1;

if h > length(menu)
then
h:= 1
else
if h < 1
then
h:= length(menu);
writemenu(h);
end;

const
xng = -5.0;
xkg = 5.0;

var

x1g,x2g,y1g,y2g: integer;
gd,gm: integer;
ag,bg,yg,xg,maxg,dxg,kf: real;
cg: char;
n:byte;
a,b:real;
h,k: integer;
s1,s2:string;

begin

h:= 1;
while true do
begin
writemenu(h);
clrscr();
case h of
1: begin
punct1;
end;
2: begin
repeat
writeln(' Enter borders and number of segments');
readln(a,b,k);
if a = b then
writeln (' a and b dolzhni bit raznimi');
if a > b then
writeln(' a dolzhno bit menshe b');
until (a < b) and (a <> b);
end;
3: begin
writeln('Area is: ', simpson(a,b,k):0:2 );
end;
4: begin
writeln('Error is:', Runge(a,b,k):0:2 );
end;
5: begin
dxg:= 0.1;
xg:= xng;
maxg:= abs(f(xg));
while xg <= xkg do
begin
if abs(f(xg)) > maxg then
maxg:= abs(f(xg));
xg:= xg+dxg;
end;
gm:= detect;
initgraph(gd,gm,'');
x1g:= getmaxX div 4;
x2g:= x1g*3;
y1g:= getmaxY div 4;
y2g:= y1g*3;
kf:=1;
grafik(xkg,xng,ag,bg,kf,maxg,x1g,x2 g,y1g,y2g);
repeat
if keypressed then
begin
cg:= readkey;
if (cg = #0) then
begin
cg:= readkey;

if cg = #71 then
if (x1g > 110) then
begin
x1g:= x1g-10;
x2g:= x2g+10;
y1g:= y1g-10;
y2g:= y2g+10;
kf:= kf*1.01;
end;

if cg = #79 then
if (x1g < (getmaxX div 2) - 230) then
begin
x1g:= x1g+10;
x2g:= x2g-10;
y1g:= y1g+10;
y2g:= y2g-10;
kf:= kf*0.99;
end;

cleardevice;
grafik(xkg,xng,ag,bg,kf,maxg,x1g,x2 g,y1g,y2g);
end;
end;
until cg = #27;
closegraph;
readln;

end;
6: exit;
end;
writeln;
writeln('Press "Enter" to back in menu.');
ReadLn();
end;
end;



begin
menu;
end.
Knicker вне форума Ответить с цитированием
Старый 07.03.2020, 08:45   #2
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,501
По умолчанию

графику подключили?
в этом 5 пункте начните комментировать строки, начиная с последней. и увидите, на каком шаге у вас исчезнет ошибка.
или перепишите код в ещё один проект и сделайте 5 пункт пустым. затем, постепенно добавляйте в него по одной строке в этот 5 пункт. рано или поздно, при добавлении очередной строки, вы увидите, какой именно оператор или функция у вас вызывает ошибку. вот там уже и будете разбираться.
это же так просто. пошагово
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.

Последний раз редактировалось NetSpace; 07.03.2020 в 08:49.
NetSpace вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
по Exitcode NikiToZz_ Паскаль, Turbo Pascal, PascalABC.NET 3 01.12.2016 00:25
exitcode 215 в чем проблема? anton.dasuik Паскаль, Turbo Pascal, PascalABC.NET 2 28.01.2013 18:03
exitcode 201 Beerhazard Помощь студентам 1 06.02.2012 19:43
exitcode 205 Beerhazard Паскаль, Turbo Pascal, PascalABC.NET 4 04.02.2012 21:34


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS