Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
16
Добавлен:
11.04.2015
Размер:
3.75 Кб
Скачать
program v;
uses graph,crt;
{вҐбв®ўл© ЇаЁ¬Ґа}
const
xmin=-5;xmax=10;
npol=10;
{F+}
type
func1=function(t:real):real;
polval=array[0..npol] of real;
var
i,nt:integer;
fz:func1;
masf,masx:polval;
function f1(x:real):real;far;
begin
f1:=exp(0.15*x)*sin(2*x);
end;
{⥪бв Їа®жҐ¤гал}
{
Їа®жҐ¤га  аЁбгҐв
Ја дЁЄ дг­ЄжЁЁ function f(t) ­  ®в१ЄҐ
[xmin,xmax] ў npoint >= 0 в®зЄ е бЇ«®и­®© «Ё­ЁҐ©,
  ¬ аЄҐа®¬-Єаг¦Є®¬ ®в¬Ґз Ґв nmas >=0 в®зҐЄ б
Є®®а¤Ё­ в ¬Ё (xmas[i],ymas[i]), i=0,...,nmas
}
procedure grafun(npoint:integer; xmin,xmax:real; f:func1 ;
nmas:integer;xmas,ymas:polval);
const
h=450;w=600; {а §¬Ґал а ¬ЄЁ}
y1=10;x1=25; {«Ґўл© гЈ®«}
hx=w div 5;hy=h div 5; {Є®®а¤Ё­ в­ п бҐвЄ }
{Ја дЁЄ дг­ЄжЁЁ г=f(е) ­  ®в१ЄҐ [xmin..xmax]}
var
s:string[6];
sim:char;
k,i,x0,xk,y0,yk,x,dr,mo:integer;
px,dx,dy,n,xt,yt,y:real;
ymin,ymax:real;
xscr,yscr:integer;
yris:array[0..w] of real;
procedure pause;
begin
setcolor(9);
outtextxy(401,h+20,'press any key to continue');
sim:=readkey;
end;
{нв  Їа®жҐ¤га  ¤«п ®в« ¤®з­ле ®бв ­®ў®Є}
function ypos(y:real):integer;
var yp:integer;
begin
yp:=trunc((y-ymin)*dy);
if yp<0 then yp:=0;
if yp>h then yp:=h;
ypos:=h+y1-yp;
end;
function xpos(x:real):integer;
var xp:integer;
begin
xp:=trunc(x1+(x-xmin)*w/(xmax-xmin));
if xp<x1 then xp:=x1;
if xp>x1+w then xp:=x1+w;
xpos:=xp;
end;
begin
dr:=0;
initgraph(dr,mo,'d:\tp\bgi');
if graphresult<>grOk then halt;
setbkcolor(7);
ymin:=0;ymax:=0;
dx:=w/(xmax-xmin);dy:=1/h;
for i:=0 to nmas do
begin
if ymas[i]>ymax then ymax:=ymas[i];
if ymas[i]<ymin then ymin:=ymas[i];
end;
yris[0]:=0;
if npoint<>0 then
begin
if npoint>w then npoint:=w;
px:=(xmax-xmin)/npoint;
for i:=0 to npoint do
begin
xt:=xmin+i*px;
y:=f(xt);yris[i]:=y;
if ymin>y then ymin:=y;
if ymax<y then ymax:=y
end;
end;
for k:=0 to 1 do
begin
for i:=0 to 5 do
begin
x0:=x1+k*hx*i;
xk:=x0+(1-k)*w;
y0:=h+y1-i*hy*(1-k);
yk:=y0-k*h;
setcolor(11);
setlinestyle(1,0,1);
line(x0,y0,xk,yk);
xt:=xmin+i*(xmax-xmin)/5;
yt:=ymin+i*(ymax-ymin)/5;
case k of
0: n:=yt;
1: n:=xt;
end;
str(n:5:1,s);
outtextxy(x0-x1,y0-(1-k)*10+k*5,s);
{ pause; }
end;
end;
setcolor(13);setlinestyle(0,0,3);
rectangle(0,0,639,479);
{x-axses}
setcolor(4);setlinestyle(0,0,1);
if (ymax-ymin)<0.1E-5 then dy:=1 else dy:=h/(ymax-ymin);
line(x1,ypos(0),x1+w+10,ypos(0));
line(xpos(0),10,xpos(0),h+10);
xscr:=xpos(xmin);yscr:=ypos(yris[0]);
putpixel(xscr,yscr,9);moveto(xscr,yscr);
for i:=1 to npoint do
begin
xt:=xmin+i*px;
yscr:=ypos(yris[i]);
lineto(xpos(xt),yscr);
end;
setcolor(10);setlinestyle(0,0,1);
for i:=0 to nmas do
begin
xt:=xmas[i];yt:=ymas[i];
xscr:=xpos(xt);yscr:=ypos(yt);
putpixel(xscr,yscr,10);
circle(xscr,yscr,3);
end;
pause;
closegraph;
end;{Є®­Ґж Їа®жҐ¤гал grafun}
begin
fz:=f1;nt:=800;
for i:=0 to npol do
begin
masx[i]:=xmin+i*(xmax-xmin)/npol;
masf[i]:=(i-5)/2;
end;
grafun(nt,xmin,xmax,fz,npol,masx,masf);
end.
Соседние файлы в папке lab2