Процедура для креслення графіка

Hижче наведена процедура Graffun креслення графіка довільної функції y=f(x). У процедурі передбачено креслення координатної сітки із нанесенням шкал поділки, а також округлення y до потрібного числа ok.

procedure Graffun(xn,xk,ok:real;

xa,ya,xb,yb:integer; f:fun);

var y,x,hx,hx1,ymin,ymax,

mx,my,yy,sx,sy : real;

i,x1,y1,x2,y2,hy : integer;

st : string;

{ знаходження максимуму i мінімуму функції }

procedure maxmin;

begin

x:=xn; ymax:=-1e30; ymin:=1e30;

while x<=xk do begin

y:=f(x);

if y>ymax then ymax:=y;

if y<ymin then ymin:=y;

x:=x+hx1 end;

ymax:=round(ymax/ok+0.4999)*ok;

ymin:=round(ymin/ok-0.5)*ok;

end;

{ креслення графіка функції }

procedure graf;

begin

setlinestyle(0,0,3);

x:=xn; setcolor(4);

x1:=round(mx*x+sx);

y1:=round(-my*f(x)+sy);

while x<=xk-hx1 do

begin

x:=x+hx1;

x2:=round(mx*x+sx);

y2:=round(-my*f(x)+sy);

line(x1,y1,x2,y2);

x1:=x2; y1:=y2; end

end;

begin

hx1:=(xk-xn)/200;

maxmin;

{розрахунок масштабів для осей }

hx:=(xk-xn)/10;

hy:=(yb-ya) div 8;

mx:=(xb-xa)/(xk-xn);

my:=(yb-ya)/(ymax-ymin);

sy:=ya+my*ymax;

sx:=xa-mx*xn;

setfillstyle(1,7);

bar(xa,ya,xb,yb);

{ горизонтальна вісь }

setlinestyle(0,0,1);

settextjustify(1,2);

settextstyle(0,0,1);

x:=xn; i:=round(mx*x+sx);

while i<=xb+1 do begin

setcolor(15); line(i,ya,i,yb);

setcolor(14); str(x:4:2,st);

outtextxy(i,yb+3,st);

x:=x+hx; i:=round(mx*x+sx); end;

{ прямовисна вісь }

settextjustify(2,1);

i:=yb;

while i>=ya do

begin

setcolor(15);

line(xa,i,xb,i);

yy:=(sy-i)/my;

setcolor(14);

str(yy:4:2,st);outtextxy(xa-3,i,st);

i:=i-hy;

end;

graf;

end;

Нижче наведена процедура Kurcorx креслення курсору - візирної лінії, що переміщується внаслідок натиску клавіш <ліворуч>, <праворуч>, а також видає на екран значення аргументу x i функції f(x) у поточній точці.

procedure Kurcorx(xn,xk:real;

xa,ya,xb,yb:integer;f:fun);

var x,mx,sx,y : real;

i,hi : integer; st : string; ch : char;

procedure out;

begin

setcolor(11); setlinestyle(0,0,3);

line(i,ya,i,yb)

end;

procedure quit;

begin

setfillstyle(1,1);

bar(xb+15,yb-55,xb+86,yb-43);

setcolor(15);

settextjustify(0,0);

outtextxy(xb+18,yb-45,'QUIT-ESC');

end;

begin

mx:=(xb-xa)/(xk-xn);

sx:=xa-mx*xn;

hi:=4;i:=xa;

quit;

setwritemode(xorput);

out;

while true do begin

ch:=readkey; if ch=#27 then exit;

if ch=#0 then begin ch:=readkey;

case ch of

#75 : begin out; i:=i-hi; if i<xa then i:=xa; out end;

#77 : begin out; i:=i+hi; if i>xb then i:=xb; out end;

#71 : begin out; i:=xa; out end;

#79 : begin out; i:=xb; out end;

end;

x:=(i-sx)/mx; y:=f(x);

setviewport(xb+15,yb-30,getmaxx,yb,false);

setcolor(14);

clearviewport;

str(x:4:2,st);outtextxy(4,12,'X='+st);

str(y:5:2,st);outtextxy(4,27,'F='+st);

setviewport(0,0,getmaxx,getmaxy,true);

end

end { while }

end;

Приклад програми із використанням процедур

Graffun i Kurcorx

Приклад 45. Побудувати на екрані графічного дисплея кусочно-лінійний графік функції y=10e^-x/4sin(2x) при зміні аргументу x від 1,5 до 6,5. Для зазначення крапки графіка використати курсор-візирну лінію.

Програма має вид:

PROGRAM PR45;

USES CRT,GRAPH;

TYPE fun=function(x:real):real;

VAR GD,GM : INTEGER;

{$f+}

function f(x:real):real;

begin f:=10*exp(-x/4)*sin(2*x) end;

{$f-}

BEGIN

GD:=DETECT; INITGRAPH(GD,GM,'');

SETBKCOLOR(9);

Graffun(1.5,6.5,0.5,60,8,getmaxx-90,getmaxy-23,f);

Kurcorx(1.5,6.5,60,8,getmaxx-90,getmaxy-23,f);

CLOSEGRAPH;

END.