Ч2 ИПР2 В5 / ИПР2

{Создать однонаправленную очередь с числами в диапазоне от –50 до +50.
После создания очереди выполнить индивидуальное задание. В конце работы
все очереди должны быть удалены.
5. Удалить из очереди каждый второй элемент.}
{Написана в PascalABC.NET
GetMem = new
FreeMem = dispose}

Program IPW_2;
uses crt;
type
Tinf=integer; // тип данных, который будет храниться в элементе очереди
List=^TList; // Указатель на элемент типа TList
TList=record // Наименование нашего типа "запись"
data:TInf; // Данные, хранимые в элементе
next:List; // Указатель на следующий элемент списка
end;

procedure AddElem(var spis1:List;znach1:TInf); // Процедура добавления нового элемента в очередь
var
tmp:List;
begin
if spis1=nil then // Проверяем не пуст ли список
begin
new(spis1);
tmp:=spis1;
end
else
begin
tmp:=spis1;
while tmp^.next<>nil do
tmp:=tmp^.next; // Ставим tmp на последний элемент списка
new(tmp^.next);
tmp:=tmp^.next; // Переносим tmp на новый элемент
end;
tmp^.next:=nil; // Зануляем указатель
tmp^.data:=znach1; // Заносим значение
end;

procedure Print(spis1:List); // Процедура печати очереди
begin
if spis1=nil then // Проверка наличия элементов
begin
writeln('Очередь пуста.');
exit;
end;
while spis1<>nil do // Пока указатель stek1 не станет указывать в пустоту
begin
Write(spis1^.data, ' '); //Вывод элементов
spis1:=spis1^.next // Перенос указателя вглубь
end;
end;

Procedure FreeStek(spis1:List); // Процедура удаления очереди, очистка памяти
var
tmp:List;
begin
while spis1<>nil do
begin
tmp:=spis1; // Указатель tmp на вершину стека
spis1:=spis1^.next; // Вершину стека перенесём на следующий за данной вершиной элемент
dispose(tmp); // Освобождаем память занятую под старую вершину
end;
end;

Procedure DelElem(var spis1:List;tmp:List); // Процедура удаления элемента по позиции
var
tmpi:List;
begin // Удаляемый элемент на на вершине стека!
tmpi:=spis1; // Ставим указатель на вершину стека
while tmpi^.next<>tmp do // Доходим до элемента стоящего "перед" тем, который нам следует удалить
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next; // Указатель элемента переносим на следующий элемент за удаляемым
dispose(tmp);// Удаляем элемент
end;

Procedure DelElemPos(var spis1:List;posi:integer); // Поиск порядкового номера
var
i:integer;
tmp:List;
begin
i:=1; // Счетчик позиции
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do // Пока tmp не укажет в "пустоту" или мы не найдём искомый элемент
begin
tmp:=tmp^.next; // Переходим на следующий элемент
inc(i) // Увеличиваем значение счётчика
end;
DelElem(spis1,tmp); // Переход к процедуре удаления элемента

end;


var
Spis,spis1,tmpl:List;
znach,i,j,t,N:integer;
ch:char;
begin
Spis:=nil;
repeat
clrscr;
Writeln('Выберите желаемое действие:');
Writeln('1. Добавить в очередь число от -50 до +50.');
Writeln('2. Добавить N рандомных чисел в очередь от -50 до +50.');
Writeln('3. Удалить из очереди каждый второй элемент.');
Writeln('4. Просмотреть очередь.');
Writeln('5. Выход (очистка очереди).');
writeln;
ch:=readkey;
case ch of
'1':begin // Добавление 1 числа
write('Введите значение добавляемого элемента(от -50 до +50): ');
readln(znach);
if (znach<(-50)) or (znach>+50) then
repeat
writeln ('Введенно неправильное значение!');
writeln ('Введите значение от -50 до +50:');
readln(znach);
until (znach>=(-50)) and (znach<=+50);
AddElem(Spis,znach);
end;
'2':begin // Добавление нескольких рандомных числе
randomize;
Writeln ('Введите колличество добавляемых числе N:');
readln(N);
for i:=1 to N do
begin
znach:=random(100)-50;
AddElem(Spis,znach);
end;
write('Значания введены!');
readkey;
end;
'3': begin // Удаление каждого второго элемента
spis1:=spis;
while spis1<>nil do
begin
inc(j); // Счетчик числа элементов в очереди
spis1:=spis1^.next
end;
if j=0 then begin // Проверка наличия элементов
writeln('Очередь пустa.');
readkey;
end;
if j=1 then begin // Если нет 2 элемента
writeln ('Очередь содержит всего 1 элемент');
j:=0;
readkey;
end;
if j>1 then
begin
t:= (j div 2); // Порядковые номера удаляемых элементов
znach:=2;
for i:=1 to t do
begin
DelElemPos(Spis,znach);
inc(znach);
end;
Writeln ('Элемент(ы) удалены!');
readkey;
j:=0;
end;
end;
'4':begin // Просмотр очереди
clrscr;
Print(Spis);
readkey;
end;

end;
until ch='5';
FreeStek(Spis); // Очистка памяти
end.