Создать двухсвязной список

type
  (*Указатель на элемент списка.*)
  TPRec = ^TRec;
  (*Элемент списка.*)
  TRec = record
    Num : Integer;
    Next : TPRec;
    Prev : TPRec;
  end;
 
const
  (*Количество элементов в первом списке.*)
  N = 10;
var
  (*Указатель на первый элемет списка для 1, 2, и 3 списка.*)
  B1, B2, B3 : TPRec;
  (*Указатель на последний элемет списка для 1, 2, и 3 списка.*)
  E1, E2, E3 : TPRec;
  (*Указатель на текущий элемент списка.*)
  Cur, Tmp : TPRec;
  (*Счётчик для циклов.*)
  i : Integer;
begin
  B1 := nil;
  E1 := nil;
  B2 := nil;
  E2 := nil;
  B3 := nil;
  E3 := nil;
 
  (*Создаём первый список из N элементов и записываем в его элементы случайные числа.*)
  Randomize;
  for i := 1 to N do begin
    (*Выделяем память для нового элемента списка.*)
    New(Tmp);
    (*Встраиваем новый элемент в список.*)
    if B1 = nil then begin
      (*Если список пока пуст.*)
      B1 := Tmp;
      E1 := Tmp;
      Tmp^.Prev := nil;
      Tmp^.Next := nil;
    end else begin
      (*Если список уже не пуст.*)
      E1^.Next := Tmp;
      Tmp^.Prev := E1;
      Tmp^.Next := nil;
      E1 := Tmp;
    end;
    (*Записываем случайное число в элемент списка.*)
    Tmp^.Num := -50 + Random(101); (*-50..50*)
  end;
 
  (*Перебираем элементы первого списка.*)
  Cur := B1;
  while Cur <> nil do begin
    if Cur^.Num >= 0 then begin
      (*Добавляем элемент во второй список.*)
 
      (*Выделяем память для нового элемента списка.*)
      New(Tmp);
      (*Встраиваем новый элемент в список.*)
      if B2 = nil then begin
        (*Если список пока пуст.*)
        B2 := Tmp;
        E2 := Tmp;
        Tmp^.Prev := nil;
        Tmp^.Next := nil;
      end else begin
        (*Если список уже не пуст.*)
        E2^.Next := Tmp;
        Tmp^.Prev := E2;
        Tmp^.Next := nil;
        E2 := Tmp;
      end;
      (*Копируем число из элемента первого списка в элемет второго списка.*)
      Tmp^.Num := Cur^.Num;
    end else begin
      (*Добавляем элемент в третий список.*)
 
      (*Выделяем память для нового элемента списка.*)
      New(Tmp);
      (*Встраиваем новый элемент в список.*)
      if B3 = nil then begin
        (*Если список пока пуст.*)
        B3 := Tmp;
        E3 := Tmp;
        Tmp^.Prev := nil;
        Tmp^.Next := nil;
      end else begin
        (*Если список уже не пуст.*)
        E3^.Next := Tmp;
        Tmp^.Prev := E3;
        Tmp^.Next := nil;
        E3 := Tmp;
      end;
      (*Копируем число из элемента первого списка в элемет третьего списка.*)
      Tmp^.Num := Cur^.Num;
    end;
 
    (*Переходим к следующему элементу первого списка.*)
    Cur := Cur^.Next;
  end;
 
  (*Распечатка списков.*)
 
  Writeln('Elementi spiskov v pryamom poryadke:');
  Writeln;
 
  Write('List1: ');
  Cur := B1;
  while Cur <> nil do begin
    Write(Cur^.Num:4);
    Cur := Cur^.Next;
  end;
  Writeln;
 
  Write('List2: ');
  Cur := B2;
  while Cur <> nil do begin
    Write(Cur^.Num:4);
    Cur := Cur^.Next;
  end;
  Writeln;
 
  Write('List3: ');
  Cur := B3;
  while Cur <> nil do begin
    Write(Cur^.Num:4);
    Cur := Cur^.Next;
  end;
  Writeln;
 
  (*Т. к. списки двунаправленные, продемонстрируем обход списков, начиная
  с конца.
  Выполним на примере распечатки элементов списков в обратном порядке.*)
 
  Writeln;
  Writeln('Elementi spiskov v obratnom poryadke:');
  Writeln;
 
  Write('List1: ');
  Cur := E1;
  while Cur <> nil do begin
    Write(Cur^.Num:4);
    Cur := Cur^.Prev;
  end;
  Writeln;
 
  Write('List2: ');
  Cur := E2;
  while Cur <> nil do begin
    Write(Cur^.Num:4);
    Cur := Cur^.Prev;
  end;
  Writeln;
 
  Write('List3: ');
  Cur := E3;
  while Cur <> nil do begin
    Write(Cur^.Num:4);
    Cur := Cur^.Prev;
  end;
 
  (*Удаление всех трёх списков из памяти.*)
 
  Cur := B1;
  while Cur <> nil do begin
    Tmp := Cur;
    Cur := Cur^.Next;
    Dispose(Tmp);
  end;
 
  Cur := B2;
  while Cur <> nil do begin
    Tmp := Cur;
    Cur := Cur^.Next;
    Dispose(Tmp);
  end;
 
  Cur := B3;
  while Cur <> nil do begin
    Tmp := Cur;
    Cur := Cur^.Next;
    Dispose(Tmp);
  end;
 
  Readln;
end.