Разбиение списка на два списка одинаковой длины

program Project1;
 
type
  //Типы для описания списка.
 
  //Тип данных - определяет данные, которые будет содержать каждый элемент списка.
  TData = String;
  //Тип, описывающий элемент списка.
  TPElem = ^TElem;
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
  //Тип, описывающий список.
  TList = record
    PFirst : TPElem;
    PLast : TPElem;
  end;
 
//Процедуры для работы со списком.
 
//Удаление всего списка из памяти и инициализация.
procedure ListFree(var aList : TList);
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;
 
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Добавление элемента в конец списка.
procedure AddL(var aList : TList; const aPElem : TPElem);
begin
  if aPElem = nil then Exit;
 
  aPElem^.PNext := nil;
  if aList.PFirst = nil then begin
    aList.PFirst := aPElem;
    aList.PLast := aPElem;
  end else begin
    aList.PLast^.PNext := aPElem;
    aList.PLast := aPElem;
  end;
end;
 
var
  List1, List2, List3 : TList;
  PElem, PTmp : TPElem;
  i : Integer;
  S : String;
begin
  List1.PFirst := nil;
  List1.PLast := nil;
  List2.PFirst := nil;
  List2.PLast := nil;
  List3.PFirst := nil;
  List3.PLast := nil;
 
  repeat
    Writeln('Задайте первый список из строк.');
    Writeln('Ввод каждой строки завершайте нажатием клавиши Enter.');
    Writeln('Завершить ввод - пустая строка + Enter.');
    repeat
      Write('Строка: ');
      Readln(S);
      if S = '' then Continue;
      New(PElem);
      PElem^.Data := S;
      AddL(List1, PElem);
    until S = '';
 
    //Запись элементов в два других списка.
    PElem := List1.PFirst;
    i := 0;
    while PElem <> nil do begin
      Inc(i);
      PTmp := PElem;
      PElem := PElem^.PNext;
      if i mod 2 = 0 then
        AddL(List2, PTmp)
      else
        AddL(List3, PTmp)
      ;
    end;
    //Все элементы первого списка перенесены в другие списки.
    List1.PFirst := nil;
    List1.PLast := nil;
 
    //Распечатка составленных списков.
 
    Writeln('Второй список:');
    PElem := List2.PFirst;
    while PElem <> nil do begin
      Writeln(PElem^.Data);
      PElem := PElem^.PNext;
    end;
    Writeln;
    Writeln('Третий список:');
    PElem := List3.PFirst;
    while PElem <> nil do begin
      Writeln(PElem^.Data);
      PElem := PElem^.PNext;
    end;
    Writeln;
 
    //Удаление списокв из памяти.
    ListFree(List1);
    ListFree(List2);
    ListFree(List3);
    Writeln('Списки удалены из памяти.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.