{Вариант 18. Построить линейный список из фамилий. Удалить из него самую
длинную фамилию. Используется текстовый файл, в котором в столбик записано 10
фамилий в алфавитном порядке}
- Код: Выделить всё
Program Spisok;
uses
crt;
type
Tinf=string[20]; {тип данных, который будет храниться в элементе стека}
List=^TList; {Указатель на элемент типа TList}
TList=record {динамическая структура через запись}
data:TInf; {данные, хранимые в элементе}
next:List; {указатель на следующий элемент}
end;
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var Spisok:List;family:Tinf);
var
tmp:List;
begin
if Spisok=nil then {Проверяем не пуст ли список, если пуст, то }
begin
GetMem(Spisok,sizeof(TList));
tmp:=Spisok;
end
else {в случае если список не пуст}
begin
tmp:=Spisok;
while tmp^.next<>nil do
tmp:=tmp^.next; {ставим tmp на последний элемент списка}
GetMem(tmp^.next,sizeof(TList));
tmp:=tmp^.next; {переносим tmp на новый элемент}
end;
tmp^.next:=nil; {зануляем указатель}
tmp^.data:=family; {заносим значение}
end;
{процедура печати списка}
procedure Print(Spisok:List);
begin
while Spisok<>nil do
begin
Write(Spisok^.data, ' ');
Spisok:=Spisok^.next
end;
end;
{Процедура поиска наибольшого значения (длины строки) в списке}
Function SearchMax(Spisok:List):integer;
var
len:integer;
begin
len:=0;
if Spisok<>nil then
while (Spisok<>nil) do
begin
if len<=Length(Spisok^.data) then
len:= Length(Spisok^.data);
Spisok:=Spisok^.next;
end;
SearchMax:=len;
end;
{Процедура удаления соответствующих значений}
Procedure DelElem(Spisok:List;tmp:List);
var
tmpi:List;
begin
if tmp=Spisok then {если мы удаляем элемент который является первым элементом, то}
begin
//Writeln(tmp^.data);
Spisok:=tmp^.next;{следует перенести вершину}
FreeMem(tmp,SizeOf(TList));
end
else {если мы удаляем элемент который не является первым элементом, то}
begin
tmpi:=Spisok; {ставим указатель на вершину списка}
while tmpi^.next<>tmp do {доходим до элемента стоящего "перед" тем, который нам следует удалить}
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next; {указатель элемента переносим на следующий элемент за удаляемым}
FreeMem(tmp,sizeof(TList)); {удаляем элемент}
end;
end;
{Процедура передачи указателей на элементы подлежащие удалению}
Procedure DelElemPos(Spisok:List;len:integer);
var
lenMax:integer;
tmp:List;
begin
tmp:=Spisok;
while (tmp<>nil) do
begin
lenMax:=Length(tmp^.data);
if lenMax=len then
begin
Writeln('Элемент - ' + tmp^.data + ' удален');
DelElem(Spisok,tmp);
end;
tmp:=tmp^.next;
end;
end;
var
Spis:List;
fam:string[20];
myFile:text;
begin
Spis:=nil;
assign(myFile, 'myFile.txt');
reset(myFile);
while not eof(myFile) do
begin
readln(myFile, fam);
AddElem (Spis,fam);
end;
close(myFile);
writeln('Список до обработки: ');
Print(Spis);
Writeln;
DelElemPos(Spis, SearchMax(Spis));
writeln('Список после обработки: ');
Print(Spis);
readln;
end.