Работа со списком. Вставляем список в заданное место другого списка
---- Исходный текст программы ----
Program Spiski1;
{ Заполняет списки. Вставляет в список L за первым вхождением
элемента E все элементы списка L1, если E содержится в L
}
uses crt;
type PElem = ^TElem;
TElem = record
GodRojden: Integer;
FIO: string[50];
Next: PElem;
end;
s2= string[2];
var e1,e2,Iskomii: PElem; d1,NacaloL,NacaloL1:TElem;
GR: integer;
Function Pusto(PP: Pointer):Boolean;
begin
if PP=nil then
begin writeln('Список пустой. Жми Enter'); readln;
Pusto := true; textattr:= $07; clrscr;
end else Pusto:= false;
end;
Procedure ControlSpiska(Nac:TElem; Ima: s2);
var ele: PElem;
begin clrscr;
writeln(' --------- КОНТРОЛЬ списка '+Ima+' -----------');
ele:= Nac.Next; if Pusto(ele) then halt(1); { выход в систему с кодом завершения = 1
(сигнал ошибки)}
Repeat
writeln ('Ф.И.О. = ',ele^.FIO);
writeln('Год рождения = ',ele^.GodRojden);
ele:= ele^.Next;
until ele = nil;
write('Для продолжения жми Enter'); readln;
end;
Procedure VvodSpiska(var Nac:TElem; Ima: s2);
var ele: PElem; buf: TElem;
begin textattr:= $1F;
clrscr; buf:= Nac;
writeln('--------- Введи список '+Ima+' -----------');
Nac.Next:= nil;
Repeat
write('Введи ФИО -> '); readln(d1.FIO);
if d1.FIO = '' then break;
write('Введи год рождения -> '); readln(d1.GodRojden);
New(ele);
ele^ := d1;
ele^.Next:= Nac.Next;
Nac.Next:= ele;
until false;
ControlSpiska(Nac,Ima);
end;
Function Poisk(Nac:TElem; Key: integer):PElem;
var ele: PElem;
begin
ele:= Nac.Next; if Pusto(ele) then halt(1);
Repeat
if ele^.GodRojden = Key then
begin
Poisk:= ele; exit; {Образец найден}
end;
ele:= ele^.Next;
until ele = nil;
Poisk:= nil; {Образец не найден}
end;
Procedure Insert1(L,L1: TElem; Naiden: PElem);
var elem,xvost: PElem;
begin
xvost:= Naiden^.Next; {запоминаем адрес элемента, следующего за найденным}
naiden^.Next:= L1.Next; {переключаем: теперь найденный элемент указывает на
начало списка L1}
elem:= naiden^.Next; {elem указывает туда же}
while elem^.next <> nil do {проходим по списку L1 до его конца}
elem:= elem^.next;
elem^.next:= xvost; {подкючаем к последнему элементу списка L1 элементы, располагавшиеся
ранее следом за найденным}
end;
begin { ************* Начало главной программы ************** }
VvodSpiska(NacaloL, 'L');
VvodSpiska(NacaloL1, 'L1');
if Pusto(NacaloL.Next) then halt(1);
write('Задай элемент Е значением его поля .GodRojden -> ');
readln(GR);
Iskomii:= Poisk(NacaloL,GR);
if Iskomii = nil then
begin
writeln('Элемент отсутствует, вставка не производится');
end else
begin
Insert1(NacaloL,NacaloL1,Iskomii);
writeln(' --- Список вставлен. Контроль:');
ControlSpiska(NacaloL,'L');
end;
textattr:= $07; clrscr;
end.