Списки: Распечатайте слова, имеющие максимальную длину

type
  //Тип основных данных списка.
  TData = String;
  //Тип указателя на элемент списка.
  TPElem = ^TElem;
  //Тип элемента списка.
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
  //Тип, описывающий однонаправленный список.
  TDynList = record
    PFirst : TPElem; //Указатель на первый элемент списка.
    PLast : TPElem; //Указатель на последний элемент списка.
  end;
 
//Процедуры для работы со списком.
 
//Инициализация списка. Внимание! Эту процедуру можно выполнять только
//в отношении пустого списка. Иначе - будут утечки памяти.
procedure Init(var aList : TDynList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Добавление элемента в конец однонаправленного списка.
procedure AddL(var aList : TDynList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
end;
 
//Удаление однонаправленного списка из памяти и инициализация.
procedure ListFree(var aList : TDynList);
var
  PNext, PDel : TPElem;
begin
  if aList.PFirst = nil then Exit;
 
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;
 
//Распечатка однонаправленного списка.
function ListToStr(const aList : TDynList) : String;
var
  PElem : TPElem;
  i : Integer;
begin
  Result := '';
  if aList.PFirst = nil then begin
    Result := 'Список пуст.';
    Exit;
  end;
 
  PElem := aList.PFirst;
  i := 0;
  while PElem <> nil do begin
    Inc(i);
    if i > 1 then Result := Result + ', ';
    Result := Result + PElem^.Data;
    PElem := PElem^.PNext;
  end;
end;
 
//Разбиение текста на слова, добавление их в список и подсчёт наибольшей длины слов.
function ProcStr(const aStr : String; var aList : TDynList) : Integer;
const
  //Множество разделителей слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  i, Len, LenW : Integer;
begin
  Result := 0;
  Len := Length(aStr);
  LenW := 0;
  for i := 1 to Len do begin
    //Пропуск разделителей.
    if aStr[i] in D then Continue;
    //Учитываем очередной символ в длине слова.
    Inc(LenW);
    //Отслеживаем конец слова.
    if (i = Len) or (aStr[i + 1] in D) then begin
      //Выделяем слово и добавляем его в список.
      AddL(aList, Copy(aStr, i - LenW + 1, LenW));
      //Уточняем сведения о наибольшей длине слов.
      if LenW > Result then Result := LenW;
      //Сброс длины слова.
      LenW := 0;
    end;
  end;
end;
 
//Обработчики нажатий кнопок на форме.
 
procedure TForm1.Button1Click(Sender: TObject);
const
  Fn = 'file.txt';
var
  F : TextFile;
  List : TDynList;
  PElem : TPElem;
  S, FileName : String;
  Len, LenMax : Integer;
begin
  //Полное имя файла. Файл должен располагаться в той же папке,
  //где лежит исполняемый файл программы.
  FileName := ExtractFilePath(ParamStr(0)) + Fn;
  //Проверка существования файла.
  if not FileExists(FileName) then begin
    MessageBox(
      0
      ,'Файл с именем "' + Fn + '" не найден. Действие отменено.'
      ,'Внимание!'
      ,MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL
    );
    Exit;
  end;
 
  //Начальная инициализация списка.
  Init(List);
  //Построчное чтение из файла, разбиение на слова, запись их в список и подсчёт
  //наибольшей длины слов.
  AssignFile(F, FileName);
  Reset(F);
  LenMax := 0;
  while not Eof(F) do begin
    Readln(F, S);
    Len := ProcStr(S, List);
    if Len > LenMax then LenMax := Len;
  end;
  CloseFile(F);
 
  Memo1.Lines.Add('------------------------------');
  if LenMax = 0 then begin //Или так: if List.PFirst = nil then begin
    Memo1.Lines.Add('В файле нет слов.');
    //В этом случае список пуст и удалять его из памяти не требуется.
    Exit;
  end;
  Memo1.Lines.Add('Наибольшая длина слов: ' + IntToStr(LenMax));
  Memo1.Lines.Add('Список слов, прочитанных из файла:');
  Memo1.Lines.Add(ListToStr(List));
 
  //Распечатка самых длинных слов.
  Memo1.Lines.Add('----------');
  Memo1.Lines.Add('Список слов с наибольшей длиной:');
  S := '';
  PElem := List.PFirst;
  while PElem <> nil do begin
    if Length(PElem^.Data) = LenMax then begin
      if S <> '' then S := S + ', ';
      S := S + PElem^.Data;
    end;
    PElem := PElem^.PNext;
  end;
  Memo1.Lines.Add(S);
 
  //Удаление списка из памяти.
  ListFree(List);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Str: TStringList;
  x, i: Integer;
  s: String;
begin
  Str := TStringList.Create;
  Str.LoadFromFile('0.txt');
  x := 0;
    for i := 0 to Str.Count - 1 do
      begin
        if Length(Str.Strings[i]) > x then x := Length(Str.Strings[i])
      end;
    for i := 0 to Str.Count - 1 do
      begin
        if Length(Str.Strings[i]) = x then s := s + Str.Strings[i] + #13#10;
      end;
  Str.Free;
  ShowMessage(s);
end;

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
type
TE=string;
Li=^Elem;
Elem=Record
     inf:string;
     next:Li;
     end;
Var f:text;
 st:string; {st1:array [1..255] of string;  }
 a:array [1..255] of integer; 
 ch:char;
 bl:boolean;
 i,j,max:integer;
 st1:Li;
begin
  Assign (f,'my.txt');
  //rewrite (f);
  bl:=true;
  {while (bl=true) do
  begin
  read (st);
  writeln (f,st);
  if st[length (st)]='.' Then bl:=false;
  end;    }
  max:=1;
  i:=0;
 // closefile(f);
  reset (f);
  while not(EOF(f)) do
  begin
 { while not (EOLN(f)) do
  begin  }
  i:=i+1;
  a[i]:=0;
 { st1[i]:='';}
  read (f,ch);
 
  while (ch<>' ') and not((EOLN(f))) do
  begin
  st1[i]:=st1[i]+ch;
  a[i]:=a[i]+1;
  read(f,ch);
  end;
 
    end;
     st1[i]:=st1[i]+ch;
     a[i]:=a[i]+1;
 
  for j:=1 to i do
  begin
  If a[j]>a[max] Then max:=j;
  end;
  //  end;
 
  write (st1[max]);
 
  readln;
end.