Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Сборник задач Бабалова.doc
Скачиваний:
86
Добавлен:
04.06.2015
Размер:
1.16 Mб
Скачать

Insert_list(li);

end;

end;

procedure List_displ;

{ Вывести полностью список на экран для проверки правильности записи и преобразований}

Var I:integer;

begin

i:=1;

lp:=pStart;

writeln('Список всех, имеющихся в файле ');

while lp<>nil do

begin

write(i,' ');

write(lp^.li.title+' ');

write(lp^.li.Nm+' ');

write(lp^.li.Pt+' ');

writeln(lp^.li.Number);

lp:=lp^.next;

i:=i+1;

end;

end;{Список можно теперь увидеть на экране}

procedure List_equal;

{Алгоритм поиска однофамильцев используется для упорядоченного списка по фамилиям, но он будет пригоден и для произвольного списка}

Var I:integer;p:boolean;

begin

lp:=pStart;

pList:=lp;

i:=1;

while lp<>nil do

begin

p:=true;

while (p and (pList<>nil)) do

begin

if pList<>lp then

if lp^.li.Title=pList^.li.Title then

begin

write(i,' ');

write(lp^.li.Title+' ');

write(lp^.li.Nm+' ');

write(lp^.li.Pt+' ');

writeln(lp^.li.Number);

i:=i+1;

p:=false;

end;

pList:=pList^.next;

end;

pList:=lp;

lp:=lp^.next;

end; {Просмотр списка начинается заново всегда со следующего элемента}

end; {конец поиска однофамильцев}

procedure Sort;

var

p1, p2, temp: pEl_list;

tt:list;

begin

if ((pStart = nil) or (pStart^.Next = nil)) then

exit;

repeat

p1 := pStart;

p2:=p1^.next;

noswap:=true;

while (p2 <> nil) do

begin

if (p1^.li.Title > p2^.li.Title) then

begin

{сравниваем только поля фамилий в списке}

noswap:=false;

tt := p1^;

p1^:= p2^;

p2^:= tt;

temp:= p1^.next;

p1^.next := p2^.next;

p2^.next:= temp;

end;

p1:=p2;

p2 := p2^.Next;

end;

until noswap;

end;{Конец сортировки}

procedure redact(x1,y1,l,v:integer);

begin

textbackground(2);

window(x1+2,y1+oi*2-1,x1+l+2,y1+oi*2-l);

clrscr;

write(alter[oi]);

textbackground(4);

window(x1+2,y1+v*2-i,x1+l+2,y1+v*2-l);

clrscr;

write(alter[v]);

end;

procedure dialog;

begin

textbackground(1);

window(30,2,78,23);

clrscr;

end;

procedure alt(x1,y1,l:integer); {это только меню в текстовом режиме для выполнения всех действий в определенной последовательности}