[Abikutin]

Очередь через односвязные списки.

Код:

type
Tinfo=record
FamIO, Nazv: string[20];
Year: integer;
end;

PElem=^TElem;
  TElem=record
          Info: TInfo;
          Next: PElem;
  End;

TOcher = record
First, Last : PElem; //Указатели на первый и на последний элемент очереди.
end;

Процедура добавления в конец.

Код:

procedure AddLast(var Ocher: TOcher; var Data : TInfo);
var NewElem:PElem;
begin
new(NewElem);
NewElem^.Info := Data;
NewElem^.Next := Ocher.First;
Ocher.first := NewElem;
end;

Проверка на пустоту очереди

Код:

function IsEmpty(var Ocher: TOcher): Boolean;
begin
if (Ocher.First = nil) then
Result := true
else
Result := false;
End;

Процедура удаления с начала.

Код:

procedure DelFirst(var Ocher: TOcher); //удаление(первого)
begin
if IsEmpty(Ocher) then Ocher.Last:=nil
else
Ocher.First:=Ocher.First.Next;
end;

Процедура перебора элементов

Код:

Procedure Pereklad(var Ocher1, Ocher2:TOcher);
var Info:TInfo;
begin
  Info:=Ocher1.first.Info;
  AddLast(Ocher2,Info);
  DelFirst(Ocher1);
end;

Кнопка добавления в очередь

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
r:TInfo;
begin
r.FamIO:=Edit1.Text;
r.Nazv:=Edit2.Text;
r.Year:=StrToInt(Edit3.Text);
if (Edit1.text<>'') and (Edit2.text<>'') and (Edit3.text<>'') then
AddLast(Ocher,r);

end;

Кнопка вывода в список(в Лист Бокс)

Код:

procedure TForm1.Button4Click(Sender: TObject);
var DopOcher:TOcher;
begin
OcherInit(DopOcher);
List.Items.Clear;
If IsEmpty(Ocher) then List.Items.Add('(пусто)');

while not IsEmpty(Ocher) do
begin;
List.Items.Add(Ocher.First.Info.FamIO +'       '+ Ocher.First.Info.Nazv +'             '+ IntToStr(Ocher.First.Info.Year));
  Pereklad(Ocher,DopOcher);
end;
while not IsEmpty(DopOcher) do
begin;
  Pereklad(DopOcher,Ocher);
end;

end;

в итоге добавляет , но в начало. Как изменить так, чтобы добавлял в конец?

[Alegun]

Сообщение от Abikutin

...Процедура добавления в конец.

Код:

procedure AddLast(var Ocher: TOcher; var Data : TInfo);
var NewElem:PElem;
begin
new(NewElem);
NewElem^.Info := Data;
NewElem^.Next := Ocher.First;
Ocher.first := NewElem;
end;

...

First - это первый, Last последний, не тот указатель используется, скорее всего из-за этого

[Abikutin]

К сожалению, нет.
Если я меня 7ую строчку на Ocher.Last , то вылетает ошибка

Access violation at adress 004533E8 in module 'Project1.exe'. Write of address 00429F48

При прохождении процедуры перекладывания очереди.

[Alegun]

Пытаюсь повторить, OcherInit() - что за процедура, без неё добавляется дубль записей, и затем вылетает с ошибкой в перекладе на инициализации переменной Info

[Abikutin]

А, забыл её выложить.

Код:

procedure OcherInit(var Ocher : TOcher);
begin
  Ocher.First := nil;
  Ocher.Last := nil;
end;

используется ещё вот здесь

Код:

var Ocher: TOcher;
procedure TForm1.FormCreate(Sender: TObject);
begin
OcherInit(Ocher);
end;

[Abikutin]

Вот вся программа, но там ещё несколько пока что не доделанных процедур есть...

[Alegun]

Только сейчас дошло - вы объявили тип записи (рекорда) элементом односвязного списка по принципу sll, а предпологаете от него функционал двухсвязного dll, для реализации такого требуется небольшая переделка. Подробности здесь