Листинг программы
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.