program
dynms_list;
uses
crt;
type
link=^list;
list=record
family,name,surname:string;
ADR:string;
mark:string;
year:string;
color:string;
enige:string;
number:string;
next:link;
end;
proc_out=procedure
(base:link;i:integer);
var
base:link;
n:integer;
k:boolean;
first_rec:string;
{$F+}
procedure
out_list(base:link;i:integer);
begin
with
base^ do
begin
writeln('Элемент
№',i);
writeln('╔═══════════╤═══════════════════════════╗');
writeln('║Фамилия:
│',family:27,'║');
writeln('║Имя:
│',name:27,'║');
writeln('║Отчество:
│',surname:27,'║');
writeln('║Адрес:
│',adr:27,'║');
writeln('║Марка:
│',mark:27,'║');
writeln('║Год:
│',year:27,'║');
writeln('║Цвет:
│',color:27,'║');
writeln('║Движок:
│',enige:27,'║');
writeln('║Номер:
│',number:27,'║');
writeln('╚═══════════╧═══════════════════════════╝');
writeln('Нажмите
ENTER для
продолжения');
readln;
end;
end;
{$F-}
procedure
drop_list(out_list:proc_out;base:link);
var
i:integer;
begin
if
base=nil then
begin
writeln('Список
пуст');
readln;
exit;
end;
i:=0;
repeat
i:=i+1;
clrscr;
out_list(base,i);
base:=base^.next;
until
base=nil;
end;
procedure
get_list(var base:link;VAR K:INTEGER);
var
buff:link;
i:integer;
begin
clrscr;
base:=nil;
writeln('Введите
количество
элементов');
readln(k);
for
i:=k downto 1 do
begin
new(buff);
clrscr;
writeln('Вы
заполняете
карточку
',i);
with
buff^ do
begin
write('Фамилия:
');
readln(family);
write('Имя:
');
readln(name);
write('Отчество:
');
readln(surname);
write('Адрес:
');
readln(adr);
write('Марка:
');
readln(mark);
write('Год
выпуска:
');
readln(year);
write('Цвет:
');
readln(color);
write('Двигатель:
');
readln(enige);
write('Гос.номер:
');
readln(number);
end;
buff^.next:=base;
base:=buff;
end;
end;
procedure
scan_list(out_list:proc_out; base:link);
var
first_rec:string[30];
k:integer;
begin
clrscr;
if
base=nil then
begin
writeln('Список
пуст');
readln;
exit;
end;
write('Введите
фамилию:
');
readln(first_rec);
k:=0;
repeat
k:=k+1;
if
first_rec=base^.family then
begin
clrscr;
out_list(base,k);
end;
base:=base^.next;
until
base=nil;
end;
procedure
cut_list(var base:link;var n:integer);
var
num,k:integer;
buff,buff_prev:link;
ans:char;
begin
clrscr;
if
base=nil then
begin
writeln('Список
пуст');
readln;
exit;
end;
writeln('Введите
номер
элемента');
readln(num);
buff:=base;
buff_prev:=nil;
for
k:=1 to n do
begin
if
k=num then
begin
out_list(buff,k);
writeln('Удалить
элемент?
1-Да
Anykey-Нет');
ans:=readkey;
if
ans='1'then
begin
if
buff=base then
begin
buff_prev:=base^.next;
dispose(base);
base:=buff_prev;
buff:=base;
end
else
begin
buff_prev^.next:=buff^.next;
dispose(buff);
buff:=buff_prev;
end;
end;
end
else
buff_prev:=buff;
buff:=buff^.next;
end;
end;
procedure
main_menu(var k:boolean);
var
g:char;
begin
clrscr;
window(14,6,66,24);
writeln('Связанный
список. Лабораторная работа №5');
writeln;
writeln('Выберете
действие:');
writeln('┌───┬────────────────────────┐');
writeln('│
1 │Ввод новых элементов │ ');
writeln('│
2 │Вывод элементов на экран│');
writeln('│
3 │Поиск в базе по ключу │');
writeln('│
4 │Удаление элемента │');
writeln('│
5 │Завершение работы │');
writeln('└───┴────────────────────────┘');
g:=readkey;
case
g of
'1':get_list(base,n);
'2':drop_list(out_list,base);
'3':scan_list(out_list,base);
'4':cut_list(base,n);
'5':k:=true
else
writeln('Hеправильная
команда');
end;
end;
begin
textcolor(15);
textbackground(1);
k:=false;
main_menu(k);
while
k=false do
main_menu(k);
end.
|