Загрузка...
Учебная работа. Курсовая работа: Работа с текстовыми строками, двумерными массивами, файловыми структурами данных
Оглавление
1 Задание №1.
1.1 Блок-схема программки.
1.2 Работа программки
2 Задание №2.
2.1 Блок-схема программки
2.2 Работа программки.
3 Задание №3.
3.1 Блок-схема программки
3.2 Работа программки
4 Задание №4.
4.1 Работа программки
5 Задание №5.
5.1 Блок-схема программки
5.2 Работа программки
6 Заключение.
7 Перечень применяемой литературы.
8 Приложения А
9 приложение Б
10 Приложение В
11 Приложение Г
12 Приложение Д
1 Задание №1
Подсчитать количество слов последовательности, начинающихся с большенный буковкы и оканчивающихся цифрой. Напечатать слова, содержащие задаваемую цепочку знаков и хотя бы один символ.
1.1 
Блок-схема программки
Работа программки
Основное тело программки.
Begin
Задаем переменные, которая будет обозначать о наличии введенного текста и признака продолжения работы программки.
Vvod:=False;
Cont:=True;
while Cont do
Begin
Очмщаем экран для удобства ввода и вывода инфы.
clrscr;
Выводим меню с номерами установок, которое можно узреть на рисунке 1.
Набросок 1 – основное меню первой программки.
menu;
write(‘Vvedite komandu: ‘);
Считываем команду в переменную Rem.
readln(Rem);
Распознаем команду и выберем нужные функции для выполнения в согласовании с введенном знаком.
case Rem of
‘0’: Cont:=False;
‘1’: begin
Считываем введенную строчку в переменную Txt и присваиваем Vvod
writeln(‘Text:’);
readln(Txt);
Vvod:=True;
end;
‘2’: begin
Если текст не введен то выводится соответственное сообщение, в неприятном случае запускается функция вывода слова с наибольшим количеством букв, расположенных в алфавитном порядке.
if Not Vvod then
writeln(‘Ne vveden text’)
else
alfslovo(Txt);
end;
‘3’: begin
Аналогично предшествующему, лишь запускается функция подсчета количества симметричных слов больше чем два знака.
if Not Vvod then
writeln(‘Ne vveden text’)
else
colsimmslovo(Txt);
end;
‘4’: begin
Вывод на экран введенной строчки, если же она не введены, выводится соответственное сообщение.
if Not Vvod then
writeln(‘Ne vveden text’)
else
writeln(Txt);
end
else
Если переменная Rem не удовлетворяет предшествующим условиям, то выводится сообщение о том что введена неведомая команда.
writeln(‘Neizvestnaya komanda’);
end;
Если программка все еще работает, то выводится предупреждающее сообщение о том что опосля нажатия клавиши ENTER нужно будет ввести последующую команду.
if Cont then
begin
write(‘Nagmite ENTER dlya vvoda sleduyuschei komandy… ‘);
readln;
end
else
clrscr;
end;
end.
Процедура для нахождения слова с наибольшим количеством букв, находящихся в алфавитном порядке.
Она получает в качестве параметра строчку S и считает в ней слова, в каких латинские буковкы размещены по алфавиту и печатает такое слово, в каком очень количество букв.
procedure alfslovo(S: Stroka250);
var
Если переменная F становится True, то это указывает что найдено новое слово.
F: boolean;
Len: Byte;
I: Byte;
Counter: Byte;
FSlovo, Buf: Slovo;
Index, L: Byte;
MaxCol: Byte;
begin
Len:=Length(S);
Вставляем в конец строчки пробел, если его там нет.
if S[Len]<>’ ‘ then
begin
S:=S+’ ‘;
Inc(Len);
end;
F:=False;
MaxCol:=0;
for I:=1 to Len do
if S[I]<>’ ‘ then
begin
Если находим начало новейшего слова, тогда устанавливаем признак новейшего слова, запоминаем номер знака начала слова в строке в переменную Index и вводим исходную длину слова в L.
if F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Увеличиваем длину до того времени, пока не находим пробел.
Inc(L);
end
else
Если i-й знак пробел, то сбрасываем признак слова, копируем слово в переменную Buf и длину строчки в нулевую ячейку.
if F=True then
begin
F:=False;
Buf:=Copy1(S, Index, L);
Buf[0]:=char(L);
Последующая процедура инспектирует слово. Если буковкы размещены в алфавитном порядке, то возвращает True по другому False.
if alforder(Buf, Counter) then
begin
Если в слове больше знаков, чем в наивысшем, то заносим слово в Fslovo и колличество букв в MaxCol.
if Counter>MaxCol then
begin
FSlovo:=Copy1(S, Index, L);
FSlovo[0]:=char(L);
MaxCol:=Counter;
end;
end;
end;
Если таковых слов нет то выводим сообщение о этом, по другому выводим слово.
if MaxCol=0 then
writeln(‘Net podhodyaschi slov v texte’)
else
writeln(FSlovo, ‘ kol-vo bukv: ‘, MaxCol);
end;
Функция alforder получает в качестве характеристик строчку S1, если в строке латинские буковкы размещены по алфавиту, то функция возвратит True по другому False. Count – количество латинских букв в строке.
function alforder(Sl: Slovo; var Count: Byte): Boolean;
var
I, L: Byte;
F: Boolean;
Buf: Char;
begin
L:=Length(Sl);
Сбрасываем изначальное количество букв в строке.
Count:=0;
Находим в цикле количество латинских букв в строке и приводим все большие буковкы к строчному виду.
for I:=1 to L do
begin
if (isletter(Sl[I])) then
Inc(Count);
if (Sl[I]>=’A’) and (Sl[I]<=’Z’) then
Sl[I]:=char(byte(Sl[I])+32);
end;
if Count=0 then
alforder:=False
else
if Count=1 then
alforder:=True
else
begin
F:=True;
Перемещаем все буковкы строчки в начало строчки.
While F do
begin
F:=False;
for I:=1 to L-1 do
Если i-й знак не буковка, а его сосед справа – буковка, то меняем эти знаки местами.
if (Not isletter(Sl[I])) And (isletter(Sl[I+1])) then
begin
F:=True;
Buf:=Sl[I];
Sl[I]:=Sl[I+1];
Sl[I+1]:=Buf;
end;
end;
F:=true;
Дальше проверяем расположения букв по алфавиту.
for I:=1 to Count-1 do
if Sl[I]>Sl[I+1] then
begin
F:=False;
break;
end;
alforder:=F;
end;
end;
Процедура colsimmsolvo получает в качестве параметра строчку S, и считает в ней симметричные слова, выводит их на экран и выводит количество отысканных симметричных слов.
procedure colsimmslovo(S: Stroka250);
var
F: boolean;
Len: Byte;
I: Byte;
Counter: Byte;
Buf: Slovo;
Index, L: Byte;
MaxCol: Byte;
begin
Len:=Length(S);
Заносим в конец строчки пробел, если его там нет.
if S[Len]<>’ ‘ then
begin
S:=S+’ ‘;
Inc(Len);
end;
За F обозначаем флаг нахождения слова, F=true –найдено новое слово. И сбрасываем изначальное
F:=False;
Counter:=0;
writeln(‘Spisok simmetrichnyh slov iz bolshe chem 2 znaka:’);
Начинаем поиск симметричных слов в строке.
for I:=1 to Len do
В случае, если i-й знак не пробел, устанавливаем флаг новейшего слова, запоминаем начало новейшего слова, и сбрасываем изначальное
if S[I]<>’ ‘ then
begin
if F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Inc(L);
end
else
По другому, если установлен признак новейшего слова, то сбрасываем его. Если длинна слова больше 2-ух знаков, то копируем слово в буффер.
if F=True then
begin
F:=False;
if L>2 then
begin
Buf:=Copy(S, Index, L); {kopiruem slovo v Buf}
Buf[0]:=char(L);
Дальше функцией проверяем слово на симметрию, и если оно симметрично, то увеличиваем счетчик на единицу, и выводим это слово на экран.
if simmetr(Buf) then
begin
Inc(Counter);
writeln(Buf);
end;
end;
end;
writeln(‘Kol-vo naidennyh slov: ‘, Counter);
end;
Процедура проверки словва на симметричность.
function simmetr(S: Slovo):boolean;
var
L, I, R: Byte;
F: Boolean;
Begin
Начинаем инспектировать симметричные относительно центра знаки. Если они совпадают, то функции присваивается True. Если хоть один знак не сходится, то программка выходит из цикла и функции присваивается
L:=Length(S);
R:=L div 2;
F:=True;
for I:=1 to R do
if S[I]<>S[L-I+1] then
begin
F:=False;
break;
end;
simmetr:=F;
end;
2 Задание №2
Символьный квадратный массив заполнен случайным набором знаков. Найти количество цепочек, расположенных по вертикали и/либо горизонтали и состоящих лишь из латинских букв.
2.1 Блок-схема программки
2.2 Работа программки
Сначала задаем 2 типа: самой матрицы и буффера.
type
Matrix=array[1..20,1..20] of Integer;
type
Vector=array[1..80] of Integer;
Begin
Делаем чистку экрана для комфортного ввода и вывода инфы и делаем запрос на ввод размера массива, согласно положению.
clrscr;
Повторяем ввод до того времени, пока не будет введено число от 12 до 22.
repeat
write(‘Razmer matricy (12..20): ‘);
readln(N);
until (N>=12) and (N<=20);
Используем функцию для формирования матрицы Matr размером N на N ячеек. Потом выводим ее на экран.
FormMatrix(Matr, N, N);
writeln(‘Sformirovana matrica:’);
PrintMatrix(Matr, N, N);
Используем функцию поворота матрицы и выводим матрицу на экран.
TurnMatrix(Matr, N);
writeln(‘Matrica posle povorota’);
PrintMatrix(Matr, N, N);
readln;
end.
Процедура FormMatrix
Данная процедура присваивает значения от -99 до 99 элементам матрицы.
procedure FormMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
D: Integer;
R: Integer;
begin
randomize;
for I:=1 to N do
for J:=1 to M do
begin
Присваиваем элементу хоть какое
A[I,J]:=random(100);
Если случайное число от 0 до 999 четное, данный элемент становится отрицательным, по другому символ не меняется.
if (random(1000) mod 2)=0 then
A[I,J]:=0-A[I,J];
end;
end;
Процедура вывода матрицы на экран.
procedure PrintMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
Begin
Задаем два цикла, один для столбцов, 2-ой для строк и попеременно выводим все элементы строчки. Опосля чего же выводим последующую строчку.
for I:=1 to N do
begin
for J:=1 to M do
write(A[I,J]:4);
writeln;
end;
end;
Процедура поворота матрицы на 90 градусов вправо.
procedure TurnMatrix(var A: Matrix; N: Integer);
var
Arr: Vector;
I, J, K, Ot, L: Integer;
R: Integer;
Revers: Integer;
Buf1, Buf2: Integer;
begin
R:=N div 2;
Ставим изначальное
Ot:=0;
for K:=1 to R do
begin
Переменная L отвечает за количество частей в массиве Arr. Ставим изначальное значение равное нулю, а потом заносим в массив Arr элементы матрицы.
L:=0;
for J:=1+Ot to N-Ot do
begin
Inc(L);
Arr[L]:=A[1+Ot, J];
end;
for I:=2+Ot to N-1-Ot do
begin
Inc(L);
Arr[L]:=A[I, N-Ot];
end;
for J:=N-Ot downto 1+Ot do
begin
Inc(L);
Arr[L]:=A[N-Ot, J];
end;
for I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
Arr[L]:=A[I, 1+Ot];
end;
Находим на сколько частей необходимо двинуть массив Arr.
Revers:=N-2*Ot-1;
Дальше, при помощи процедуры, циклически сдвигаем массив Arr из L частей на Revers позиций на Право. И записываем получившийся массив назад в матрицу.
TurnArray(Arr, L, Revers);
L:=0;
for J:=1+Ot to N-Ot do
begin
Inc(L);
A[1+Ot, J]:=Arr[L];
end;
for I:=2+Ot to N-1-Ot do
begin
Inc(L);
A[I, N-Ot]:=Arr[L];
end;
for J:=N-Ot downto 1+Ot do
begin
Inc(L);
A[N-Ot, J]:=Arr[L];
end;
for I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
A[I, 1+Ot]:=Arr[L];
end;
Увеличиваем
Inc(Ot);
end;
Процедура повторяющегося сдвига массива.
procedure TurnArray(var V: Vector; NN: Integer; Rev: Integer);
var
Buf: Integer;
I, J: Integer;
Begin
for J:=1 to Rev do
begin
Сохраняем
Buf:=V[NN];
for I:=NN downto 2 do
V[I]:=V[I-1];
V[1]:=Buf;
end;
end;
3 Задание №3
Соединить два файла в 3-ий, добавив опосля содержимого первого файла лишь те строчки второго файла, в каких имеются числа-палиндромы.
3.1 Блок-схема программки
3.2 Работа программки
Begin
Выводим на экран меню, представленное на рисунке 2.
Набросок 2 – основное меню третьей программки.
menu;
Задаем три переменных, которые будут отвечать за информацию о вводе имени для 3-х файлов. И еще одну, которая будет отвечать за работу программки.
pf:=false;
vf:=false;
tf:=false;
cont:=true;
В дальнейшем нам пригодится еще 2 переменных, flag1 и flag1, которые будут отвечать за наличие инфы в файлах.
flag1:=false;
flag2:=false;
while cont do
begin
writeln;
write(‘Vvedite komandu: ‘);
Считываем команду и запускаем одну из процедур.
readln(command);
case command of
‘0’: cont:=false;
‘1’: begin
write(‘Vvedite imja pervogo faila: ‘);
readln(p);
Запускаем проверку корректности ввода имени файла, и если она проходит, то флаг ввода воспринимает
if check1(p)=true then
begin
pf:=true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln(‘Error input’);
end;
end;
‘2’: begin
write(‘Vvedite imja vtorogo faila: ‘);
readln(v);
Запускаем проверку корректности ввода имени файла, и если она проходит, то флаг ввода воспринимает
if check1(v)=true then
begin;
vf:=true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln(‘Error input’);
end;
end;
‘3’: begin
write(‘Vvedite imja tretego faila: ‘);
readln(t);
Запускаем проверку корректности ввода имени файла, и если она проходит, то флаг ввода воспринимает
if check1(t)=true then
begin
tf:=true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln(‘Error input’);
end;
end;
‘4’: begin
Если все три имени файла введены правильно, то запускается ряд процедур по составлению третьего файла.
if (pf=true)and(vf=true)and(tf=true) then
begin
filepr;
Данная процедура глядит количество строк в файлах и выбирает наибольшее и малое.
chmax;
Если оба файлы не пустые, то программка приступает к образованием слов и записи их в 3-ий файл.
if check2=false then
begin
Ставим цикл до малого числа строк.
for l:=1 to m do
begin
slv;
obrslov(slova1,slova2,k1,k2,slova,k);
for g:=1 to k do
begin
write(third,slova[g]);
if g<k then write(third,’ ‘);
end;
тут осуществляется переход на последующую строку.
writeln(third,»);
end;
Избираем в котором из файлов больше строк и переписываем оставшиеся без конфигураций.
if m1<>m2 then
begin
if m1>m2 then for L:=m to m1 do
begin
readln(first,S1);
writeln(third,S1);
end
else
for L:=m to m2 do
begin
readln(second,S2);
Writeln(third,S2);
end;
end;
closing;
writeln(‘Operacia zavershena’);
end
else
Если 1-ые два файла не прошли проверку, то программка произнесет, какой конкретно из файлов пустой.
begin
if flag1=true then writeln(‘Pervii fail pustoi’);
if flag2=true then writeln(‘Vtoroi fail pustoi’);
end;
end
else
begin
Если файл не прошел первую проверку, то программка произнесет, имя какого из файлов введено ошибочно либо совершенно не было введено.
if pf=false then writeln(‘Ne vvedeno imja pervogo faila’);
if vf=false then writeln(‘Ne vvedeno imja vtorogo faila’);
if tf=false then writeln(‘Ne vvedeno imja tretego faila’);
end;
end;
else
writeln(‘Neizvestnaya komanda’);
end;
end;
end.
Процедура корректности проверки ввода имени файлов.
function check1(x:string):boolean;
begin
В данном случае проверяется пустой ввод, и название файла, начинающееся с пробела.
if length(x)>0 then begin
if x[1]<>’ ‘ then
check1:=true;
end;
end;
Процедура привязки и открытия файлов.
procedure filepr;
begin
assign(first,p);
assign(second,v);
assign(third,t);
reset(first);
reset(second);
rewrite(third);
end;
Процедура проверки количества строк в файлах.
procedure chmax;
begin
Сбрасываем счетчик строк.
m1:=0;
m2:=0;
И пока не конец файла перебираем строчки и прибавляем по единице к счетчику.
while not eof(first) do
begin
readln(first,S1);
m1:=m1+1;
end;
Пока не конец файла перебираем строчки и прибавляем по единице к счетчику.
while not eof(second) do
Begin
readln(second,S2);
m2:=m2+1;
end;
И присваиваем малое
if m1<m2 then m:=m1 else m:=m2;
Поновой закрываем и открываем файлы.
close(first);
reset(first);
close(second);
reset(second);
end;
Процедура разбития строчки на слова и перемещение их в массив.
Procedure slv;
var
i,j:integer;
begin
Считываем первую строку из обоих файлов и добавляем пробел сначала и в конце строчки.
Readln(first,S1);
readln(second,S2);
S1:=’ ‘+S1+’ ‘;
S2:=’ ‘+S2+’ ‘;
Сбрасываем счетчик количества слов.
k1:=0;
k2:=0;
Начинаем перебор частей до того времени, пока не найдем пробел. Дальше смотрим, если след элемент опосля пробела, тоже пробел, то пропускаем 1-ый. Если же мы получаем слово, то копируем его в одну из ячеек массива.
for i:=1 to length(S1) do
begin
if s1[i]=’ ‘ then
begin
for j:=i+1 to length(s1) do
if s1[i+1]<>’ ‘ then
if s1[j]=’ ‘ then begin
k1:=k1+1;
slova1[k1]:=copy(s1,i+1,j-i-1);
break;
end;
end;
end;
for i:=1 to length(S2) do
begin
if s2[i]=’ ‘ then
begin
for j:=i+1 to length(s2) do
if s2[i+1]<>’ ‘ then
if s2[j]=’ ‘ then begin
k2:=k2+1;
slova2[k2]:=copy(s2,i+1,j-i-1);
break;
end;
end;
end;
end;
Процедура отсортировки слов.
procedure obrslov(a,b:arr;na,nb:integer; var c:arr; var nc:integer);
var i,j,k:integer;
begin
nc:=0;
Делаем несколько циклов, посреди которых перебираем элементы первого массива и сравниваем их со вторым. Потом элементы вторго с элементами первого и оставшиеся заносятся в новейший массив.
for i:=1 to na do
begin
k:=0;
for j:=1 to nb do
if a[i]=b[j] then k:=1;
if k=0 then
begin
nc:=nc+1;
c[nc]:=a[i];
end;
end;
for i:=1 to nb do
begin
k:=0;
for j:=1 to na do
if b[i]=a[j] then k:=1;
if k=0 then
begin
nc:=nc+1;
c[nc]:=b[i];
end;
end;
end;
Функция проверки файлов на информацию.
function check2:boolean;
begin
В данному случае мы смотри, не находится ли конец файла на первом месте, и если хоть один файл пустой, то функции присваивается
if eof(first)=true then flag1:=true else flag1:=false;
if eof(second)=true then flag2:=true else flag2:=false;
if (flag1=false)and(flag2=false) then check2:=false else check2:=true;
end;
Процедура закрытия всех файлов.
procedure closing;
begin
close(first);
close(second);
close(third);
end;
4 Задание №4.
На дисплее выстроить семейство кривых (Гипоциклоида), данных функцией:
X=A∙cos(t)+D∙cos(A∙t); [0<=t<=2∙pi]
X=A∙sin(t)+D∙sin(A∙t);
Группа характеристик A,D для построения семейства дана в текстовом файле.
4.1 Работа программки
Begin
Присваиваем изначальное
t:=0;
menu;
cont:=true;
while cont do
begin
Вводим команду в показавшееся меню, показанное на рисунке 3.
Набросок 3 – меню программки 4.
Writeln(‘Vvedite komady: ‘);
Readln(command);
case command of
‘0’:cont:=false;
‘1’:
begin
writeln;
Вводится имя файла. Имя проходит проверку, если проверка успешна, то из него читаются два значения (А и D) и файл сходу же запирается.
writeln(‘Vvedite imja faila: ‘);
Readln(name);
if check1 = true then begin
namef:=true;
read(fileg,a);
read(fileg,d);
close(fileg);
end else namef:=false;
end;
‘2’:
Begin
Если из файла удачно считали информацию, программка перебегает к построению графика, а конкретно:
-Очистака окна.
-Изменению разрешения.
-Построению графика.
-Окончанию выполнения программки.
if namef=false then
writeln(‘Ne Vvedeno imja faila’)
else
begin
clearwindow;
SetWindowSize(800,600);
mnoj;
graf;
cont:=false;
end;
end;
end;
end;
Последующая функция не дает изменять график до функции ReDraw.
lockdrawing;
OnResize же дозволяет созодать определенные процедуры при изменение размера окна.
OnResize:=resize;
end.
Функция У
function Yfunc(i: real): real;
begin
result:=A*sin(i)-D*sin(A*t);
end;
Функция Х
function Xfunc(i:real):real;
begin
Xfunc:=A*cos(i)+D*cos(A*i);
end;
Процедура нахождения наибольшего значения функции, а заодно и множителя.
procedure mnoj;
begin
t:=0;
Задаем цикл и отыскиваем наибольшее
while t <= 2*pi do
begin
xx:=trunc(Xfunc(t));
ifabs(xx)> maxx then maxx:=абс(xx);
yy:=trunc(Yfunc(t));
if абс(yy)> maxy then maxy:=абс(yy);
тут изменяем точность поиска.
t:=t+0.001;
end;
Опосля чего же отыскиваем коэффициент координат. Он зависит от нескольких переменных: ширина, высота, и наибольшей координаты.
if WindowWidth<WindowHeight then
if maxy>maxx then k:=(WindowHeight/2)/maxy else k:=(windowWidth/2)/maxx else
If maxx>maxy then k:=(windowheight/2)/maxx else k:=(windowWidth/2)/maxy;
end;
Функция проверки файла на корректность ввода имени и на нахождения в нем данных.
function check1:boolean;
begin
Проверка длинны имени файла.
if length(name)>0 then
begin
assign(fileg, name);
reset(fileg);
if eof(fileg)=false then check1:= true else check1:=false;
end;
end;
Процедура построения графика.
procedure graf;
begin
Уменьшаем наш коэффициент, чтоб уместились обозначения системы координат.
k:=k-k*0.1;
Дальше чертим ровно по центру оси Х и У. Стрелочки, показывающее направление. Все данные берутся зависимо от размера экрана, для удобства просмотра как при небольшом, так и при большенном разрешение.
moveto(1, windowHeight div 2);
lineto(WindowWidth, WindowHeight div 2);
moveto(WindowWidth div 2, 1);
lineto(WindowWidth div 2, WindowHeight);
moveto(trunc((WindowWidth div 2)*0.98),trunc(0.04*WindowHeight));
Lineto((Windowwidth div 2),1);
lineto(trunc((windowWidth div 2)*1.02),trunc(0.04*windowHeight));
moveto(trunc(windowwidth*0.96),trunc(0.98*(windowheight div 2)));
lineto(windowwidth,windowheight div 2);
lineto(trunc(windowwidth*0.96),trunc(1.02*(windowheight div 2)));
T:=0;
Вычисляем стартовые координаты и перемещаем туда курсор, для предстоящего построения.
xx:=(WindowWidth div 2)+trunc(k*Xfunc(t));
yy:=(WindowHeight div 2)+trunc(k*Yfunc(t));
moveto(xx,yy);
Задаем цикл, в каком программка сама будет высчитывать значения, и отрисовывать график.
while t<=2*pi do
begin
xx:=(WindowWidth div 2)+trunc(k*Xfunc(t));
yy:=(WindowHeight div 2)+trunc(k*Yfunc(t));
lineto(xx,yy);
Число ниже влияет на точность построения графика. При огромных значениях график может весьма длительно строится, а при малеханьких график выходит не точны и угловатый.
t:=t+0.001;
end;
Для улучшения просматриваемости графика, при малеханьких разрешениях подписи систем координат скрываются.
If WindowWidth>400 then
If Windowheight>200 then
begin
textout(trunc(1.05*(windowWidth div 2)),trunc(0.01*(WindowHeight )),’Y’);
Textout(trunc(0.95*WindowWidth),trunc((WindowHeight div 2)*1.05),’X’);
end;
end;
Процедура перечерчивания графика при смене разрешения.
procedure resize;
begin
mnoj;
ClearWindow;
graf;
redraw;
lockdrawing;
end;
5 Задание №5
Написать программку, которая сформировывает файл записей данной структуры:
Type Vladelez=Record
Familia: String;
Adress:String;
Avto:lnteger;
Nomer:Integer;
End;
и описывает: —количество каров каждой марки;
-владельца самого старенького кара;
-фамилии хозяев и номера каров данной марки.
5.1 
Блок-схема программки
5.2 Работа программки
Begin
Задаем цикл, и заполняем массив ch, который будет отвечать за введение инфы в иной массив.
for i:=1 to 200 do
ch[i]:=false;
Очищаем экран для комфортного ввода, и выводим меню на экран, которое представлено на рисунке 4.
Набросок 5 – меню пятой программки.
clrscr;
menu;
Задаем две переменные, которые отвечают за работу программки и за введение количества частей.
cont:=true;
fzap:=false;
while cont do
begin
write(‘Vvedite komandu: ‘);
readln(command);
case command of
‘0’: cont := false;
‘1’:
Begin
Задаем общее количество частей массива, если запись будет соответствовать условию, то fzap присвоится true.
Write(‘Vvedite kol-vo zapisei(1..200): ‘);
readln(n);
if (n>0) and (n<=200) then
fzap:=true else fzap:=false;
end;
‘2’:
Begin
Если было введено общее количество записей, то запустится цикл с циклической процедурой, до того времени пока не будут введены все записи. В неприятном случае выведется сообщение, что не введено общее количество записей.
if fzap=true then
begin
for i:=1 to n do
сhange(i, avtovl, ch);
clrscr;
menu;
end
else writeln(‘Ne vvedeno kol-vo zapisei’);
end;
‘3’:
Begin
Если было введено общее количество частей, то можно редактировать записи по очереди. Если введено число больше общего числа частей, то программка скажет от ошибке ввода.
if fzap=true then
begin
write(‘Vvedite nomer redaktiryemoi zapisi: ‘);
readln(i);
if i>n then writeln(‘Wrong input’)
else
begin
change(i, avtovl, ch);
clrscr;
menu;
end;
end
else Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
‘4’:
Begin
Сначала программка инспектирует, введено ли общее число частей. Потом инспектирует любой элемент по очереди. Если они все заполнены, то начинается выполнятся процедура по подсчету машин каждой марки.
if fzap=true then
begin
for i:=1 to n do
if ch[i]=false then
begin
dzap:=false;
writeln(‘Vvedeni ne vse zapisi’);
end
else dzap:=true;
if dzap=true then
mark(avtovl);
end
else
Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
‘5’:
Begin
Все проверки производятся аналогично предшествующему варианту, но тут выбирается процедура нахождения владельца самого старенького авто.
if fzap=true then
begin
for i:=1 to n do
if ch[i]=false then
begin
dzap:=false;
writeln(‘Vvedeni ne vse zapisi’);
end
else dzap:=true;
if dzap=true then
mostold(avtovl);
end
else
Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
‘6’:
Begin
Все проверки производятся аналогично предшествующему варианту, но тут выбирается другая процедура.
if fzap=true then
begin
for i:=1 to n do
if ch[i]=false then
begin
dzap:=false;
writeln(‘Vvedeni ne vse zapisi’);
end
else dzap := true;
if dzap=true then
oprmarki(avtovl);
end
else
Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
end;
end;
end.
Процедура oprmarki;
procedure oprmarki(x: mas);
var
h:integer;
m:string;
begin
Вводим заглавие марки, и программка переберет все записи и при нахождение таковой же марки выведет на экран фамилию обладателя и номер кара.
Write(‘Vvedite marku avto: ‘);
readln(m);
for h:=1 to n do
if x[h].Avto=m then
writeln(x[h].Familia, ‘ nomer-‘, x[h].Nomer);
end;
Процедура нахождения самого старенького авто
procedure mostold(x: mas);
var
min,nmin,h:integer;
begin
min:=x[1].Vypusk;
nmin:=0;
Перебираем все записи и сохраняем малый год выпуска в переменную min, а номер записи в переменную nmin. А опосля цикла их выводит на экран.
for h:=1 to n do
if x[h].Vypusk<min then
begin
min:=x[h].Vypusk;
nmin:=h;
end;
Writeln(x[nmin].FamiliaactiveXmin,’ god vypuska’);
end;
Процедура подсчета каров каждой марки.
procedure mark(x: mas);
var
h, l, k: integer;
begin
for h := 1 to n do
begin
Сначала программки задаем пустое огромное количество. И запускаем цикл. Если определенной марки нет в огромном количестве, тогда добавляем ее. И запускаем 2-ой цикл, лишь начиная не с единицы, а с h-го элемента. Потом если h-ый и l-ый элементы совпадают, прибавляем к счетчику единицу .И в конце второго цикла выводим собранные данные на экран.
if not (x[h].avto in marki) = true then
begin
k := 0;
include(marki, x[h].avto);
for l:=h to n do
if x[h]=x[l] then
if x[l].avto in marki then
k:=k + 1;
writeln(x[h].avtoactiveXk);
end;
end;
end;
Процедура ввода данных в запись.
procedure change(x: integer; var z: mas; var v: mas2);
begin
clrscr;
В контрольный массив ставим, что данная запись с сиим номер заполнена.
v[x]:=true;
write(‘Vvedite familiu: ‘);
readln(z[x].familia);
write(‘Vvedite adress: ‘);
readln(z[x].adress);
write(‘Vvedite marku avto: ‘);
readln(z[x].avto);
write(‘Vvedite nomer avto: ‘);
readln(z[x].nomer);
z[x].Vypusk:= 0;
while (z[x].Vypusk < 1900) or (z[x].Vypusk > 2000) do
begin
write(‘Vvedite god vipuska(1900..2000): ‘);
readln(z[x].vypusk);
end;
end;
6 Заключение.
В процессе выполнения курсовой работы мною был исследован язык програмированния Pascal. Также получены практические способности работы с текстовыми строчками, двумерными массивами, файловыми структурами данных, элементами машинной графики и записями.
7 Приложения А
Код программки 1
program slova1;
uses crt;
type
Stroka250=string[250];
Slovo=string[20];
function Copy1(S: Stroka250; Start, Len: Integer):Stroka250;
var
Rez: Stroka250;
L: Integer;
I, J: Integer;
begin
L:=byte(S[0]);
if (L<Start) then
Rez[0]:=char(0)
else
begin
if (Start+Len-1)>L then
Len:=L-Start+1;
J:=Start;
for I:=1 to Len do
begin
Rez[I]:=S[J];
Inc(J);
end;
Rez[0]:=char(Len);
end;
Copy1:=Rez;
end;
function isletter(C: Char): Boolean;
begin
if ((C>=’A’) and (C<=’Z’)) or ((C>=’a’) and (C<=’z’)) then
isletter:=True
else
isletter:=False;
end;
function alforder(Sl: Slovo; var Count: Byte): Boolean;
var
I, L: Byte;
F: Boolean;
Buf: Char;
begin
L:=Length(Sl);
Count:=0;
for I:=1 to L do
begin
if (isletter(Sl[I])) then
Inc(Count);
if (Sl[I]>=’A’) and (Sl[I]<=’Z’) then
Sl[I]:=char(byte(Sl[I])+32);
end;
{esli v slove net bukv}
if Count=0 then
alforder:=False
else
if Count=1 then
alforder:=True
else
begin
F:=True;
While F do
begin
F:=False;
for I:=1 to L-1 do
if (Not isletter(Sl[I])) And (isletter(Sl[I+1])) then
begin
F:=True;
Buf:=Sl[I];
Sl[I]:=Sl[I+1];
Sl[I+1]:=Buf;
end;
end;
F:=true;
for I:=1 to Count-1 do
if Sl[I]>Sl[I+1] then
begin
F:=False;
break;
end;
alforder:=F;
end;
end;
procedure alfslovo(S: Stroka250);
var
F: boolean;
Len: Byte;
I: Byte;
Counter: Byte;
FSlovo, Buf: Slovo;
Index, L: Byte;
MaxCol: Byte;
begin
Len:=Length(S);
if S[Len]<>’ ‘ then
begin
S:=S+’ ‘;
Inc(Len);
end;
F:=False;
MaxCol:=0;
for I:=1 to Len do
if S[I]<>’ ‘ then
begin
if F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Inc(L);
end
else
if F=True then
begin
F:=False;
Buf:=Copy1(S, Index, L);
Buf[0]:=char(L);
if alforder(Buf, Counter) then
begin
if Counter>MaxCol then
begin
FSlovo:=Copy1(S, Index, L);
FSlovo[0]:=char(L);
MaxCol:=Counter;
end;
end;
end;
if MaxCol=0 then
writeln(‘Net podhodyaschi slov v texte’)
else
writeln(FSlovo, ‘ kol-vo bukv: ‘, MaxCol);
end;
function simmetr(S: Slovo):boolean;
var
L, I, R: Byte;
F: Boolean;
begin
L:=Length(S);
R:=L div 2;
F:=True;
for I:=1 to R do
if S[I]<>S[L-I+1] then
begin
F:=False;
break;
end;
simmetr:=F;
end;
procedure colsimmslovo(S: Stroka250);
var
F: boolean;
Len: Byte;
I: Byte;
Counter: Byte;
Buf: Slovo;
Index, L: Byte;
MaxCol: Byte;
begin
Len:=Length(S);
if S[Len]<>’ ‘ then
begin
S:=S+’ ‘;
Inc(Len);
end;
F:=False;
Counter:=0;
writeln(‘Spisok simmetrichnyh slov iz bolshe chem 2 znaka:’);
for I:=1 to Len do
if S[I]<>’ ‘ then
begin
if F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Inc(L);
end
else
if F=True then
begin
F:=False;
if L>2 then
begin
Buf:=Copy(S, Index, L);
Buf[0]:=char(L);
if simmetr(Buf) then
begin
Inc(Counter);
writeln(Buf);
end;
end;
end;
writeln(‘Kol-vo naidennyh slov: ‘, Counter);
end;
procedure menu;
begin
writeln;
writeln(‘++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln(‘+ Vvod texta —> 1 +’);
writeln(‘+ Slovo s max. kol.bukv v alf. poryadke —> 2 +’);
writeln(‘+ Simmetrichnye slova —> 3 +’);
writeln(‘+ Vyvod texta —> 4 +’);
writeln(‘+ +’);
writeln(‘+ Konec —> 0 +’);
writeln(‘++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln;
end;
var
Txt: Stroka250;
Vvod, Cont: Boolean;
Rem: Char;
begin
Vvod:=False;
Cont:=True;
while Cont do
begin
clrscr;
menu;
write(‘Vvedite komandu: ‘);
readln(Rem);
case Rem of
‘0’: Cont:=False;
‘1’: begin
writeln(‘Text:’);
readln(Txt);
Vvod:=True;
end;
‘2’: begin
if Not Vvod then
writeln(‘Ne vveden text’)
else
alfslovo(Txt);
end;
‘3’: begin
if Not Vvod then
writeln(‘Ne vveden text’)
else
colsimmslovo(Txt);
end;
‘4’: begin
if Not Vvod then
writeln(‘Ne vveden text’)
else
writeln(Txt);
end
else
writeln(‘Neizvestnaya komanda’);
end;
if Cont then
begin
write(‘Nagmite ENTER dlya vvoda sleduyuschei komandy… ‘);
readln;
end
else
clrscr;
end;
end.
8 приложение Б
Код программки 2
program massiv1;
uses crt;
type
Matrix=array[1..20,1..20] of Integer;
type
Vector=array[1..80] of Integer;
procedure TurnArray(var V: Vector; NN: Integer; Rev: Integer);
var
Buf: Integer;
I, J: Integer;
begin
for J:=1 to Rev do
begin
Buf:=V[NN];
for I:=NN downto 2 do
V[I]:=V[I-1];
V[1]:=Buf;
end;
end;
procedure TurnMatrix(var A: Matrix; N: Integer);
var
Arr: Vector;
I, J, K, Ot, L: Integer;
R: Integer;
Revers: Integer;
Buf1, Buf2: Integer;
begin
R:=N div 2;
Ot:=0;
for K:=1 to R do
begin
L:=0;
for J:=1+Ot to N-Ot do
begin
Inc(L);
Arr[L]:=A[1+Ot, J];
end;
for I:=2+Ot to N-1-Ot do
begin
Inc(L);
Arr[L]:=A[I, N-Ot];
end;
for J:=N-Ot downto 1+Ot do
begin
Inc(L);
Arr[L]:=A[N-Ot, J];
end;
for I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
Arr[L]:=A[I, 1+Ot];
end;
Revers:=N-2*Ot-1;
TurnArray(Arr, L, Revers);
L:=0;
for J:=1+Ot to N-Ot do
begin
Inc(L);
A[1+Ot, J]:=Arr[L];
end;
for I:=2+Ot to N-1-Ot do
begin
Inc(L);
A[I, N-Ot]:=Arr[L];
end;
for J:=N-Ot downto 1+Ot do
begin
Inc(L);
A[N-Ot, J]:=Arr[L];
end;
for I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
A[I, 1+Ot]:=Arr[L];
end;
Inc(Ot);
end;
end;
procedure FormMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
D: Integer;
R: Integer;
begin
randomize;
for I:=1 to N do
for J:=1 to M do
begin
A[I,J]:=random(100);
if (random(1000) mod 2)=0 then
A[I,J]:=0-A[I,J];
end;
end;
procedure PrintMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
begin
for I:=1 to N do
begin
for J:=1 to M do
write(A[I,J]:4);
writeln;
end;
end;
var
Matr: Matrix;
N: Integer;
begin
clrscr;
repeat
write(‘Razmer matricy (12..20): ‘);
readln(N);
until (N>=12) and (N<=20);
FormMatrix(Matr, N, N);
writeln(‘Sformirovana matrica:’);
PrintMatrix(Matr, N, N);
TurnMatrix(Matr, N);
writeln(‘Matrica posle povorota’);
PrintMatrix(Matr, N, N); readln;
end.
9 приложение В
Код программки 3
program textfile;
uses
crt;
type
arr = array [1..83] of string;
var
slova1, slova2, slova: arr;
m, m1, m2, k1, k2, k, l, g: integer;
first, second, third: text;
command: char;
p, v, t, S1, S2: string;
pf, vf, tf, cont, flag1, flag2: boolean;
function check2: boolean;
begin
if eof(first) = true then flag1 := true else flag1 := false;
if eof(second) = true then flag2 := true else flag2 := false;
if (flag1 = false) and (flag2 = false) then check2 := false else check2 := true;
end;
procedure closing;
begin
close(first);
close(second);
close(third);
end;
procedure obrslov(a, b: arr; na, nb: integer; var c: arr; var nc: integer);
var
i, j, k: integer;
begin
nc := 0;
for i := 1 to na do
begin
k := 0;
for j := 1 to nb do
if a[i] = b[j] then k := 1;
if k = 0 then
begin
nc := nc + 1;
c[nc] := a[i];
end;
end;
for i := 1 to nb do
begin
k := 0;
for j := 1 to na do
if b[i] = a[j] then k := 1;
if k = 0 then
begin
nc := nc + 1;
c[nc] := b[i];
end;
end;
end;
procedure slv;
var
i, j: integer;
begin
Readln(first, S1);
readln(second, S2);
S1 := ‘ ‘ + S1 + ‘ ‘;
S2 := ‘ ‘ + S2 + ‘ ‘;
k1 := 0;
k2 := 0;
for i := 1 to length(S1) do
begin
if s1[i] = ‘ ‘ then
begin
for j := i + 1 to length(s1) do
if s1[i + 1] <> ‘ ‘ then
if s1[j] = ‘ ‘ then begin
k1 := k1 + 1;
slova1[k1] := copy(s1, i + 1, j — i — 1);
break;
end;
end;
end;
for i := 1 to length(S2) do
begin
if s2[i] = ‘ ‘ then
begin
for j := i + 1 to length(s2) do
if s2[i + 1] <> ‘ ‘ then
if s2[j] = ‘ ‘ then begin
k2 := k2 + 1;
slova2[k2] := copy(s2, i + 1, j — i — 1);
break;
end;
end;
end;
end;
procedure chmax;
begin
m1 := 0;
m2 := 0;
while not eof(first) do
begin
readln(first, S1);
m1 := m1 + 1;
end;
while not eof(second) do
begin
readln(second, S2);
m2 := m2 + 1;
end;
if m1 < m2 then m := m1 else m := m2;
close(first);
reset(first);
close(second);
reset(second);
end;
procedure filepr;
begin
assign(first, p);
assign(second, v);
assign(third, t);
reset(first);
reset(second);
rewrite(third);
end;
function check1(x: string): boolean;
begin
if length(x) > 0 then begin
if x[1] <> ‘ ‘ then
check1 := true;
end;
end;
procedure menu;
begin
writeln;
writeln(‘++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln(‘+ Vvod imeni pervogo faila —> 1 +’);
writeln(‘+ Vvod imeni vtorogo faila —> 2 +’);
writeln(‘+ Vvod imeni tretiego faila —> 3 +’);
writeln(‘+ Preobrazovat tretii fail —> 4 +’);
writeln(‘+ +’);
writeln(‘+ Konec —> 0 +’);
writeln(‘++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln;
end;
begin
menu;
pf := false;
vf := false;
tf := false;
cont := true;
flag1 := false;
flag2 := false;
while cont do
begin
writeln;
write(‘Vvedite komandu: ‘);
readln(command);
case command of
‘0’: cont := false;
‘1’:
begin
write(‘Vvedite imja pervogo faila: ‘);
readln(p);
if check1(p) = true then
begin
pf := true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln(‘Error input’);
end;
end;
‘2’:
begin
write(‘Vvedite imja vtorogo faila: ‘);
readln(v);
if check1(v) = true then
begin;
vf := true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln(‘Error input’);
end;
end;
‘3’:
begin
write(‘Vvedite imja tretego faila: ‘);
readln(t);
if check1(t) = true then
begin
tf := true;
clrscr;
menu;
end
else
begin
clrscr;
menu;
writeln(‘Error input’);
end;
end;
‘4’:
begin
if (pf = true) and (vf = true) and (tf = true) then
begin
filepr;
chmax;
if check2 = false then
begin
for l := 1 to m do
begin
slv;
obrslov(slova1, slova2, k1, k2, slova, k);
for g := 1 to k do
begin
write(third, slova[g]);
if g < k then write(third, ‘ ‘);
end;
writeln(third, »);
end;
if m1 <> m2 then
begin
if m1 > m2 then for L := m to m1 do
begin
readln(first, S1);
writeln(third, S1);
end
else
for L := m to m2 do
begin
readln(second, S2);
Writeln(third, S2);
end;
end;
closing;
writeln(‘Operacia zavershena’);
end
else
begin
if flag1 = true then writeln(‘Pervii fail pustoi’);
if flag2 = true then writeln(‘Vtoroi fail pustoi’);
end;
end
else
begin
if pf = false then writeln(‘Ne vvedeno imja pervogo faila’);
if vf = false then writeln(‘Ne vvedeno imja vtorogo faila’);
if tf = false then writeln(‘Ne vvedeno imja tretego faila’);
end;
end;
else
writeln( ‘Neizvestnaya komanda’);
end;
end;
end.
10 приложение Г
Код программки 4
program grafik;
uses
graphabc;
var
xx, yy, a, d, maxy, maxx: integer;
t, k: real;
fileg: text;
cont, namef: boolean;
command: char;
name: string;
function Yfunc(i: real): real;
begin
result := A * sin(i) — D * sin(A * t);
end;
function Xfunc(i: real): real;
begin
result := A * cos(i) + D * cos(A * i);
end;
procedure mnoj;
begin
t := 0;
while t <= 2 * pi do
begin
xx := trunc(Xfunc(t));
if абс(xx) > maxx then maxx := абс(xx);
yy := trunc(Yfunc(t));
if абс(yy) > maxy then maxy := абс(yy);
t := t + 0.001;
end;
if WindowWidth < WindowHeight then
if maxy > maxx then k := (WindowHeight / 2) / maxy else k := (windowWidth / 2) / maxx else
if maxx > maxy then k := (windowheight / 2) / maxx else k := (windowWidth / 2) / maxy;
end;
procedure graf;
begin
k := k — k * 0.1;
moveto(1, windowHeight div 2);
lineto(WindowWidth, WindowHeight div 2);
moveto(WindowWidth div 2, 1);
lineto(WindowWidth div 2, WindowHeight);
moveto(trunc((WindowWidth div 2) * 0.98), trunc(0.04 * WindowHeight));
Lineto((Windowwidth div 2), 1);
lineto(trunc((windowWidth div 2) * 1.02), trunc(0.04 * windowHeight));
moveto(trunc(windowwidth * 0.96), trunc(0.98 * (windowheight div 2)));
lineto(windowwidth, windowheight div 2);
lineto(trunc(windowwidth * 0.96), trunc(1.02 * (windowheight div 2)));
T := 0;
xx := (WindowWidth div 2) + trunc(k * Xfunc(t));
yy := (WindowHeight div 2) + trunc(k * Yfunc(t));
moveto(xx, yy);
while t <= 2 * pi do
begin
xx := (WindowWidth div 2) + trunc(k * Xfunc(t));
yy := (WindowHeight div 2) + trunc(k * Yfunc(t));
lineto(xx, yy);
t := t + 0.0001;
end;
if WindowWidth > 400 then
if Windowheight > 200 then
begin
textout(trunc(1.05 * (windowWidth div 2)), trunc(0.01 * (WindowHeight )), ‘Y’);
Textout(trunc(0.95 * WindowWidth), trunc((WindowHeight div 2) * 1.05), ‘X’);
end;
end;
function check1: boolean;
begin
if length(name) > 0 then
begin
assign(fileg, name);
reset(fileg);
if eof(fileg) = false then check1 := true else check1 := false;
end;
end;
procedure menu;
begin
writeln;
writeln(‘++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln(‘+ Vvod imeni faila s parametrami —> 1 +’);
writeln(‘+ Porstroenie grafika —> 2 +’);
writeln(‘+ Vihod —> 0 +’);
writeln(‘++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln;
end;
procedure resize;
begin
mnoj;
ClearWindow;
graf;
redraw;
lockdrawing;
end;
begin;
t := 0;
menu;
cont := true;
while cont do
begin
Writeln(‘Vvedite komady: ‘);
Readln(command);
case command of
‘0’: cont := false;
‘1’:
begin
writeln;
writeln(‘Vvedite imja faila: ‘);
Readln(name);
if check1 = true then begin
namef := true;
read(fileg, a);
read(fileg, d);
close(fileg);
end else namef := false;
end;
‘2’:
begin
if namef = false then
writeln(‘Ne Vvedeno imja faila’)
else
begin
clearwindow;
SetWindowSize(800, 600);
mnoj;
graf;
cont := false;
end;
end;
end;
end;
lockdrawing;
OnResize := resize;
end.
11 приложение Д
Код программки 5
program zapisi;
uses
crt;
type
vladelez = record
Familia: string;
Adress: string;
Avto: string;
Nomer: string;
Vypusk: integer;
end;
mas2 = array [1..200] of boolean;
mas = array [1..200] of vladelez;
var
command: char;
cont, fzap, dzap: boolean;
avtovl: mas;
n: integer;
i: integer;
ch: mas2;
marki: set of string;
procedure oprmarki(x: mas);
var
h: integer;
m: string;
begin
Write(‘Vvedite marku avto: ‘);
readln(m);
for h := 1 to n do
if x[h].Avto = m then
writeln(x[h].Familia, ‘ nomer-‘, x[h].Nomer);
end;
procedure mostold(x: mas);
var
min, nmin, h: integer;
begin
min := x[1].Vypusk;
nmin := 1;
for h := 1 to n do
if x[h].Vypusk < min then
begin
min := x[h].Vypusk;
nmin := h;
end;
Writeln(x[nmin].FamiliaactiveXmin, ‘ god vypuska’);
end;
procedure mark(x: mas);
var
h, l, k: integer;
begin
for h := 1 to n do
begin
if not (x[h].avto in marki) = true then
begin
k := 0;
include(marki, x[h].avto);
for l := h to n do
if x[h] = x[l] then
if x[l].avto in marki then
k := k + 1;
writeln(x[h].avtoactiveXk);
end;
end;
end;
procedure change(x: integer; var z: mas; var v: mas2);
begin
clrscr;
v[x] := true;
write(‘Vvedite familiu: ‘);
readln(z[x].familia);
write(‘Vvedite adress: ‘);
readln(z[x].adress);
write(‘Vvedite marku avto: ‘);
readln(z[x].avto);
write(‘Vvedite nomer avto: ‘);
readln(z[x].nomer);
z[x].Vypusk := 0;
while (z[x].Vypusk < 1900) or (z[x].Vypusk > 2000) do
begin
write(‘Vvedite god vipuska(1900..2000): ‘);
readln(z[x].vypusk);
end;
end;
procedure menu;
begin
writeln;
Writeln(‘+++++++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln(‘+ Ykazat kolichestvo zapisei ->1 +’);
writeln(‘+ Izmenit vse zapisi ->2 +’);
writeln(‘+ Izmenit odny zapis ->3 +’);
writeln(‘+ Kolichestvo avtomobilei kazdoi marki ->4 +’);
writeln(‘+ Vladelec samogo starogo avtomobila ->5 +’);
writeln(‘+ Familii vladelcev i nomera avto dannoi marki ->6 +’);
Writeln(‘+ +’);
writeln(‘+ Konec ->0 +’);
Writeln(‘+++++++++++++++++++++++++++++++++++++++++++++++++++++’);
writeln;
end;
begin
for i := 1 to 200 do
ch[i] := false;
clrscr;
menu;
cont := true;
fzap := false;
while cont do
begin
write(‘Vvedite komandu: ‘);
readln(command);
case command of
‘0’: cont := false;
‘1’:
begin
Write(‘Vvedite kol-vo zapisei(1..200): ‘);
readln(n);
if (n > 0) and (n <= 200) then
fzap := true else fzap := false;
end;
‘2’:
begin
if fzap = true then
begin
for i := 1 to n do
change(i, avtovl, ch);
clrscr; menu;
end
else writeln(‘Ne vvedeno kol-vo zapisei’);
end;
‘3’:
begin
if fzap = true then
begin
write(‘Vvedite nomer redaktiryemoi zapisi: ‘);
readln(i);
if i > n then writeln(‘Wrong input’)
else
begin
change(i, avtovl, ch);
clrscr;
menu;
end;
end
else Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
‘4’:
begin
if fzap = true then
begin
for i := 1 to n do
if ch[i] = false then
begin
dzap := false;
writeln(‘Vvedeni ne vse zapisi’);
end
else dzap := true;
if dzap = true then
mark(avtovl);
end
else
Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
‘5’:
begin
if fzap = true then
begin
for i := 1 to n do
if ch[i] = false then
begin
dzap := false;
writeln(‘Vvedeni ne vse zapisi’);
end
else dzap := true;
if dzap = true then
mostold(avtovl);
end
else
Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
‘6’:
begin
if fzap = true then
begin
for i := 1 to n do
if ch[i] = false then
begin
dzap := false;
writeln(‘Vvedeni ne vse zapisi’);
end
else dzap := true;
if dzap = true then
oprmarki(avtovl);
end
else
Writeln(‘Ne vvedeno obshee chislo zapisei’);
end;
end;
end;
end.
]]>