написанные программы / задание №5 — 1 / PRO5_DEM

program pro5;
uses Crt,Graph;
type Arr=array[1..4] of string;
var a,b,Num,Fraction,dx,xn,xk,F1:Real;
Mas1,Mas2:array[1..50] of Real;
GraphDriver,GraphMode,i,j,bp:Integer;
Ch:Char;
const A1: Arr=('Parameters','Make ','Graphics ','Exit ');

function FirstFunc(x:Real):Real;
begin
Fraction:=1;
F1:=0;
Num:=x*ln(a);
for i:=1 to 70 do begin
Fraction:=Fraction*Num/i;
if abs(Fraction)< 0.0001 then Break;
F1:=F1+Fraction;
end;
FirstFunc:=F1+1;
end;

function SecFunc(x:Real):Real;
begin
SecFunc:=Exp(x*Ln(a))+b;
end;

procedure Environment;
begin
clrscr;
TextColor(7);
TextBackground(0);
gotoXY(1,19);
Write('Й'); for i:=1 to 77 do Write('Н'); Writeln('»');
for i:=1 to 4 do begin
Write('є ',A1[i]); for j:=1 to 64 do Write(' '); Writeln('є');
end;
Write('И'); for i:=1 to 77 do Write('Н'); Writeln('ј');
TextColor(4);
gotoXY(5,20); Write('P'); gotoXY(5,21); Write('M');
gotoXY(5,22); Write('G'); gotoXY(5,23); Write('E');
TextColor(7);
gotoXY(30,21); Write(' a=',a:2:3);
gotoXY(60,21); Write(' b=',b:2:0);
end;

procedure Parameters;
label 1;
begin
1: gotoXY(30,21); Write(' a= '); Read(a);
if (a<0) or (a>30) or (a<0.33) then begin gotoXY(25,22);
Write('Impossible meaning!'); goto 1; end;
gotoXY(60,21); Write(' b= '); Read(b);
gotoXY(25,22); Write('This meanings may not fit to both functions');
Readkey;
end;

procedure ParameterScales;
begin
if (abs(b)>19) and (abs(b)<99) then bp:=10
else if (abs(b)>99) and (abs(b)<999) then bp:=100
else bp:=1;
end;

procedure Calculation;
var k:Word;
begin
xn:=-19;
for k:=1 to 48 do begin
Mas1[k]:=FirstFunc(xn);
Mas2[k]:=SecFunc(xn);
xn:=xn+dx;
if xn=xk+1 then Break;
end;
end;

procedure Make;
var f:Text;
begin
assign(f,'C:\pro5_res.txt');
Rewrite(f);
gotoXY(1,1);
Writeln(' x і f(x,a) і f(x) ');
Writeln('ДДДДДЕДДДДДДДДДДДДЕДДДДДДДДД');
Writeln(f,' x і f(x,a) і f(x) ');
Writeln(f,'ДДДДДЕДДДДДДДДДДДДЕДДДДДДДДД');
xn:=-16;
i:=4;
while (i>3) and (i<20) do begin
writeln(' ',xn:3:0,' і ',Mas1[i]:7:2,' і ',Mas2[i]:7:2);
writeln(f,' ',xn:3:0,' і ',Mas1[i]:7:2,' і ',Mas2[i]:7:2);
xn:=xn+dx; Inc(i);
end;
j:=1;
while (i>19) and (i<38) do begin
gotoXY(35,j);
Writeln(' ',xn:3:0,' і ',Mas1[i]:7:2,' і ',Mas2[i]:7:2);
Writeln(f,' ',xn:3:0,' і ',Mas1[i]:7:2,' і ',Mas2[i]:7:2);
Inc(j);
Inc(i);
xn:=xn+dx;
end;
Close(f);
Readkey;
end;

procedure Graphics;
var x1:Real;
x,y:Integer;
label 1;
begin
InitGraph(GraphDriver,GraphMode,'D:\BORLAND\BGI\');
SetViewPort(0,0,460,410,True);
SetColor(7);
OutTextXY(120,1,'Function Graphics');
if bp=1 then OutTextXY(167,187,'1')
else if bp=10 then OutTextXY(160,187,'10')
else if bp=100 then OutTextXY(155,187,'100');
Line(1,204,450,204); Line(450,204,445,199); Line(450,204,445,209);
Line(180,15,180,350); Line(180,15,176,19); Line(180,15,184,19);
OutTextXY(170,208,'0'); OutTextXY(188,210,'1');
OutTextXY(165,15,'Y'); OutTextXY(450,214,'X');
x:=0;
while x<450 do begin
Line(x,202,x,206);
x:=x+10;
end;
y:=24;
while y<350 do begin
Line(178,y,182,y);
y:=y+10;
end;
xn:=-19;
if a<1 then begin x1:=ln(205-b/bp)/ln(a);
MoveTo(180+Round(x1)*10,0); end
else MoveTo(0,205-Trunc(Mas2[1]*10));
for i:=2 to 48 do begin
SetColor(4);
y:=Trunc(Mas2[i]*10/bp);
LineTo(180+Round(xn)*10,205-y);
if (a>1) and (205-y<0) then Break;
xn:=xn+dx;
end;
OutTextXY(15,300,'ю y=f(x)');
if (a>2.7) or (a<1) then goto 1;
SetColor(6);
xn:=-19;
if a<1 then begin x1:=ln(205)/ln(a);
MoveTo(180+Round(x1)*10,0); xn:=x1*10+dx; end
else MoveTo(0,210-Trunc(Mas1[1]*10));
for i:=2 to 48 do begin
y:=Trunc(Mas1[i]*10);
LineTo(180+Trunc(xn)*10,205-y);
if (a>1) and (205-y<0) then Break;
xn:=xn+dx;
end;
OutTextXY(15,320,'ю y=f(x,a)');
1: SetColor(7);
OutTextXY(5,340,'Press any key...');
Readkey;
CloseGraph;
end;

begin
clrscr;
GraphDriver:=Detect;
GraphMode:=2;
TextBackground(0);
TextColor(7);
Environment;
xn:=-19; xk:=25; dx:=1;
while True do begin
Ch:=Readkey;
case UpCase(Ch) of
'P': begin Parameters; ParameterScales; Calculation; end;
'M': Make;
'G': Graphics;
'E': begin clrscr; Halt; end;
end;
Environment;
end;
end.