Программирование на языке Паскаль в среде Турбо Паскаль

Частное учреждение образования Колледж бизнеса и права ОТЧЕТ по учебной практике по программированию ОП Т.117 013.

Проверил (Н.И. Савченкова) Выполнил (В.А. Макрак).

• 1. Программирование на языке Паскаль в среде Турбо Паскаль
• 1.1 Линейные алгоритмы
• 1.2 Процедуры и функции
• 1.3 Структура данных: массивы
• 1.4 Структура данных: строки.
• 1.4 Структура данных: записи
• 1.5 Модульное программирование
• 1.6 Прямая и косвенная рекурсия
• 1.7 Рекурсивные алгоритмы
• 1.8 Бинарный поиск
• 1.9 Сортировка влючением
• 1.10 Обменная сортировка
• 1.11 Сортировка разделением
• 1.12 Статическое и динамическая распределение памяти
• 1.13 Организация списков
• 1.14 Модуль Graph

1. Программирование на языке Паскаль в среде Турбо Паскаль

1.1 Линейные алгоритмы

Условие задачи

Составить словесное (математическое) описание и блок-схему следующей задаче: найти периметр треугольника АВС, если его координаты A (x₁,y₁), B (x₂,y₂), C (x₃,y₃,) вводятся с клавиатуры. При неправильном вводе значений, вывести на экран сообщение об ошибке и предложением повторно ввести правильные данные. Результат отобразить на экране.

P=AB+BC+AC

Для тестирования программы использовались данные, приведённые в таблице 1. Полученные результаты приведены там же.

Таблица 1 — Результаты выполнения линейного алгоритма

Листинг программы — Линейный алгоритм

program perimetr;

uses crt;

var ab, bc, ac, x1, x2,x3,y1,y2,y3: real;

p: real;

begin

clrscr;

repeat

writeln ('vvesti koordinati verhin A');

readln (x1,y1);

writeln ('vvedite koordinati verhin B');

readln (x2,y2);

writeln ('vvedite koordinati verhin C');

readln (x3,y3);

AB: =sqrt ((sqr (x1-x2)) + (sqr (y1-y2)));

BC: =sqrt ((sqr (x2-x3)) + (sqr (y2-y3)));

AC: =sqrt ((sqr (x1-x3)) + (sqr (y1-y3)));

if (AB>=BC+AC) or (AC>=AB+BC) or (BC>=AB+AC) then writeln ('eto ne treygolnik, povtorite vvod');

until (AB<BC+AC) and (AC<AB+BC) and (BC<AB+AC);

P: =AB+BC+AC;

writeln ('perimetr treygolnika raven=', p: 0: 2);

readln;

end.

программирование алгоритм турбо паскаль Рисунок 1 — Блок-схема линейного алгоритма Результат решения задачи представлен на рисунке 1.

Рисунок 1 — Результат работы программы в TurboPascal.

1.2 Процедуры и функции

Составить словесное (математическое) описание и блок-схему следующей задаче: найти периметр треугольника АВС, если его координаты A (x₁,y₁), B (x₂,y₂), C (x₃,y₃,) вводятся с клавиатуры. При неправильном вводе значений, вывести на экран сообщение об ошибке и предложением повторно ввести правильные данные. Результат отобразить на экране.

P=AB+BC+AC

Для тестирования программы использовались данные, приведённые в таблице 2. Полученные результаты приведены там же.

Таблица 2 — Результаты выполнения процедуры и функции

Результат решения задачи представлен на рисунке 2.

Рисунок 2 — Результат работы программы в TurboPascal.

Листинг — Процедуры.

program perimet_procedure;

uses crt;

var ab, bc, ac, x1, x2,x3,y1,y2,y3: real;

p: real;

procedure perimetr (x1,y1,x2,y2: real);

begin.

clrscr;

repeat.

writeln ('vvesti koordinati verhin A');

readln (x1,y1);

writeln ('vvedite koordinati verhin B');

readln (x2,y2);

writeln ('vvedite koordinati verhin C');

readln (x3,y3);

AB: =sqrt ((sqr (x1-x2)) + (sqr (y1-y2)));

BC: =sqrt ((sqr (x2-x3)) + (sqr (y2-y3)));

AC: =sqrt ((sqr (x1-x3)) + (sqr (y1-y3)));

if (AB>=BC+AC) or (AC>=AB+BC) or (BC>=AB+AC) then writeln ('eto ne treygolnik, povtorite vvod');

until (AB<BC+AC) and (AC<AB+BC) and (BC<AB+AC);

P: =AB+BC+AC;

end;

begin.

clrscr;

perimetr (x1,y1,x2,y2);

writeln ('perimetr treygolnika raven=', p: 0: 2);

readln;

end.

Рисунок 2 — Блок-схема процедуры Листинг — функции.

Program perimetr_function;

Uses crt;

Var x1, x2,x3,y1,y2,y3: real; {объявление переменных }.

p: real;

Function stor (ab, bc, ac: real): real; {функция }.

Begin.

Repeat.

writeln ('Vvesti Koordinati Verhin |A|'); {ввод координат точки А}.

readln (x1,y1);

writeln ('Vvedite Koordinati Verhin |B|'); {ввод координат точки B}.

readln (x2,y2);

writeln ('Vvedite Koordinati Verhin |C|'); {ввод координат точки C}.

readln (x3,y3);

AB: =sqrt ((sqr (x1-x2)) + (sqr (y1-y2)));

BC: =sqrt ((sqr (x2-x3)) + (sqr (y2-y3)));

AC: =sqrt ((sqr (x1-x3)) + (sqr (y1-y3)));

if (AB>=BC+AC) or (AC>=AB+BC) or (BC>=AB+AC) then writeln ('Eto ne treygolnik, Povtorite Vvod');

until (AB<BC+AC) and (AC<AB+BC) and (BC<AB+AC);

P: =AB+BC+AC; {вычисление периметра }.

End;

{основная программа}.

Var ab, bc, ac: real; {объявление переменных}.

Begin.

clrscr; stor (ab, bc, ac.

);

writeln ('|Perimetr Treygolnika Raven|=', p: 0: 0,' (cm) '); {вывод результата}.

readln;

End. {конец }.

Результат решения задачи представлен на рисунке 3.

Рисунок 3 — Результат работы программы в TurboPascal.

Рисунок 3 — Блок-схема функции.

1.3 Структура данных: массивы

Дан двумерный массив 5×5. Заменить нулем элементы, расположенные над побочной диагональю.

Листинг — Структуры данных: массивы

program massiv;

Uses CRT;

Const n=5;

var a: array [1. n, 1. n] of integer;

i, j: integer;

Begin

randomize;

FOR i: = 1 to n DO

begin

FOR j: = 1 to n DO

begin

A [i, j]: =random (10) — 3;

write (a [i, j]: 3);

end;

writeln;

end;

writeln;

FOR i: = 1 to n DO

begin

FOR j: = 1 to n DO

begin

if j<=n-i+1 then

a [i, j]: =0;

write (a [i, j]: 3);

end;

writeln;

end;

Readln

End.

Результат решения задачи представлен на рисунке 3.

Рисунок 4 — Результат работы программы в TurboPascal

1.4 Структура данных: строки.

Даны строки S1, S2 и символ C. Перед (после) каждого вхождения символа C в строку S1 вставить строку S2.

Листинг — Структуры данных: строки

uses crt;

var s1, s2,s: string;

c, w: char;

i: byte;

begin

clrscr;

writeln (`Ввести строку в которую будем вставлять: ');

readln (s1);

writeln ('Ввести строку которую будем вставлять: ');

readln (s2);

repeat

write (');

readln (c);

if pos (c, s1) =0 then writeln ();

until pos (c, s1) >0;

repeat

clrscr;

writeln (? ');

writeln ();

writeln ();

writeln ();

readln (w);

case w of

'1': begin

s: =s1;

for i: =length (s) downto 1 do

if s1 [i] =c then insert (s2,s, i);

write (s);

readln;

end;

'2': begin

s: =s1;

for i: =length (s) downto 1 do

if s1 [i] =c then insert (s2,s, i+1);

write (s);

readln;

end;

else exit;

end;

until not (w in ['1'. '2']);

end.

Результат решения задачи представлен на рисунке 4.

Рисунок 4 — Результат работы программы в TurboPascal

1.4 Структура данных: записи

Запись содержит данные о продовольственных и промышленных товарах со следующими реквизитами: наименование товара (тип string), тип товара (тип string), количество (тип integer), цена за единицу (тип integer). Составить программу, выполняющую поиск по типу товара и количеству товара.

Листинг — Структуры данных: записи

uses crt;

type tov=record

t: string;

k: integer;

n: string;

c: char;

end;

const

Nmax=10;

var

i: integer;

c: char;

m: array [1. Nmax] of tov;

k: integer;

o: boolean;

procedure enter;

var

c: string;

begin

clrscr;

i: =1;

while c<>'н' do begin

clrscr;

i: =i+1;

writeln ();

readln (m [i]. n);

writeln () ');

readln (m [i]. t);

writeln ();

readln (m [i]. k);

writeln ();

readln (m [i]. c);

writeln (');

readln (c);

end;

end;

procedure find;

var

tip: string;

kol, k: integer;

begin

i: =2;

while c<>'н' do begin

i: =i+1;

write (? ');

readln (tip);

write (: ');

readln (kol);

for i: =2 to Nmax do begin

if (m [i]. t=tip) and (m [i]. k=kol) then begin

writeln (c);

o: =true;

end;

end;

if o=false then writeln ();

writeln (? ');

readln (c);

end;

end;

begin

while c<>'3' do begin

writeln (: ');

writeln ('1.);

writeln ('2.);

writeln ('3. ');

readln (c);

case c of

'1': enter;

'2': find;

end;

end;

end.

Результат решения задачи представлен на рисунке 5.

Рисунок 5 — Результат работы программы в TurboPascal

1.5 Модульное программирование

В заданном массиве К (N) найти индексы элементов, которые кратны минимальному значению элемента массива.

Листинг — Модульное программирование

programpract6;

usescrt; {подключениебиблиотеки}

functionRec (k: integer): longint; {описаниефункции}

begin

ifk<4 then Rec: =1{началоцикла}

else Rec: =Rec (k-3) +Rec (k-2) +Rec (k-1);

end; {конеццикла}

varn: integer; {описаниепеременных}

beginclrscr; {очисткаэкрана}

repeat{цикл}

write ('vvedite nomer chlena posledovatelnosti, nat chislo n=');

readln (n);

until n>0;

write ('znachenie=', Rec (n));

readln;

readkey; {задержка экрана}

end.

Результат решения задачи представлен на рисунке 6.

Рисунок 6 — Результат работы модульное программирование

1.6 Прямая и косвенная рекурсия

Написать программу с рекурсивной функцией, вычисляющей:

.

Листинг — Прямая и косвенная рекурсия

Programpr7;

uses crt;

var n: integer;

function Koren (n: integer): real;

begin

if n=1 then Koren: =sqrt (3)

else Koren: =sqrt (3+Koren (n-1));

end;

begin

clrscr;

write ('n=');

readln (n);

write (Koren (n): 0: 5);

readln

end.

Таблица 6 — Результаты выполнения прямой и косвенной рекурсии

Результат решения задачи представлен на рисунке 7.

Рисунок 7 — Результат работы программы в TurboPascal.

1.7 Рекурсивные алгоритмы

Написать рекурсивную процедуру, переводящую целое число из восьмеричной системы счисления в десятичную.

Для тестирования программы использовались данные, приведённые в таблице 7. Полученные результаты приведены там же.

Таблица 7 — Результаты выполнения линейного алгоритма

Листинг — Рекурсивные алгоритмы.

programProject1;

function Oct2Num (const aSOct: String; const aWeight, aI: Integer): Integer;

var.

Num: Integer;

begin.

Num: = 0;

case aSOct [aI] of.

'0': Num: = 0 * aWeight;

'1': Num: = 1 * aWeight;

'2': Num: = 2 * aWeight;

'3': Num: = 3 * aWeight;

'4': Num: = 4 * aWeight;

'5': Num: = 5 * aWeight;

'6': Num: = 6 * aWeight;

'7': Num: = 7 * aWeight;

end;

if aI > 1 then begin.

Num: = Num + Oct2Num (aSOct, aWeight * 8, aI — 1);

end;

Oct2Num: = Num;

end;

var.

SOct, S: String;

Num: Integer;

Begin.

repeat.

Writeln ('zadaite celoe neotricatelnoe chislo: ');

Readln (SOct);

Num: = Oct2Num (SOct, 1, Length (SOct));

Writeln ('Chislo v 10oi sisteme: ');

Writeln (Num);

Readln (S);

until S <> '';

End.

Результат решения задачи представлен на рисунке 8.

Рисунок 8 — Результат работы программы в TurboPascal.

1.8 Бинарный поиск

Задан массив AX (N). Добавить массив С (К). Выполнить сортировку включением. В полученном массиве положительные элементы уменьшите вдвое, а отрицательные замените на значения их индексов.

Для тестирования программы использовались данные, приведённые в таблице 8. Полученные результаты приведены там же.

Таблица 8 — Результаты выполнения линейного алгоритма

Листинг — Бинарный поиск.

Programpr7;

usescrt; {подключениебиблиотеки}.

Constn = 5; {постоянная}.

Var{описание переменных}.

i, min: integer;

k: array [1. n] of integer; {описаниемассива}.

Begin clrscr; {очисткаэкрана}.

For i: = 1 To n Do {заполнениемассива}.

Begin.

Writeln ('Vvedite ', i,' element: ');

Readln (K [i]).

End;

min: = k [1];

For i: = 2 To n Do {поискминимального}.

if k [i] < min Then min: = k [i];

For i: = 1 To n Do {кратностьэлементов}.

If (k [i] mod min) = 0 Then Writeln (i);

readkey;

End.

Результат решения задачи представлен на рисунке 9.

Рисунок 9 — Результат работы программы в TurboPascal.

1.9 Сортировка влючением

Задан массив AX (N). Добавить массив С (К). Выполнить сортировку включением. В полученном массиве положительные элементы уменьшите вдвое, а отрицательные замените на значения их индексов.

Листинг — Сортировка включением

programl;

type mas=array [0.100] of integer;

var i, min, n, m, imn: integer; a, c: mas;

Procedure Straight_Insertion (n: integer; Var a: mas);

Var

i, j: integer;

x: integer;

Begin

For i: =2 To n Do

begin

x: =a [i]; a [0]: =x; j: =i-1;

While x<a [j] Do

begin

a [j+1]: =a [j]; j: =j-1;

end;

a [j+1]: =x

end;

End; {Straight_Insertion}

begin

randomize;

writeln (');

readln (n);

for i: =1 to n do begin

a [i]: =random (10) +random (5);

end;

writeln (');

for i: =1 to n do begin

write (a [i],' ');

end;

writeln;

writeln (');

readln (m);

for i: =1 to m do begin

c [i]: =random (15) +random (5);

end;

writeln;

writeln ();

for i: =1 to n do begin

write (c [i],' ')

end;

writeln;

writeln;

for i: =1 to m do begin

n: =n+1;

a [n]: =c [i];

end;

writeln (');

for i: =1 to n do

write (a [i],' ');

writeln;

writeln;

Straight_Insertion (n, a);

writeln (');

for i: =1 to n do

write (a [i],' ');

writeln;

writeln;

min: =a [1];

for i: =1 to n do begin

if a [i] <min then min: =a [i];

end;

write (=', min);

writeln;

imn: =0;

for i: =1 to n do begin

if a [i] mod a [min] =0 then

imn: =i;

end;

begin

min: =a [1];

writeln (');

for i: =1 to n do

if (a [i] mod min = 0) then

write (i: 3);

writeln;

end;

end.

Результат решения задачи представлен на рисунке 10.

Рисунок 10 — Результат работы программы в TurboPascal

1.10 Обменная сортировка

Задан массив AX (N). Добавить массив С (К). Выполнить сортировку включением. В полученном массиве положительные элементы уменьшите вдвое, а отрицательные замените на значения их индексов.

Листинг — Сортировка обменная

type mas=array [0.100] of integer;

var i, min, n, m, imn: integer; a, c: mas;

Procedure Shaker_Sort (n: word; Var a: mas);

Var j, k, l, r: integer;

x: integer;

Begin

l: =2; r: =n; k: =n;

Repeat

For j: =r DownTo l Do

If a [j-1] >a [j] Then

begin

x: =a [j-1];

a [j-1]: =a [j];

a [j]: =x;

k: =j;

end;

l: =k+1;

For j: =l To r Do

If a [j-1] >a [j] Then

begin

x: =a [j-1];

a [j-1]: =a [j];

a [j]: =x;

k: =j;

end;

r: =k-1;

Until l>r

End; {Shaker_Sort}

begin

randomize;

writeln (');

readln (n);

for i: =1 to n do begin

a [i]: =random (10) +random (5);

end;

writeln (');

for i: =1 to n do begin

write (a [i],' ');

end;

writeln;

writeln (');

readln (m);

for i: =1 to m do begin

c [i]: =random (15) +random (5);

end;

writeln;

writeln (');

for i: =1 to n do begin

write (c [i],' ')

end;

writeln;

writeln;

for i: =1 to m do begin

n: =n+1;

a [n]: =c [i];

end;

writeln (');

for i: =1 to n do

write (a [i],' ');

writeln;

writeln;

Shaker_Sort (n, a);

writeln (');

for i: =1 to n do

write (a [i],' ');

writeln;

writeln;

min: =a [1];

for i: =1 to n do begin

if a [i] <min then min: =a [i];

end;

write (= ', min);

writeln;

imn: =0;

for i: =1 to n do begin

if a [i] mod a [min] =0 then

imn: =i;

end;

begin

min: =a [1];

writeln (');

for i: =1 to n do

if (a [i] mod min = 0) then

write (i: 3);

writeln;

end;

end.

Результат решения задачи представлен на рисунке 11.

Рисунок 11 — Результат работы программы в TurboPascal

1.11 Сортировка разделением

Задан массив К (N). Добавить массив С (В). Выполнить сортировку разделением. В полученном массиве найти индексы элементов, которые кратны минимальному значению элемента массива.

Листинг — Сортировка разделением

type mas=array [1.20] of integer;

var i, min, n, m, imn: integer; a, c: mas;

procedure sort (l, r: integer);

var

i, j, x1,y1,m: integer;

begin

i: =l;

j: =r;

m: =round ((l+r) /2);

x1: =a [m];

repeat

while a [i] <x1 do inc (i);

while a [j] >x1 do dec (j);

if i<=j then

begin

y1: =a [i];

a [i]: =a [j];

a [j]: =y1;

inc (i);

dec (j);

end;

until i>j;

if l<j then sort (l, j);

if i<r then sort (i, r);

end;

begin

randomize;

writeln (');

readln (n);

for i: =1 to n do begin

a [i]: =random (10) +random (5);

end;

writeln (');

for i: =1 to n do begin

write (a [i],' ');

end;

writeln;

writeln ('');

readln (m);

for i: =1 to m do begin

c [i]: =random (15) +random (5);

end;

writeln;

writeln (');

for i: =1 to n do begin

write (c [i],' ')

end;

writeln;

writeln;

for i: =1 to m do begin

n: =n+1;

a [n]: =c [i];

end;

writeln (');

for i: =1 to n do

write (a [i],' ');

writeln;

writeln;

sort (1,n);

writeln (');

for i: =1 to n do

write (a [i],' ');

writeln;

writeln;

min: =a [1];

for i: =1 to n do begin

if a [i] <min then min: =a [i];

end;

write (= ', min);

writeln;

imn: =0;

for i: =1 to n do begin

if a [i] mod a [min] =0 then

imn: =i;

end;

begin

min: =a [1];

writeln (');

for i: =1 to n do

if (a [i] mod min = 0) then

write (i: 3);

writeln;

end;

end.

Результат решения задачи представлен на рисунке 12.

Рисунок 12 — Результат работы программы в TurboPascal

1.12 Статическое и динамическая распределение памяти

1. Заполнить массив В (10) случайными значениями. Организовать вывод на экран. Присвоить указателю адрес начала размещения массива в памяти. Напечатать значения четных значений элементов массива. Присвоить указателю адрес 10-го элемента, напечатать его значение, используя текущий базовый адрес сегмента и смещение с преобразованием в значение типа указатель. Заменить его содержимое на значение третьего элемента. Напечатать его новое значение.

Для тестирования программы использовались данные, приведённые в таблице 12. Полученные результаты приведены там же.

Листинг — Статическое и динамическое разделение памяти.

program yp14; {название программы}.

uses crt; {подключение библиотеки}.

type {описание типов}.

massiv=array [1.10] of integer; {описание массива}.

var {раздел описания переменных}.

i, z: integer;

a: massiv;

PtrMas: ^massiv; {указатель на массив}.

begin clrscr; {очистка экрана}.

writeln ('Vvedite elementy massiva: '); {выводнаэкран}.

for i: =1 to 10 do {выводэлементовмассива}.

begin.

read (a [i]);

end;

writeln ('Vveden massiv: ');

for i: =1 to 10 do {выводэлементамассива}.

begin.

write (a [i]: 3);

end;

writeln;

PtrMas: =@a; {присвоение указателю адрес начала массива в памяти}.

writeln ('—————————————————————-');

writeln ('Polozitelnie 4isla: ');

for i: =1 to 10 do.

begin.

if PtrMas^ [i] mod 2 =0 then.

writeln (PtrMas^ [i]);

end;

PtrMas: =Ptr (Seg (a [9]), Ofs (a [9]) +SizeOf (integer)); {присвоениеадреса 4 элемента}.

writeln ('—————————————————————-');

write ('10 element: ');

writeln (PtrMas^ [1]); {вывод значения 4 лемента}.

write ('novoe zna4enie 10: ');

writeln (ptrmas^ [1]); {вывод умноженного массива}.

ptrMas^ [1]: =a [3];

write ('novoe zna4enie 10: ');

writeln (ptrmas^ [1]);

readkey; {задержкаэкрана}.

end. {конец программы}.

Результат решения задачи представлен на рисунке 13.

Рисунок 13 — Результат работы программы в TurboPascal.

1.13 Организация списков

Создать связанный список из записей, содержащих сведения о товаре (код товара, наименование товара, цена), реализовать операции со связанным списком: запись первым в список, удаление первого объекта из списка, просмотр всего списка, удаление объекта, следующего за указанным.

Листинг — Организациясписков

Programyp15;

UsesCrt;

Type

NameStr = String [20];

SNameStr = string [20];

Link = ^Auto;

Auto = record

Name: NameStr; {названиетовара}

Kod: integer; {кодтовара}

cena: integer; {ценатовара}

Next: Link; {связьсоследующимобъектом}

end;

VarP, First: Link; {указательнатекущуюзапись}

NamFind: NameStr; {поискпоназванию}

V: 0.4; {меню}

EndMenu: boolean; {завершениеменю}

FunctionFindName (FN: NameStr): Link; {поискпофамилии}

VarCurr: Link;

begin

Curr: =First; {установканапервый}

whileCurr<>Nildo{доконцасписка}

if Curr^. Name=FN then {нашли}

begin

FindName: =Curr; {возвращаемуказатель}

Exit; {завершениефункции}

end

elseCurr: =Curr^. Next; {следующий}

FindName: =Nil; {еслиненашло}

end; {end FindName}

procedure AddFirst (A: Link); {добавление 1 записи}

begin

A^. Next: =First; {новыйобъект 1}

First: =A; {ссылканановыйобъект}

end; {конецпроцедуры}

procedure DelFirst (var A: Link); {удаление 1 }

begin

A: =First;

First: =First^. Next;

end; {end DelFirst}

procedure DelAfter (Old: Link; var A: Link); {удаленияобъектазастарый}

begin

A: =Old^. Next; {присвоенияуказателя}

Old^. Next: =Old^. Next^. Next;

end; {конецпроцедуры}

procedure InpAvto; {ввод}

begin

P: =New (Link); {новыйобъект}

Write ('Ha3BaHuE: ');

Readln (P^. Name);

Write ('Kog: ');

Readln (P^. kod);

write ('Cena: ');

readln (P^. cena);

AddFirst (P); {вызов процедуры добавления }

end; {конец процедуры}

procedureMyList; {вывод записей}

varCurr: Link; {указатель на след. запись}

begin

Curr: =First; {установка на 1ую запись}

whileCurr<>Nildo

begin

Writeln ('Na3BaToBapa: ', Curr^. Name,' Kod ToBaPa: ', Curr^. kod,' Kol-vo: ', Curr^. cena: 3);

Curr: =Curr^. Next; {переход к следующей}

end;

readkey;

Readln;

end; {end MyList}

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

Begin {Osnova}

New (P); {новаядинамическаяпеременная}

EndMenu: =False;

repeat

clrscr;

Writeln ('Vi6irite punktick: ');

Writeln ('1. Zapisat pervblm');

Writeln ('2. Ydalit pervyl0 zapis');

WriteLn ('3. Prosmotr vsego spiska');

Writeln ('4. ydalenie ');

WriteLn ('0. EXIT');

Readln (V);

Case V of {вызовнужнего}

1: InpAvto; {выводданных}

2: DelFirst (P); {удаление 1}

3: MyList; {вывод}

4: begin{удалениеследующего}

Write ('VvodHa3BaHu9 poslekotorogodelete: ');

Readln (NamFind);

DelAfter (Findname (NamFind), P); {вызовудаления}

end

elseEndMenu: =True; {конецменю}

end;

until EndMenu;

Dispose (P); {освобождениекучи}

end.

Результат решения задачи представлен на рисунке 14.

Рисунок 14 — Результат работы программы в TurboPascal

Рисунок 15 — Результат работы программы в TurboPascal

Рисунок 16 — Результат работы программы в TurboPascal

1.14 Модуль Graph

Написать программу, которая выводит на экран изображение шахматной доски. Используйте желтый и коричневый цвета для закрашивания квадратов. Прорисовка каждой детали выполняется с задержкой 1000 мс. После полной прорисовки стирать изображение и повторно выводить узор до нажатия Esc.

Листинг — МодульGraph

uses crt, graph;

procedure Kletka (x1,y1,c: integer; d: integer);

begin

Setcolor (c);

rectangle (x1,y1,x1+d, y1+d);

Setfillstyle (1,c);

Bar (x1,y1,x1+d, y1+d);

end;

var gd, gm, x1, y1,x2,y2,d1, i, j: integer;

c: char;

begin

initgraph (gd, gm,'');

d1: =round ((getmaxY-60) /8);

x1: =100; y1: =50;

outtextXY (getmaxX div 2−40, 20,'Vyhod-Esc');

repeat

for i: =0 to 7 do

begin

for j: =0 to 7 do

begin

if odd (i+j) then Kletka (x1+d1*i, y1+d1*j, 14, d1)

else Kletka (x1+d1*i, y1+d1*j, 6, d1);

delay (1000);

end;

end;

delay (1000);

setfillstyle (1,0);

bar (x1,y1,x1+d1*8,y1+d1*8);

if keypressed then c: =readkey;

if c=#27 then exit;

until c=#27;

end.

Результат решения задачи представлен на рисунке 17.

Рисунок 17 — Результат работы программы в TurboPascal