Приложение
program practica;
uses crt,graph;
type massiv=array[1..1000] of char;
massiv1=array[1..100] of real;
const a=-1;b=8;
var i,l,j,g,v,gd,gm,kx,ky,k,pox,poy,mx,my,kor,cas:integer; x,eps1,eps2,y1,y2,h,x1,x2,c0,c:real; st:string;
f:text;
mas:massiv;
mas1:massiv1;
function fun(z:real):real;
begin
fun:=0.9*sqr(z)*z-7*sqr(z)+5.9*z+1.5;
end;
procedure zvuk_in;
begin
sound(2500);
delay(2000);
sound(5000);
delay(2000);
sound(7500);
delay(2000);
nosound;
end;
procedure zvuk_out;
begin
sound(7500);
delay(2000);
sound(5000);
delay(2000);
sound(2500);
delay(2000);
nosound;
end;
procedure avtor;
begin clrscr;
gd:=detect;
initgraph(gd,gm,'c:\bp\bgi');
setbkcolor(2);
setcolor(14);
outtextxy(80,70,'Бурлов Александр Сергеевич');
outtextxy(80,90,'Radist Company');
outtextxy(80,110,'Уральский Государственный Технический Университет УГТУ-УПИ');
outtextxy(80,130,'Филиал в г.Краснотурьинске');
outtextxy(80,150,'All rights reserved. Смотри не нарушай! 2003');
setcolor(4);
outtextxy(290,262,'radio');
outtextxy(320,272,'fuck');
outtextxy(288,315,'Р-231КТ');
setcolor(15);
rectangle(280,240,360,300);
rectangle(287,247,353,293);
line(280,240,287,247); line(280,300,287,293);
line(360,300,353,293); line(360,240,353,247);
line(280,240,305,225); line(360,240,370,225);
line(370,225,370,275); line(305,225,370,225);
line(370,275,360,300); line(265,305,365,305);
line(265,305,265,330); line(360,335,365,335);
line(365,335,365,305); line(365,305,385,275);
line(365,335,385,305); line(385,306,385,275);
line(385,275,370,275); line(265,305,279,284);
line(260,330,360,330); line(260,330,240,355);
line(360,330,340,355); line(240,355,340,355);
line(360,340,340,360); line(240,360,340,360);
line(240,360,240,355); line(340,360,340,355);
line(360,340,360,330);
readkey;
zvuk_out;
closegraph;
end;
procedure zadanie;
begin clrscr;
assign(f,'c:\zadanie.txt');
reset(f);
i:=0;
textcolor(10);
while not(eof(f)) do begin
i:=i+1;
read(f,mas[i]);
write(mas[i]);
end;
readkey;
zvuk_out;
close(f);
end;
procedure graphik;
begin clrscr;
gd:=detect;
initgraph(gd,gm,'c:\bp\bgi');
setbkcolor(15);
setcolor(8);
if graphresult<>0 then
writeln('Ошибка №=',graphresult)
else begin
g:=getmaxx;
v:=getmaxy;
pox:=getmaxx div 2;
poy:=getmaxy div 2;
line(0,poy,g,poy);
line(g,poy,g-5,poy-2);
line(g,poy,g-5,poy+2);
line(pox,0,pox,v);
line(pox,0,pox-2,5);
line(pox,0,pox+2,5);
outtextxy(g-7,poy+4,'x');
outtextxy(pox-13,0,'y');
k:=0;
mx:=30;
my:=30;
kx:=pox;
while kx<g do begin
line(kx,poy-2,kx,poy+2);
str(k,st);
outtextxy(kx-7,poy+5,st);
k:=k+1;
kx:=kx+mx;
end;
k:=-1;
kx:=pox-mx;
while kx>0 do begin
line(kx,poy-2,kx,poy+2);
str(k,st);
outtextxy(kx-11,poy+5,st);
k:=k-1;
kx:=kx-mx;
end;
k:=1;
ky:=poy-my;
while ky>0 do begin
line(pox-2,ky,pox+2,ky);
str(k,st);
outtextxy(pox-10,ky-3,st);
k:=k+1;
ky:=ky-my;
end;
k:=-1;
ky:=poy+my;
while ky<v do begin
line(pox-2,ky,pox+2,ky);
str(k,st);
outtextxy(pox-18,ky-3,st);
k:=k-1;
ky:=ky+my;
end;
x:=-1;
while x<=8 do begin
kx:=round(pox+mx*x);
ky:=round(poy-my*(fun(x)));
putpixel(kx,ky,8);
delay(25);
x:=x+0.001;
end;
readkey;
zvuk_out;
end;
closegraph;
end;
procedure reshenie;
label 11,22;
begin clrscr;
textcolor(2);
writeln('введите границы интервала, шаг табулирования и точность расчета корней');
writeln('a=',a);
writeln('b=',b);
write('h=');
readln(h);
write('eps1=');
readln(eps1);
write('eps2=');
readln(eps2);
kor:=0; x1:=a; x2:=x1+h;
while x2<=b do begin
y1:=fun(x1);
y2:=fun(x2);
if y1*y2<0 then begin
kor:=kor+1;
begin
l:=0;
if fun(x1)*fun(x2)<0 then begin
c0:=x1;
if fun(c0)*(5.4*c0-14)<0 then c0:=x2;
22:
c:=c0-fun(c0)/(2.7*sqr(c0)-14*c0+5.9);
l:=l+1;
mas1[l]:=c;
if abs(c-c0)>eps1 then begin
c0:=c;
goto 22;
end;
write(kor,'-й корень при точности eps1=',eps1:1:4,' ');
writeln(c:1:8);
end;
writeln('все приближения к этому корню');
for j:=1 to l do
writeln('mas1[',j,']=',mas1[j]:1:8);
writeln;
l:=0;
if fun(x1)*fun(x2)<0 then begin
c0:=x1;
if fun(c0)*(5.4*c0-14)<0 then c0:=x2;
11:
c:=c0-fun(c0)/(2.7*sqr(c0)-14*c0+5.9);
l:=l+1;
mas1[l]:=c;
if abs(c-c0)>eps2 then begin
c0:=c;
goto 11;
end;
write(kor,'-й корень при точности eps2=',eps2:1:4,' ');
writeln(c:1:8);
end;
writeln('все приближения к этому корню');
for j:=1 to l do
writeln('mas1[',j,']=',mas1[j]:1:8);
writeln;
readln;
end;
end;
x1:=x2;
x2:=x1+h;
end;
readkey;
zvuk_out;
end;
begin
repeat
clrscr;
writeln;
writeln;
writeln;
textcolor(14);
writeln(' * * * * * * * * * * * * * * * * * * * *');
writeln(' * *');
writeln(' * ГЛАВНОЕ МЕНЮ *');
writeln(' * 1.Автор *');
writeln(' * 2.Задание *');
writeln(' * 3.График функции *');
writeln(' * 4.Решение *');
writeln(' * 5.Выход *');
writeln(' * *');
writeln(' * * * * * * * * * * * * * * * * * * * *');
textcolor(12);
write('Выберете любой пункт меню и увидете результат: ');
readln(cas);
zvuk_in;
case cas of
1:avtor;
2:zadanie;
3:graphik;
4:reshenie;
end;
until cas=5;
end.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.