Программирование на Pascal / Delphi / Курсовая работа - Нахождение значения определённого интеграла методом трапеций / trapint

program TrapInt;
{$N+}
uses Crt, Graph, Dos;

var
MaxByX, MaxByY: Double;


procedure HandleKey(Code: Char); forward;

function F(X: Double): Double;
begin
F := 1 / (2 + X);
end;

procedure ShowMenu;
var
Select: Char;
begin
Select := #0;
repeat
ClrScr;
if not ((Ord(Select) >= Ord('0')) and (Ord(Select) <= Ord('4'))) and (Ord(Select) <> 0) then
begin
TextColor(Red);
WriteLn('ЌҐўҐа­л© ўлЎ®а. Ќ ¦¬ЁвҐ зЁб«®ўго Є­®ЇЄг ®в 0 ¤® 4.');
end
else
begin
TextColor(7);
WriteLn('Ќ ¦¬ЁвҐ жЁдаг, зв®Ўл ўлЎа вм Їг­Єв ¬Ґ­о.');
end;
TextColor(7);
WriteLn('=====================================');
WriteLn('1. €­вҐЈаЁа®ў ­ЁҐ');
WriteLn('2. ѓа дЁЄ дг­ЄжЁЁ');
WriteLn('3. ’ Ў«Ёж  §­ зҐ­Ё©');
WriteLn('4. ‘ўҐ¤Ґ­Ёп ® Їа®Ја ¬¬Ґ');
WriteLn('0. ‚л室');
Select := ReadKey;
HandleKey(Select);
until Select = '0';
end;

{ Ћв®Ўа ¦Ґ­ЁҐ дг­ЄжЁЁ ­  нЄа ­Ґ }
procedure PrintFunction;
begin
GoToXY(WhereX + 3, WhereY);
Write('1');
GoToXY(WhereX - 4, WhereY + 1);
Write(#196#196#196#196#196#196#196);
GoToXY(WhereX - 6, WhereY + 1);
Write('2 + x');
GoToXY(WhereX - 6, WhereY + 1);
end;

procedure StartGraph;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
begin
grDriver := Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode <> grOk then
Writeln('ЋиЁЎЄ  Ё­ЁжЁ «Ё§ жЁЁ Ја дЁЄЁ: ', GraphErrorMsg(ErrCode));
end;

procedure EndGraph;
begin
CloseGraph;
end;

procedure Tablica;
var
X1, X2, Delta, CurrX: Double;
KolVo, I: Integer;
Data: array[1..100] of Double;
Counter: Integer;
begin
ClrScr;
WriteLn('Џ®бв஥­ЁҐ в Ў«Ёжл §­ зҐ­Ё© ¤«п дг­ЄжЁЁ');
PrintFunction;
WriteLn;
repeat
Write('‚ўҐ¤ЁвҐ X1: ');
ReadLn(X1);
Write('‚ўҐ¤ЁвҐ X2: ');
ReadLn(X2);
if X1 >= X2 then
WriteLn('X1 ¤®«¦­® Ўлвм ¬Ґ­миҐ X2');
until X1 < X2;
repeat
Write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® §­ зҐ­Ё© (2 - 100): ');
ReadLn(KolVo);
until (KolVo >= 2) and (KolVo <= 100);
Delta := (X2 - X1) / (KolVo - 1);
CurrX := X1;
for I := 1 to KolVo do
begin
{ ‡­ зҐ­ЁҐ дг­ЄжЁЁ ў в®зЄҐ -2 ­Ґ ®ЇаҐ¤Ґ«Ґ­® }
if (Abs(CurrX + 2)) >= 0.0001 then
Data[I] := F(CurrX);
CurrX := CurrX + Delta;
end;
{ ‚лў®¤Ё¬ и ЇЄг в Ў«Ёжл }
WriteLn(#218#196#196#196#196#196#196#196#196#196#196#196#194#196#196,
#196#196#196#196#196#196#196#196#196#196#191);
WriteLn(#179, 'x':11, #179, 'f(x)':12, #179);
WriteLn(#195#196#196#196#196#196#196#196#196#196#196#196#197#196#196,
#196#196#196#196#196#196#196#196#196#196#180);
CurrX := X1;
Counter := 0;
for I := 1 to KolVo do
begin
{ …б«Ё ў в Ў«ЁжҐ ¬­®Ј® §­ зҐ­Ё©, в® ўлў®¤Ё¬ Ї® з бвп¬ }
if Counter >= 15 then
begin
ReadKey;
Counter := 0;
end;
{ …б«Ё §­ зҐ­ЁҐ X Ї®звЁ ­Ґ®в«ЁзЁ¬® ®в -2, в® §­ зҐ­ЁҐ дг­ЄжЁЁ
­Ґ ®ЇаҐ¤Ґ«Ґ­® Ё ЇЁиҐ¬ ў в Ў«ЁжҐ Їа®зҐаЄ }
if (Abs(CurrX + 2)) >= 0.0001 then
WriteLn(#179, CurrX:11:5, #179, Data[I]:12:5, #179)
else
WriteLn(#179, CurrX:11:5, #179, '-':12, #179);
CurrX := CurrX + Delta;
Counter := Counter + 1;
end;
WriteLn(#192#196#196#196#196#196#196#196#196#196#196#196#193#196#196,
#196#196#196#196#196#196#196#196#196#196#217);
ReadKey;
end;

{ ”г­ЄжЁп ЇҐаҐбзҐв  Є®®а¤Ё­ в Ї® X }
function XX(X: Double): Integer;
begin
XX := Round(320 + X * (320 / MaxByX) * 0.9);
end;

{ ”г­ЄжЁп ЇҐаҐбзҐв  Є®®а¤Ё­ в Ї® X }
function YY(Y: Double): Integer;
begin
YY := Round(240 - Y * (240 / MaxByY) * 0.9);
end;

procedure DrawOsi;
var
DMX: Double; { „«Ё­  ¬ҐвЄЁ Ї® ®бЁ X }
DMY: Double; { „«Ё­  ¬ҐвЄЁ Ї® ®бЁ Y }
MetkiX: array[1..3] of Double;
MetkiY: array[1..3] of Double;
I: Integer;
StrXVal, StrYVal: string[20];
begin
SetColor(White);
{ “бв ­®ўЁвм в®«йЁ­г «Ё­ЁЁ ў 1 ЇЁЄбҐ«м }
SetLineStyle(SolidLn, 0, NormWidth);
Line(XX(-MaxByX), YY(0), XX(MaxByX), YY(0));
Line(XX(0), YY(MaxByY), XX(0), YY(-MaxByY));
DMX := MaxByX / 4;
DMY := MaxByY / 4;
for I := 1 to 3 do
begin
MetkiX[I] := DMX * I;
MetkiY[I] := DMY * I;
end;
{ ђЁб㥬 ­ бҐзЄЁ ­  ®бпе }
for I := 1 to 3 do
begin
Line(XX(MetkiX[I]), YY(-MaxByY * 0.025), XX(MetkiX[I]), YY(MaxByY * 0.025));
Line(XX(-MaxByX * 0.025), YY(MetkiY[I]), XX(MaxByX * 0.025), YY(MetkiY[I]));
Line(XX(-MetkiX[I]), YY(-MaxByY * 0.025), XX(-MetkiX[I]), YY(MaxByY * 0.025));
Line(XX(-MaxByX * 0.025), YY(-MetkiY[I]), XX(MaxByX * 0.025), YY(-MetkiY[I]));
end;

{ Џ®¤ЇЁиҐ¬ жЁдал ў®§«Ґ ®бҐ© }
for I := 1 to 3 do
begin
Str(MetkiX[I]:0:2, StrXVal);
Str(MetkiY[I]:0:2, StrYVal);
{ “бв ­®ўЁвм ўла ў­Ёў ­ЁҐ ⥪бв  }
SetTextJustify(CenterText, BottomText);
OutTextXY(XX(MetkiX[I]), YY(MaxByY * 0.05), StrXVal);
OutTextXY(XX(-MetkiX[I]), YY(MaxByY * 0.05), '-' + StrXVal);
SetTextJustify(LeftText, CenterText);
OutTextXY(XX(MaxByX * 0.05), YY(MetkiY[I]), StrYVal);
OutTextXY(XX(MaxByX * 0.05), YY(-MetkiY[I]), '-' + StrYVal);
end;
end;

procedure Grafik;
var
X1, X2, Delta, CurrX, LastY: Double;
Data: array[1..1000] of Double;
KolVo, I: Integer;
begin
WriteLn('Џ®бв஥­ЁҐ Ја дЁЄ  дг­ЄжЁЁ');
PrintFunction;
WriteLn;
repeat
Write('‚ўҐ¤ЁвҐ X1: ');
ReadLn(X1);
Write('‚ўҐ¤ЁвҐ X2: ');
ReadLn(X2);
if X1 >= X2 then
WriteLn('X1 ¤®«¦­® Ўлвм ¬Ґ­миҐ X2');
until X1 < X2;
repeat
Write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® §­ зҐ­Ё© Ї® Є®в®ал¬ Ўг¤Ґв Ї®бв஥­ Ја дЁЄ (10 - 1000): ');
ReadLn(KolVo);
until (KolVo >= 10) and (KolVo <= 1000);
Delta := (X2 - X1) / (KolVo - 1);
CurrX := X1;
if Abs(X1 + 2) >= 0.01 then
MaxByY := Abs(F(X1))
else
MaxByY := Abs(F(X1 + 0.01));
for I := 1 to KolVo do
begin
{ ‡­ зҐ­ЁҐ дг­ЄжЁЁ ў в®зЄҐ -2 ­Ґ ®ЇаҐ¤Ґ«Ґ­® }
if (Abs(CurrX + 2)) >= 0.01 then
begin
Data[I] := F(CurrX);
if Abs(Data[I]) > MaxByY then
MaxByY := Abs(Data[I]);
end;
CurrX := CurrX + Delta;
end;
if Abs(X1) > Abs(X2) then
MaxByX := Abs(X1)
else
MaxByX := Abs(X2);
StartGraph;
DrawOsi;
CurrX := X1;
LastY := Data[1];
SetColor(Magenta);
{ “бв ­®ўЁвм в®«йЁ­г «Ё­ЁЁ ў 3 ЇЁЄбҐ«п
(зв®Ўл Ја дЁЄ Ўл« «гзиҐ ўЁ¤Ґ­) }
SetLineStyle(SolidLn, 0, ThickWidth);
MoveTo(XX(X1), YY(Data[1]));
for I := 1 to KolVo do
begin
if (Abs(CurrX + 2)) >= 0.01 then
begin
if LastY * Data[I] > 0 then
LineTo(XX(CurrX), YY(Data[I]))
else
MoveTo(XX(CurrX), YY(Data[I]));
LastY := Data[I];
end;
{WriteLn(XX(CurrX):15, YY(Data[I]):15);}

CurrX := CurrX + Delta;
end;
ReadKey;
EndGraph;
end;

procedure ProgramInfo;
begin
ClrScr;
WriteLn('Џа®Ја ¬¬  ¤«п Ё­вҐЈаЁа®ў ­Ёп дг­ЄжЁЁ');
PrintFunction;
WriteLn('¬Ґв®¤®¬ ва ЇҐжЁ©');
WriteLn('€¬ҐҐвбп ў®§¬®¦­®бвм Ї®бв஥­Ёп Ја дЁЄ  дг­ЄжЁЁ Ё в Ў«Ёжл §­ зҐ­Ё©');
ReadKey;
end;

function IntegralTrap(a: Double; b: Double; n: LongInt): Double;
var
s1, h, pos: Double;
i: LongInt;
begin
h := (b - a) / n;
i := 0;
s1 := 0;
pos := a;
repeat
s1 := s1 + (F(pos) + F(pos + h)) / 2 * h;
pos := pos + h;
i := i + 1;
until (i >= n);
IntegralTrap := s1;
end;

procedure Integral;
var
a, b: Double;
n: LongInt;
IntVal: Double;
begin
ClrScr;
WriteLn('‚лзЁб«Ґ­ЁҐ §­ зҐ­Ёп ®ЇаҐ¤Ґ«Ґ­­®Ј® Ё­вҐЈа «  дг­ЄжЁЁ');
PrintFunction;
WriteLn('¬Ґв®¤®¬ ва ЇҐжЁ© ­  Ё­вҐаў «Ґ [a; b] б ¤Ґ«Ґ­ЁҐ¬ дг­ЄжЁЁ ­  n з б⥩');
WriteLn;
repeat
repeat
Write('‚ўҐ¤ЁвҐ a: ');
ReadLn(a);
Write('‚ўҐ¤ЁвҐ b: ');
ReadLn(b);
if (a >= b) then
begin
WriteLn('‡­ зҐ­ЁҐ a ¤®«¦­® Ўлвм ¬Ґ­миҐ, 祬 §­ зҐ­ЁҐ b');
end;
until (a < b);
if ((a <= -2) and (b >= -2)) or (a = -2) or (b = -2) then
begin
WriteLn('‚ в®зЄҐ -2 г дг­ЄжЁЁ Ё¬ҐҐвбп а §алў, Ї®н⮬㠭Ґў®§¬®¦­® ­ ©вЁ');
WriteLn('§­ зҐ­ЁҐ Ё­вҐЈа «  ­  ®в१ЄҐ, ўЄ«оз о饬 в®зЄг -2');
end;
until not (((a <= -2) and (b >= -2)) or (a = -2) or (b = -2));
repeat
Write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® з б⥩ (ва ЇҐжЁ©): ');
ReadLn(n);
if (n < 1) then
begin
WriteLn('‡­ зҐ­ЁҐ n ¤®«¦­® Ўлвм ­Ґ ¬Ґ­ҐҐ 1');
end;
until n >= 1;
Write('ђ бзҐв Ё­вҐЈа « ...');
IntVal := IntegralTrap(a, b, n);
WriteLn('ЋЉ');
WriteLn;
WriteLn('ЋЇаҐ¤Ґ«Ґ­­л© Ё­вҐЈа « ­  Ё­вҐаў «Ґ [', a:0:6, '; ', b:0:6, '] а ўҐ­ ', IntVal:0:10);
ReadKey;
end;

procedure HandleKey(Code: Char);
begin
case Code of
'1': Integral;
'2': Grafik;
'3': Tablica;
'4': ProgramInfo;
end;
end;

begin
ShowMenu;
ReadLn;
end.