Размещено на http://www.allbest.ru/

Содержание

1. Реализация алгоритмов в системе программирования Turbo Pascal

1.1 Линейная программа

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

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

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

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

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

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

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

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

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

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

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

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

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

1.15 Модуль Graph

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

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

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

Составить словесное (математическое) описание и блок-схему следующей задаче: найти периметр треугольника АВС, если его координаты A(x1,y1), B(x2,y2), C(x3,y3,)вводятся с клавиатуры. При неправильном вводе значений, вывести на экран сообщение об ошибке и предложением повторно ввести правильные данные. Результат отобразить на экране.

P=AB+BC+AC

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

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

Входные данные	Выходные данные
A	B	C		S
3,5	-4,7	-5,-1		25.34

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

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.

алгоритм программирование turbo pascal

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

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

Составить словесное (математическое) описание и блок-схему следующей задаче: найти периметр треугольника АВС, если его координаты A(x1,y1), B(x2,y2), C(x3,y3,)вводятся с клавиатуры. При неправильном вводе значений, вывести на экран сообщение об ошибке и предложением повторно ввести правильные данные. Результат отобразить на экране.

P=AB+BC+AC

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

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

Входные данные	Выходные данные
A	B	C		P
3,5	-4,7	-5,-1		25.34

Результат решения задачи представлен на рисунке 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('Ввести символ строки перед(после)которого вставлять c=');

readln(c);

if pos(c,s1)=0 then writeln('Такого символа нет, повторите ввод');

until pos(c,s1)>0;

repeat

clrscr;

writeln('Куда вставлять?');

writeln('1-перед');

writeln('2-после');

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.5 Структура данных: записи

Запись содержит данные о продовольственных и промышленных товарах со следующими реквизитами: наименование товара (тип 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('Название: ',m[i].n,' Тип: ',m[i].t,' Кол-во ',m[i].k,' Цена: ',m[i].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.6 Модульное программирование

В заданном массиве К(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.7 Прямая и косвенная рекурсия

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

.

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

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 - Результаты выполнения прямой и косвенной рекурсии

Входные данные	Выходные данные
3	2.27493

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

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

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

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

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

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

Входные данные	Выходные данные
24	20

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

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.9 Бинарный поиск

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

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

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

Входные данные	Выходные данные
1element	2element	3element	4element	5element	1	2	5
3	3	4	5	6

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

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.10 Сортировка влючением

Задан массив 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('Ввести размер массива С C: ');

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('Объединённые масивы А и C: ');

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.11 Обменная сортировка

Задан массив 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('Ввести размер массива С C: ');

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('Объединённые масивы А и C: ');

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.12 Сортировка разделением

Задан массив К(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('Ввести размер массива С C: ');

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('Объединённые масивы А и C: ');

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.13 Статическое и динамическая распределение памяти

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

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

Входные данные	Выходные данные
5	-5	4	-6	8	-9	5	-4	-8	-6	Положительные числа	4 элемент умноженный на 2
										5	4	8	5	16

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

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.14 Организация списков

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

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

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.15 Модуль 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

Размещено на Allbest.ru