Program Programm;
uses crt;
var n:Byte; 1,2,3:integer;
begin
write('Enter');
ReadKey;
begin
repeat
ClrScr;
Writeln('Program 1 - 1');
Writeln('Program 2 - 2');
Writeln('Program 3 - 3');
writeln('Exit - 0');
writeln('Select program: ');
Readln(n);
Case n of
1:zadanie1;
2:zadanie2;
3:zadanie3;
end;
until n <> 0;
end;
{**************************ПРОЦЕДУРА №1**********************************}
procedure zadanie1 (N,H,k,j,p,i,o:integer; e,s,z,x,c,d:real);
begin
clrscr;
Write('Summa ryada: ','N(k*N+k+2*i)/2*k'); writeln;
write('Vvedite chislo integer: ');
Read(N);
write('Vvedite chislo real: ');
Read(x);
begin
i:=1;
k:=N*(N+2*i);
c:=N*((k*N)+(2*i)+k)/2*k;
write('OTBET=',c);
begin
writeln;
Write('Proizvedenie ryada: ','1/(j+h)*(Pi*h)'); writeln;
write('Vvedite chislo integer: ');
Read(H);
write('Vvedite chislo real: ');
Read(z);
begin
j:=1;
for o:= 0 to N do
repeat
p:=(H+j)*o until true;
e:=j/(H+j)*p;
write('OTBET=',e);
begin
s:=c*e;
writeln;
writeln('Uravnenie resheno');
writeln('OTBET=',s);
writeln('Enter');
readln;
end;
end;
end;
end;
end;
{**************************ПРОЦЕДУРА №2**********************************}
procedure zadanie2(p,q,eps,d,h,x,x1,x2:real);
begin
clrscr;
writeln('vvedite koeffic p,q uravn:');
write('p=');readln(p);
write('q=');readln(q);
write('Vvedite tochnost` opredel kornya eps=');{type 0.0001}
readln(eps);
d:=p*p-4*q;{Disq}
if d<0 then
begin
writeln('Uravnen ne imeet resheneeya!');
readln;
exit;
end
else if d = 0 then
begin
writeln('x1=x2=',-p/2:0:5);
readln;
exit;
end
else
begin
x:=-p/2;x2:=-p/2;h:=eps/10;
repeat
x1:=x1-h;
x2:=x2+h;
until (abs(x1*x2-q)<=eps);
end;
writeln('x1=',x1:0:5,' x2=',x2:0:5);
writeln('proverka po formule:');
writeln('x1=',(-p-sqrt(d))/2:0:5,' x2=',(-p+sqrt(d))/2:0:5);
writeln('Enter');
readln;
end;
{**************************ПРОЦЕДУРА №3**********************************}
procedure zadanie3 (t,x,y,z:integer);
begin
x:=1;
y:=2;
z:=3;
while (x=y) or (y=z) or (x=z) do
begin
t:=0;
end;
while (x<>y) or (y<>z) or (x<>z) do
begin
t:=1;
end;
write('Enter');
readln;
end.