p.s.сессия началась, выручайте :confused:
вот полностью сделанная и рабочая прога:
uses graph, crt;
type TPoint=record
x,y:word;
end;
arr=array[0..1000] of real;
foo=function(x:real):real;
var f:text;
ch:char;
{ x,y:arr;}
h,w,num,pow:integer;
a,b:real;
p:array [0..1000] of TPoint;
pol:arr;
t:array[1..10] of real;
function func(x:real):real; far;
begin
func:=sin(x);
end;
function poly(x:real):real; far;
var i:integer;
ret:real;
power:real;
begin
ret:=pol[pow+1];
power:=x;
for i:=pow downto 1 do
begin
ret:=ret+pol[i]*power;
power:=power*x;
end;
poly:=ret;
end;
function trig(x:real):real; far;
begin
trig:=t[1]*cos(t[2]*(x+t[3]))+t[4]*sin(t[5]*(x+t[6]))+t[7]*exp(t[8]*(x+t[9]))+t[10];
end;
procedure menu;
begin
writeln('1. a1*cos(b1*(x+c1))+a2*sin(b2*(x+c2))+a3*exp(b3*(x+c3))+c');
writeln('2. a1*x1+a2*x2^2+...+an*xn^n+a');
writeln('3. From program');
writeln('4. End');
end;
procedure FillCoords(var x:arr; var y:arr; a,b:real; n:integer; ff:foo);
var i:integer;
h:real;
begin
h:=abs(b-a)/n;
for i:=0 to n do
begin
x[i]:=a+h*i;
y[i]:=ff(x[i]);
write(f,'No.',i,': x:',x[i]:4:2,'; y:',y[i]:4:2);
writeln(f);
end;
end;
procedure GetMinAndMax(var y:arr; n:integer; var max,min:real);
var i:integer;
begin
max:=y[1];
min:=y[1];
for i:=0 to n do
if y[i]<min then min:=y[i]
else if y[i]>max then max:=y[i];
write(f,'---------------------');
writeln(f);
write(f,'Minimal y:',min:2:2,'. Maximal:',max:2:2);
end;
procedure DrawAxis(xmin,xmax,ymax,ymin:real; var ax:integer; var ay:integer);
var xscale,yscale:real;
s:string;
dtx,dty:integer;
begin
xscale:=(xmax-xmin)/w;
yscale:=(ymax-ymin)/h;
if ((xmin<0) and (xmax>0)) then ay:=round(abs(xmin)/xscale)
else if (xmax<0) and (xmin<0) then ay:=w
else ay:=0;
if (ymin<0) and (ymax>0) then ax:=h-round(abs(ymin)/yscale)
else if (ymax<0) and (ymin<0) then ax:=0
else ax:=h;
setcolor(white);
setlinestyle(0,1,3);
line(ay,0,ay,h);
str(ymin:2:2,s);
outtextxy(ay+5,h-10,s);
str(ymax:2:2,s);
outtextxy(ay+5,2,s);
line(0,ax,w,ax);
str(xmin:2:2,s);
outtextxy(0,ax+5,s);
str(xmax:2:2,s);
outtextxy(w-(length(s)-1)*10,ax+5,s);
if (xmax>1) then
begin
line(ay+round(1/xscale),ax+4,ay+round(1/xscale),ax-4);
outtextxy(ay+round(1/xscale)-2,ax+4,'1');
end;
if (ymax>1) then
begin
line(ay+4,ax-round(1/yscale),ay-4,ax-round(1/yscale));
outtextxy(ay+4,ax-round(1/yscale),'1');
end;
end;
procedure DrawFunc(xmin,xmax,ymax,ymin:real; ax,ay,n:integer; var x,y:arr);
var i:integer;
xscale, yscale:real;
kx,ky:integer;
begin
xscale:=abs(xmax-xmin)/w;
yscale:=abs(ymax-ymin)/h;
for i:=0 to n do
begin
if xmin>0 then p[i].x:=ay+round(abs(x[i]-xmin)/xscale)
else if xmax<0 then p[i].x:=ay-round(abs(x[i]-xmin)/xscale)
else if x[i]<0 then p[i].x:=ay-round(abs(x[i])/xscale)
else p[i].x:=ay+round(abs(x[i])/xscale);
if ymin>0 then p[i].y:=ax-round(abs(y[i]-ymin)/yscale)
else if ymax<0 then p[i].y:=ax+round(abs(y[i]-ymax)/yscale)
else if y[i]<0 then p[i].y:=ax+round(abs(y[i])/yscale)
else p[i].y:=ax-round(abs(y[i])/yscale);
end;
setcolor(lightgreen);
setlinestyle(0,1,2);
drawpoly(n+1,p)
end;
procedure draw(ff:foo);
var gd,gm:integer;
ymin,ymax:real;
x,y:arr;
ax,ay:integer; {axis coords}
begin
gd:=detect;
initgraph(gd,gm,'');
setcolor(white);
rectangle(0,0,w,h);
FillCoords(x,y,a,b,num,ff);
GetMinAndMax(y, num, ymax,ymin);
DrawAxis(a,b,ymax,ymin,ax,ay);
DrawFunc(a,b,ymax,ymin,ax,ay,num,x,y);
readln; readln;
closegraph;
end;
var i:integer;
begin
assign(f,'points.txt');
rewrite(f);
while true do
begin
clrscr;
menu;
ch:=readkey;
if (ch>=chr(ord('1'))) and (ch<=chr(ord('3'))) then
begin
write('Enter width and height of the field:');
readln(w,h);
write('Enter min and max X:');
readln(a,b);
write('Enter number of points:');
readln(num);
end;
case ch of
'1': begin
write('Enter a1,b1..b3,c3; c0:');
for i:=1 to 10 do read(t[i]);
draw(trig);
end;
'2':begin
write('Enter polynomial power:');
read(pow);
write('Enter koefficients:');
for i:=1 to pow+1 do read(pol[i]);
draw(poly);
end;
'3':draw(func);
'4':break;
end;
end;
close(f);
end.