Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Lazarus, Free Pascal, CodeTyphon
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.12.2019, 12:11   #1
Knicker
Новичок
Джуниор
 
Регистрация: 27.12.2019
Сообщений: 2
По умолчанию Закрашивание площади под графиком

Необходимо закрасить площадь под графиком при вводе границ. Заранее спасибо. Вот код:

program lab3;
uses crt,Graph;
var y, x ,s , h ,a1,b1,fmin,fmax,dx,dy,mx,my,x1,y1, num,num1,num2:real;
Gd,Gm,x0,y0,x2,y2,a,b,xLeft,yLeft,x Right,yRight,k,n1,x3,y3,l,r:integer ;
n,i,C:byte;
st:string;
c1,c2:char;
function f(x:real):real;
begin
f:=(x*x*x) - 4*x+12;
end;
function f2(x:real):real;
begin
f2:=(x*x*x*x)/4 - 2*(x*x) +12*x;
end;
function simpson( a,b:real ; k:integer):real;
var h,x,s:real;
begin
h:=(b-a)/k;
s:=0 ; x:=a+h;
while (x<b) and (x>-2.862) do
begin
s:=s+4*f(x);
x:=x+h;
s:=s+2 *f(x);
x:=x+h;
end;
s:= h/3 * (s+f(a)-f(b) ) ;
simpson:=s ;
end;
function Runge(a,b:real ; k:integer):real;
var s1,s2:real;
begin
s1:=simpson(a , b , k);
s2:=simpson(a , b , 2*k);
Runge:= 1/15 * abs(s2-s1);
end;
procedure mashtab(x2,y2:real);
var kf:byte;x3,y3:real;
begin
kf:=2;
x3:=x2*kf;
y3:=y2*kf;
end;
begin
repeat
writeln(' 1 - Print task') ;
writeln(' 2 - Entering borders and number of segments');
writeln(' 3 - Calculate step');
writeln(' 4 - Function area calculation');
writeln(' 5 - Opredelenie pogreshnosti');
writeln(' 6 - Perehod v graph');
writeln(' 0 - Exit');
writeln(' Select:');
readln(n);
clrscr;
case n of
1:writeln(' Realizovat programu vichislenia ploshadi figuri metodom Simpsona , ogranichenoi krivoi x^3-4x+12');
2:begin
repeat
writeln(' Enter borders and number of segments');
readln(a,b,k);
until (a<b) and (k>0) and (k mod 2 = 0 );
end;
3:writeln (' The step is:',( (b-a)/k ):0:2 );
4:writeln (' The square is: ' , simpson(a,b,k):0:2 );
5:writeln(' Pogreshnost: ' , Runge(a,b,k):0:4 );
6:begin
Gd:=Detect;
Gm:=GetMaxMode;
InitGraph(Gd , Gm , ' ');
If GraphResult <> 0 then writeln (' Ïðîèçîøëà îøèáêà èíèöèàëèçàöèè ')
else begin
x0:=0;xLeft:=50;yLeft:=50;
xRight:=GetMaxX-50;yRight:=GetMaxY-50;
a1:=-3;b1:=6;dx:=1;
fmin:=-36; fmax:=27; dy:=1;
mx:=(xRight - xLeft) / (b1-a1); //Ìàñøòàá ïî Õ
my:=(yRight - yLeft) / (fmax - fmin); //Ìàñøòàá ïî Y
x0:=trunc(abs(a1) * mx) + xLeft;
y0:=yRight - trunc(abs(fmin) *my);
Line(xLeft , y0 , xRight+10,y0); //Ox
Line(x0 , yLeft-10, x0 , yRight); //Oy
SetColor(4);
SetTextStyle(1,0,1);
OutTextXY(xRight+20 , y0-15 , 'X');
OutTextXY(x0-15 , yLeft-35 , 'Y');
SetColor(1);
n1:=round ((b1-a1) / dx)+1 ;
for i:=1 to n do begin
num:= a1 + (i-1) * dx;
x2:= xLeft + trunc(mx*(num-a1));
Line(x2 , y0-3, x2 , y0+3);
Str(num:0:1 , st);
if abs(num)>1E-15 then
OutTextXY(x2 - TextWidth(st) div 2 , y0+10, st);
end;
n:=round ((fmax-fmin)/dy)+1;
for i:=1 to n do begin
num:= fmin + (i-1)* dy;
y2:=yRight - trunc(my* (num-fmin));
Line(x0-3,y2,x0+3,y2);
str(num:0:0,st);
If abs(num)>1E-15 then
OutTextXY(x0+7, y2-TextHeight(st) div 2,st);
end;
x1:=a1;
while x1<=b1 do begin
y1:= f(x1);
x2:=x0 + round(x1*mx);
y2:=y0 - round(y1*my);
if (y2>=yLeft) and (y2<=yRight) then PutPixel(x2,y2,4);
x1:=x1+0.001;
end;
SetColor(15);
OutTextXY(GetMaxX div 2 + 100 , 50 , 'f(x) = x^3-4x+12');
end;
end;
end;
until n=0;
end.
Knicker вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задача с графиком Bogdan9393 Помощь студентам 3 05.12.2016 14:01
Проблема с графиком! yulkaa Visual C++ 1 06.06.2016 06:45
Написать программу вычисления площади многоугольника используя формулу для вычисления площади треугольника в качестве подпрограммы сердце Паскаль, Turbo Pascal, PascalABC.NET 0 24.12.2012 18:21
Задача с графиком Mattesich Помощь студентам 2 15.08.2012 22:31