Фаронов В.В. "Turbo Pascal 7.0. Начальный курс": учебное пособие. – М.: Кнорус, 2006. – 576 с

1. Фаронов В.В. "Turbo Pascal 7.0. Начальный курс": учебное пособие. – М.: Кнорус, 2006. – 576 с.

2. Сухарёв М. Turbo Pascal 7.0. Теория и практика программирования. – СПб: "Наука и техника", 2003. – 576 с.

3. Методические указания по оформлению студенческих работ для студентов специальностей 080403 "Программное обеспечение автоматизированных систем", 080404 "Интеллектуальные системы принятия решений", 050103 "Экономическая кибернетика"; Утверждено на заседании учёного совета ДонГИИИ протокол № 7 от 23.02. 2004 г. – Донецк: ДонГИИИ, 2004, 46 с.

Приложение А

ТЕХНИЧЕСКОЕ ЗАДАНИЕ

А.1 Общие сведения

Полное название программного продукта: "Численные методы. Решение уравнений с одной переменной методом Ньютона (касательных)". Её условное обозначение РУОП. Работа выполняется студентом 1-го курса Донецкого государственного института искусственного интеллекта (ДонГИИИ), факультета СКИТ, группы СУА-05, Николаевым Алексеем Сергеевичем.

Основанием для разработки РУОП является задание, выданное кафедрой Программного обеспечения интеллектуальных систем (ПОИС).

Плановый срок начала работы: 17 февраля 2006 года.

Дата защиты работы: 22 мая 2006 года.

А.2 Назначения и цели создания программы

Данная программа создана как учебное пособие для студентов высших учебных заведений и для учащихся математических классов среднеобразовательных школ. Позволяет решать уравнения вида y(x) =a×ln(b×x) и y(x) =ax2+bx+c методом Ньютона (касательных).

А.3 Требования к программному продукту

А.3.1. Общие требования

Программа должна выполнять следующие требования:

1) решать два вида уравнений: y(x) =a×ln(b×x) и y(x) =ax2+bx+c методом Ньютона (касательных);

2) поддержку графического меню, состоящего из пяти пунктов:

– помощь и справочная информация;

– y(x) =a×ln(b×x);

– y(x) =a×x^2+b×x+c;

– построение графика;

– выход;

3) по вводимым значениям промежутков уравнения и по вводимым значениям коэффициентов уравнения:

– вычислять корень уравнения в зависимости от вводимых данных;

– выстраивать график уравнения, отмечая, на оси абсцисс, промежуточные корни уравнения, выводить значение корня уравнения.

А.3.2. Функциональные требования

Для реализации программного продукта необходимо разработать:

1) поддержку файлов, предоставление возможности решать пользователю самому, вводить начальные данные из файла или с клавиатуры, необходимость сохранения данных и полученных результатов в файлы;

2) систему справочной информации по реализуемому в РУОП методу Ньютона.

А.3.2. Требования к техническому обеспечению

Рекомендуемые характеристики аппаратных средств:

– КПУ: i486;

– ОЗУ: 4 мб;

– видеоадаптер VGA, EGA;

– монитор: VGA, EGA;

– клавиатура;

– свободное дисковое пространство – около 100 килобайт.

А.3.3. Требования к программному обеспечению

Для успешной загрузки программы требуется наличие операционной системы MS DOS 6.0.

А.3.5. Требования к организационному обеспечению

Организационное обеспечение включает в себя пояснительную записку с приложениями: техническое задание, руководство пользователя, экранные формы, тексты программы.

Приложение Б

РУКОВОДСТВО ПОЛЬЗОВАТЕЛЯ

Главное меню появляется после титульного листа. Меню состоит из пяти пунктов. Скроллинг осуществляется клавишами "z" и "x". Вход в подменю осуществляется клавишей "Enter".

В пункте "Справка" содержится методологическая информация по методу Ньютона.

В пункте "y(x) =a*ln(b*x)" осуществляется решение уравнения y(x) =a*ln(b*x) по вводимым параметрам, промежуткам и погрешности. В пункте осуществляется загрузка данных из файлов и сохранение данных в файлы по желанию пользователя.

В пункте "y(x) =a*x^2+b*x+c" осуществляется решение уравнения y(x) =a*x^2+b*x+c по вводимым параметрам, промежуткам и погрешности. В пункте осуществляется загрузка данных из файлов и сохранение данных в файлы по желанию пользователя.

В пункте "Построение графика" осуществляется построение графика по вводимым в уравнение данным.

В пункте "Выход" осуществляет выход из программы.

Приложение В

ЭКРАННЫЕ ФОРМЫ

Рисунок В.1 – Заставка, титульная страница

Рисунок В.2 – Меню

Рисунок В.3 – Общий вид окна "y(x) =a*ln(b*x)"

Рисунок В.4 – Общий вид окна "y(x) =a*x^2+b*x+c"

Рисунок В.5 – График функции y(x) =1*ln(0.5*x) на промежутке [1; 10]

Рисунок В.6 – График функции y(x) =5*sqr(x) +29*x+3 на промежутке [-10; 10]

Приложение Г

ЛИСТИНГ ПРОГРАММЫ

program Restorant;

uses CRT, Graph;

var a, b, c, m, n: real;

number, i: byte;

mass: array [1. . 20] of real;

{***************************************************************************}

procedure title;

begin

textcolor(2);

writeln (' Министерство образования Украины');

writeln (' Донецкий государственный институт искусственного интеллекта');

writeln;

writeln (' Кафедра ПОИС');

writeln;

writeln;

writeln (' Курсовая работа');

writeln (' По курсу "АЯ и П"');

writeln (' На тему: "Решение нелинейных уравнений методом Ньютона');

writeln (' (методом секущих)" ');

writeln;

writeln;

writeln (' Выполнил: ');

writeln (' Студент группы СУА-05');

writeln (' Николаев А.С. ');

writeln (' Проверил: ');

writeln (' cт. преп. кафедры ПОИС');

writeln (' Бычкова Е.В. ');

writeln (' асс. кафедры ПОИС');

writeln (' Волченко E. B. ');

writeln;

writeln (' 2005');

writeln;

writeln;

textcolor (red);

writeln ('Нажмите "Ввод" для продолжения"');

textcolor (lightgray); Readln;

end;

{***************************************************************************}

procedure pro; FORWARD;

{***************************************************************************}

procedure graphica;

var d, r, e: integer;

begin

d: =detect;

InitGraph (d, r, '');

e: =GraphResult;

if e <> grOK then WriteLn (GraphErrorMsg (e)) else pro;

end;

{***************************************************************************}

procedure setka (yn: integer; y2: real);

var x, y, cross, dcross: integer;

lx, ly, dlx, dly: real;

st: string;

begin

If abs (m) < abs (n) then

dlx: =Abs (n/6.25) else dlx: =Abs (m/6.25);

dly: =y2/((yn-110) /40);

dcross: =0;

lx: =6*dlx;

SetColor (LightGray);

For cross: = 1 to 7 do

begin

Str (lx: 0: 1, st);

If lx >=0 then

OutTextXY (535-dcross, yn+7, st) else

OutTextXY (525-dcross, yn+7, st);

lx: =lx-2*dlx;

dcross: =dcross+80;

end;

x: =80;

Repeat

SetLineStyle (DottedLn, 0, NormWidth);

Line (x, yn-3, x, 110); Line (x, yn+3, x, 360);

SetLineStyle (SolidLn, 0, NormWidth);

Line (x, yn-3, x, yn+3);

x: =x+40;

Until x = 600;

ly: =0;

y: =yn;

Repeat

If ly > 0 then

begin

Line (317, y, 323, y);

Str (ly: 0: 1, st);

OutTextXY (295, y+7, st);

end;

ly: =ly+dly;

SetLineStyle (DottedLn, 0, NormWidth);

Line (323, y, 570, y); Line (70, y, 317, y);

SetLineStyle (SolidLn, 0, NormWidth);

y: =y-40;

Until (y < 110);

ly: =0;

y: =yn;

Repeat

If ly < 0 then

begin

Line (317, y, 323, y);

Str (ly: 0: 1, st);

OutTextXY (285, y+7, st);

end;

ly: =ly-dly;

SetLineStyle (DottedLn, 0, NormWidth);

Line (323, y, 570, y); Line (70, y, 317, y);

SetLineStyle (SolidLn, 0, NormWidth);

y: =y+40;

Until (y > 360);

end;

{***************************************************************************}

{***************************************************************************}

procedure groffunc;

var l, y0: integer;

y1, y2, x, y, mx, my: real;

gr, grand: string;

{***************************************************************************}

function f (x: real): real;

begin

Case number of

1: f: =a*ln(b*x);

2: f: =a*sqr(x) +b*x+c;

end;

end;

{***************************************************************************}

begin

If number=0 then OutTextXY(300, 20, 'Введите сначала данные в уравнение!!! ') else

begin

ClearDevice;

SetBKColor (black);

case number of

1: grand: =('y(x) =*ln(*x) ');

2: begin grand: =('y(x) =*sqr(x) +*x+');

str (c: 0: 2, gr); insert (gr, grand, 17); end;

end;

str (b: 0: 2, gr); insert (gr, grand, (6+number*4));

str (a: 0: 2, gr); insert (gr, grand, 6);

OutTextXY (300, 40, grand);

y1: =0; y2: =0;

x: =m;

Repeat

y: =f (x);

if y < y1 then y1: =y;

if y > y2 then y2: =y;

x: =x+0.01;

Until (x >= n);

my: =250/abs (y2-y1);

If (abs (m) > abs (n)) then mx: =250/abs (m) else

mx: =250/abs (n);

y0: =360-abs (Round (y1*my));

setka (y0, y2);

SetColor (blue);

Line (320, 360, 320, 90);

Line (70, y0, 590, y0);

Line (320, 90, 317, 93); Line (320, 90, 323, 93);

Line (590, y0, 587, y0-3); Line (590, y0, 587, y0+3);

OutTextXY (595, y0-5, 'x'); OutTextXY (315, 80, 'y');

OutTextXY (400, 450, 'Нажмите "Ввод" для выхода');

If Abs (m) > Abs (n) then y1: =Abs (m) else y1: =Abs (n);

SetColor (Red);

str (mass [i]: 5: 4, grand);

OutTextXY (300+Round ((250/y1) *mass [i]), 400, grand);

Line (320+Round ((250/y1) *mass [i]), y0, 320+Round ((250/y1) *mass [i]), 390);

For l: =1 to i-1 do

begin

SetColor (2+l);

Line (320+Round ((250/y1) *mass [l]), y0+10, 320+Round ((250/y1) *mass [l]), y0-10);

end;

x: =m;

Repeat

y: =f (x);

PutPixel (320+Round (x*mx), y0-Round (y*my), 15);

x: =x+0.01;

Until (x >= n);

ReadLn;

pro;

end;

end;

{***************************************************************************}

{***************************************************************************}

procedure load_file_1;

var mistake: byte;

k: char;

st: string;

f: text;

begin

Repeat

If number = 1 then

WriteLn (' Введите промежутки [m, n] одного знака') else

WriteLn (' Введите промежутки [m, n] ');

WriteLn ('Нажмите "1" для ввода данных с клавиатуры');

WriteLn ('Нажмите "2" для ввода данных из файла');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Ввод: ');

{$I-}

ReadLn (m, n);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Ошибка ввода');

end;

'2': begin

WriteLn (' Нажмите "1" для указания расположения своего файла');

WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически');

k: =ReadKey;

If k = '1' then begin

WriteLn ('Введите путь к файлу с расширением. txt');

ReadLn (st);

Assign (f, st);

end else

If k = '2' then assign (f, 'c: \temp\my_stuff\m_n. txt');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then

WriteLn ('Файла не существует') else

begin

{$I-}

Read (f, m, n);

{$I+}

mistake: =IOResult; Close (f); If mistake <> 0 then

WriteLn ('Информация в файле не соответствует нужному типу') else

begin

WriteLn (m: 0: 2);

WriteLn (n: 0: 2);

end;

end; WriteLn ('Нажмите "Ввод для продолжения"'); ReadLn;

end;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure load_file_2;

var mistake: byte;

k: char;

st: string;

f: text;

begin

Repeat

WriteLn ('Нажмите "1" для ввода с клавиатуры');

WriteLn ('Нажмите "2" для ввода данных из файла');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Ввод: ');

If number = 1 then {$I-} ReadLn (a, b) {$I+} else

If number = 2 then {$I-} ReadLn (a, b, c) {$I-};

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Ошибка ввода');

end;

'2': begin

WriteLn (' Нажмите "1" для указания расположения своего файла');

WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически');

k: =ReadKey;

If k = '1' then begin

WriteLn ('Введите путь к файлу расширением. txt');

ReadLn (st);

assign (f, st);

end else

If k = '2' then assign (f, 'c: \temp\my_stuff\a_b_c. txt');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then

WriteLn ('Файла не существует') else

begin

If number = 1 then {$I-} Read (f, a, b) {$I+} else

{$I-} Read (f, a, b, c); {$I+}

mistake: =IOResult; Close (f); If mistake <> 0 then

WriteLn ('Информация в файле не соответствует нужному типу') else

begin

WriteLn (a: 0: 2);

WriteLn (b: 0: 2);

If number = 2 then WriteLn (c: 0: 2);

end;

end; WriteLn ('Нажмите "Ввод для продолжения"'); ReadLn;

end;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure load_file_3 (var E: real);

var mistake: byte;

k: char;

st: string;

f: text;

begin

Repeat

WriteLn ('Нажмите "1" для ввода данных с клавиатуры');

WriteLn ('Нажмите "2" для ввода данных из файла');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Ввод: ');

{$I-}

ReadLn (E);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Ошибка ввода');

end;

'2': begin

WriteLn (' Нажмите "1" для указания расположения своего файла');

WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически');

k: =ReadKey;

If k = '1' then begin

WriteLn ('Введите путь к файлу с расширением. txt');

ReadLn (st);

assign (f, st);

end else

If k = '2' then assign (f, 'c: \temp\my_stuff\E. txt');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then

WriteLn ('Файла не существует') else

begin

{$I-}

Read (f, E);

{$I+}

mistake: =IOResult; Close (f); If mistake <> 0 then

WriteLn ('Информация в файле не соответствует нужному типу') else

begin

WriteLn (E: 0: 3);

end;

end; WriteLn ('Нажмите "Ввод для продолжения"'); ReadLn;

end;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure save_file (E: real);

var k: char;

mistake: byte;

f: text;

st: string;

begin

Repeat

WriteLn (' Если хотите сохранить данные и результаты нажмите "1"');

WriteLn (' Если не хотите сохранять данные и результаты нажмите "2"');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Если хотите сохранить данные в указанные вами файлы нажмите "1"');

WriteLn (' Если хотите, чтобы сохранение произошло автоматически нажмите "2"');

k: =ReadKey;

If k = '1' then begin

Repeat

WriteLn ('Введите путь и имя файла c для сохранения промежутков [m, n] ');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

Write (f, m: 3, n: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

Repeat

If number = 1 then

WriteLn ('Введите путь и имя файла для сохранения коэффициентов "a", "b"')

else

If number = 2 then

WriteLn ('Введите путь и имя файла для сохранения коэффициентов "a", "b", "c"');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

If number = 1 then begin

Write (f, a: 3, b: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end else

If number = 2 then begin

Write (f, a: 3, b: 3, c: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

end;

Until mistake = 0;

Repeat

WriteLn ('Введите путь и имя файла для сохранения погрешности "Е"');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

Write (f, E: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

Repeat

WriteLn ('Введите путь и имя файла для сохранения корня');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

Write (f, mass [i]: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

end else

If k = '2' then begin

Assign (f, 'c: \temp\my_stuff\m_n. txt');

{$I-} ReWrite (f); {$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Каталога для сохранения не существует') else

begin

Write (f, m, n); Close (f);

Assign (f, 'c: \temp\my_stuff\a_b_c. txt');

ReWrite (f); If number = 1 then Write (f, a, b) else

Write (f, a, b, c); Close (f);

Assign (f, 'c: \temp\my_stuff\E. txt');

ReWrite (f); Write (f, E); Close (f);

Assign (f, 'c: \temp\my_stuff\x. txt');

ReWrite (f); Write (f, mass [i]); Close (f);

WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

end;

end;

'2': mistake: =0;

end;

Until mistake = 0;

end;

{***************************************************************************}

{***************************************************************************}

procedure equation_1;

var mistake, code_of: byte;

E, x1, root: real;

bool_of: boolean;

k: char;

{***************************************************************************}

begin

closegraph;

bool_of: =false;

Repeat

number: =1;

clrscr;

WriteLn (' Уравнение вида: y(x) =a*ln(b*x) ');

Repeat

load_file_1;

If m > n then begin

WriteLn ('Введите "m" < "n" ');

WriteLn ('Нажмите "Ввод" для подолжения'); ReadLn;

end else

If (m < 0) and (n >0) or (m = 0) or (n = 0) then

begin

WriteLn ('"m" и "n" должны быть одного знака и неравные 0');

WriteLn ('Нажмите "Ввод" для продолжения'); ReadLn;

end;

Until (((m < 0) and (n < 0)) or ((m > 0) and (n > 0))) and (m <= n);

Repeat

WriteLn ('Введите коэффициенты уравнения "a", "b"');

load_file_2;

If m*b <= 0 then begin

WriteLn ('попробуйте ввести "b" другого знака и неравное 0');

WriteLn ('Нажмите "Ввод" для продолжения'); ReadLn;

end;

Until m*b > 0;

If a = 0 then begin

WriteLn ('Все "x" на промежутке [',m: 0: 1,'; ',n: 0: 1,'] - решения уравнения');

number: =0; end else

begin

Repeat

WriteLn ('Введите погрешность "E"');

load_file_3 (E);

If E <= 0 then begin WriteLn ('Введите "Е" больше 0');

WriteLn ('Нажмите "Ввод" для продолжения"');

end;

Until E > 0;

i: =1;

If (a*ln(b*m) *(-a/sqr(m))) > 0 then begin mass [i]: =m; code_of: =1 end else

If (a*ln(b*n) *(-a/sqr(n))) > 0 then begin mass [i]: =n; code_of: =1 end else

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end;

If code_of = 1 then

begin

Repeat

x1: =mass [i] -a*ln(b*mass [i]) /(a/mass [i]);

root: =Abs (x1-mass [i]);

i: =i+1;

mass [i]: =x1;

Until root < E;

If (x1 < m) or (x1 > n) then

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end else

WriteLn ('Корнем уравнения y(x) =', a: 0: 1, '*ln(', b: 0: 1, '*x) является: ', x1: 5: 4);

end;

end;

WriteLn ('Нажмите "Ввод"'); ReadLn; If code_of = 1 then save_file (E) else

WriteLn ('Так как уравнение не имеет корней, то сохранение не выполняется');

WriteLn ('Если хотите выйти, то нажмите "ESC"');

WriteLn ('Если хотите ввести другие данные, то нажмите "Ввод"');

k: =ReadKey;

code_of: =ord (k);

case code_of of

27: begin

bool_of: =true; graphica;

end;

13: bool_of: =false;

end;

Until bool_of;

end;

{***************************************************************************}

{***************************************************************************}

procedure equation_2;

var mistake, code_of: byte;

E, x1, root: real;

bool_of: boolean;

k: char;

{***************************************************************************}

begin

closegraph;

bool_of: =false;

Repeat

number: =2;

clrscr;

WriteLn (' Уравнение вида: y(x) =a*x^2+b*x+c');

Repeat

load_file_1;

If m > n then WriteLn ('Введите "m" < "n" ');

Until (m <= n);

WriteLn ('Введите коэффициенты уравнения "a", "b", "c"');

load_file_2;

If (a = 0) and (b = 0) and (c = 0) then begin

WriteLn ('Все "х" на промежутке [',m: 0: 1,'; ',n: 0: 1,'] - решения уравнения');

number: =0; end else

begin

Repeat

WriteLn ('Введите погрешность "Е"');

load_file_3 (E);

If E <= 0 then begin WriteLn ('Введите E > 0');

WriteLn ('Нажмите "Ввод" для продолжения');

end;

Until E > 0;

i: =1;

If (a*sqr(n) +b*n+c) *(2*a) >= 0 then begin mass [i]: =n; code_of: =1 end else

If (a*sqr(m) +b*m+c) *(2*a) >= 0 then begin mass [i]: =m; code_of: =1 end else

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end;

If code_of = 1 then

begin

Repeat

x1: =mass [i] -((a*sqr(mass [i]) +b*mass [i] +c) /(2*a*mass [i] +b));

root: =Abs (x1-mass [i]);

i: =i+1;

mass [i]: =x1;

Until (root < E);

If (x1 < m) or (x1 > n) then

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end else

WriteLn ('Корнем уравнения y(x) =', a: 0: 1, '*x^2+', b: 0: 1, '*x+', c: 0: 1, ' является: ', x1: 0: 4);

end;

end;

WriteLn ('Нажмите "Ввод"'); ReadLn; If code_of = 1 then save_file (E) else

WriteLn ('Так как уравнение не имеет корней, то сохранение не выполняется');

WriteLn ('Если хотите выйти, то нажмите "ESC"');

WriteLn ('Если хотите ввести другие данные, то нажмите "Ввод"');

k: =ReadKey;

code_of: =ord (k);

case code_of of

27: begin

bool_of: =true; graphica;

end;

13: bool_of: =false;

end;

Until bool_of;

end;

{***************************************************************************}

procedure key (p1: byte);

Var y1, y2: integer;

name: string;

i: byte;

begin

ClearDevice;

SetColor (white);

OutTextXY (250, 435, '"Ввод" - вход "z", "x" - перемещение по меню');

y1: =15;

y2: =70;

for i: =1 to 5 do

begin

Setcolor (blue);

Rectangle (16, y1-1, 251, y2-1);

RecTangle (17, y1-2, 252, y2-2);

RecTangle (18, y1-3, 253, y2-3);

SetFillStyle (1,lightblue);

Bar (15, y1, 250, y2);

case i of

1: Name: ='Cправка';

2: Name: ='y=a*ln(b*x) ';

3: Name: ='y=a*x^2+b*x+c';

4: Name: ='Построение графика';

5: Name: ='Выход';

end;

SetColor (white);

OutTextXY (45, y1+25, Name);

y1: =20+y2;

y2: =75+y2;

end;

SetColor (white);

p1: =p1-1;

Rectangle (18, 19+75*p1, 246, 66+75*p1);

end;

{***************************************************************************}

procedure help;

var st: string;

f: text;

y: integer;

mistake: byte;

begin

ClearDevice;

Assign (f, 'c: \temp\My_stuff\help. asc');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult; SetTextStyle (0, 0, 0);

If mistake <> 0 then OutTextXY (250, 220, 'Файла не существует') else

begin

y: =0;

Repeat

y: =15+y;

ReadLn (f, st);

OutTextXY (45, y, st);

Until EOf (f);

Close (f);

end;

OutTextXY (400, 450, 'Нажмите "Ввод" для выхода');

ReadLn; pro;

end;

{***************************************************************************}

procedure eat (p2: byte; var bool: boolean);

begin

if p2=1 then help else

if p2=2 then equation_1 else

if p2=3 then equation_2 else

if p2=4 then groffunc else

if p2=5 then bool: =true;

end;

{***************************************************************************}

procedure pro;

var p, code: byte;

k: char;

bool: boolean;

begin

ClearDevice;

p: =1;

key (p);

bool: =false;

repeat

SetBKColor(lightgray);

SetTextStyle (1, 0, 4); SetColor (blue);

OutTextXY (390, 130, 'МЕНЮ');

SetTextStyle (0, 0, 0);

k: =ReadKey;

code: =ord (k);

Case code of

122: begin

p: =p-1; if p=0 then p: =5;

key (p);

end;

120: begin

p: =p+1; if p=6 then p: =1;

key (p);

end;

13: eat (p, bool);

end;

until bool;

CloseGraph;

end;

{***************************************************************************}

begin

title;

number: =0;

graphica;

end.