Memo1.Lines.Add('3. На листе формата А4, опишите ход проделанной работы.');
Memo1.Lines.Add(' Ответьте на поставленные вопросы:');
Memo1.Lines.Add(' 1) Как удаляется и добавляется элементы в дек?');
Memo1.Lines.Add(' 2) В чем сходны и различны дек, стек и двунаправленный список?');
end;
procedure TForm1.N71Click(Sender: TObject);
begin
Memo1.Clear;
Memo1.Lines.Add(' Лабораторная работа №7.');
Memo1.Lines.Add(' "Тест"');
Memo1.Lines.Add('______________________________________________________________');
Memo1.Lines.Add('1. Повторите весь теоретический материал.');
Memo1.Lines.Add('');
Memo1.Lines.Add('2. Поработайте с демонстрационной программой.');
Memo1.Lines.Add('');
Memo1.Lines.Add('3. Запустите тест (сервис\тест или Ctrl + T).');
Memo1.Lines.Add(' Ответьте на поставленные вопросы теста.');
Memo1.Lines.Add('');
Memo1.Lines.Add('4. Результаты теста сообщить преподавателю.');
end;
procedure TForm1.N9Click(Sender: TObject);
begin
Form18.Show;
end;
end.
unit Unit2; //Формирование списков
interface
uses SysUtils, Windows, Dialogs;
type
List = ^Spisok; //Однонаправленный
Spisok = record
Info: Integer;
Next: List;
end;
ListTwo = ^SpisokTwo; //Двунаправленный
SpisokTwo = record
Info: Integer;
Next: ListTwo;
Prev: ListTwo;
end;
procedure CreateLists;
procedure AddToList(X: Integer; var PointerEndList: List);
procedure AddToListAfterPos(X: Integer; Position: Integer);
procedure DeleteFromList(Position: Integer);
procedure AddToListTwo(X: Integer; var PointerEndListTwo: ListTwo);
procedure AddToListTwoAfterPos(X: Integer; Position: Integer);
procedure DeleteFromListTwo(Position: Integer);
procedure AddToQueue(X: Integer; var PointerEndQueue: List);
procedure AddToEndQueue(X: Integer);
function GetQueue(var PointerBegin: List): Integer;
procedure AddToStack(X: Integer; var PointerStack: List);
function GetStack(var PointerStack: List): Integer;
procedure AddToDeck(X: Integer;
var PointerDeckBegin, PointerDeckEnd: ListTwo; Flag: Integer);
function GetDeckBegin(var PointerDeckBegin: ListTwo): Integer;
function GetDeckEnd(var PointerDeckEnd: ListTwo): Integer;
procedure DestroyList(PointerBegin: List);
procedure DestroyListTwo(PointerBegin: ListTwo);
procedure AddToRoundList(X: Integer; var PointerRoundList: List);
procedure DeleteFromRoundList(Position: Integer);
procedure DestroyRoundList(var PointerRoundList: List);
implementation
uses Unit1;
procedure DestroyList(PointerBegin: List);
var
q: List;
begin
while PointerBegin <> nil do
begin
q := PointerBegin;
PointerBegin := PointerBegin^.Next;
if q <> nil then Dispose(q);
end;
end;
procedure DestroyListTwo(PointerBegin: ListTwo);
var
q: ListTwo;
begin
while PointerBegin <> nil do
begin
q := PointerBegin;
PointerBegin := PointerBegin^.Next;
if q <> nil then Dispose(q);
end;
end;
procedure DestroyRoundList(var PointerRoundList: List);
var
q, t: List;
begin
q := PointerRoundList^.Next;
PointerRoundList^.Next := nil;
while q <> nil do
begin
t := q;
q := q^.Next;
if t <> nil then Dispose(t);
end;
PointerRoundList := nil;
end;
procedure AddToList(X: Integer; var PointerEndList: List); //Добавить элемент в
//конец списка (PointerEnd - указатель на последний элемент списка)
begin
ifPointerEndList = nilthen // Если первый элемент еще не существует
begin
New(PointerEndList);
PointerEndList^.Info := X;
PointerEndList^.Next := nil;
end
else
begin
New(PointerEndList^.Next);
PointerEndList := PointerEndList^.Next;
PointerEndList^.Info := X;
PointerEndList^.Next := nil;
end;
end;
procedure AddToListAfterPos(X: Integer; Position: Integer);
var //Добавить элемент в список после Position
i: Integer;
q, qNew: List;
begin
ifPosition = 0 then // Если позиция = 0, то добавляем в начало
begin
New(qNew);
qNew^.Info := X;
qNew^.Next := ListBegin;
ListBegin := qNew;
end
else
begin
q := ListBegin;
i := 0;
while (i < Position) and (q <> nil) do // Ищем элемент после которого
// нужно вставить
begin
q := q^.Next;
Inc(i);
end;
ifq <> nilthen // Если элемент существует то вставляем
begin
New(qNew);
qNew^.Info := X;
qNew^.Next := q^.Next;
q^.Next := qNew;
end
elseShowMessage('Элемент, после которого хотите вставить, удален');
end;
end;
procedure AddToRoundList(X: Integer; var PointerRoundList: List);
var qRound: List;
begin
if PointerRoundList = nil then
begin
New(PointerRoundList);
PointerRoundList^.Info := X;
PointerRoundList^.Next := PointerRoundList;
RoundList := PointerRoundList;
end
else
begin
New(qRound);
qRound^.Info := X;
qRound^.Next := PointerRoundList^.Next;
PointerRoundList^.Next := qRound;
end;
PointerRoundList := PointerRoundList^.Next;
end;
procedure DeleteFromRoundList(Position: Integer);
var
q, h: List;
i: Integer;
begin
if RoundList^.Next = RoundList then //один элемент в списке
begin
if RoundList <> nil then Dispose(RoundList);
RoundList := nil;
end
else // не один элемент в списке
begin
i := 1;
q := RoundList;
while i < RoundListPos do
begin
Inc(i);
q := q^.Next;
end;
if i <> 1 then
begin
h := q^.Next;
q^.Next := h^.Next;
if h <> nil then Dispose(h);
end
else
begin
q := RoundList^.Next;
while q^.Next <> RoundList do q := q^.Next;
h := q^.Next;
q^.Next := h^.Next;
if h <> nil then Dispose(h);
RoundList := q^.Next;
end;
end;
if RoundList <> nil then
begin
q := RoundList^.Next;
i := 1;
while q <> RoundList do
begin
Inc(i);
q := q^.Next;
end;
if i = RoundListPos then
begin
RoundListPos := 0;
Form1.Image7.Left := 9;
end;
end;
end;
procedure DeleteFromList(Position: Integer); //Удаляет элемент под
//номером Position
var
i: Integer;
q, r: List;
begin
q := ListBegin;
ifq <> nilthen // Если список не пуст, то
begin
ifPosition = 0 then //Если позиция = 0, то удаляем первый элемент
begin
ListBegin := q^.Next;
if q <> nil then Dispose(q);
end
else
begin
i := 0;
while (i < Position - 1) and (q <> nil) do //Ищем элемент после
//которого нужно удалить
begin
q := q^.Next;
Inc(i);
end;
r := q^.Next;
ifr <> nilthen //Если удаляемый элемент существует, то удаляем его
begin
q^.Next := r^.Next;
if r <> nil then Dispose(r);
end
elseShowMessage('Элемент уже не существует');
end;
end
else
begin
ShowMessage('Список пуст');
Form1.Image1.Hide;
end;
end;
procedure AddToListTwo(X: Integer; var PointerEndListTwo: ListTwo); //Добавить элемент в
//конец дв-списка (PointerEnd - указатель на последний элемент списка)
begin
ifPointerEndListTwo = nilthen //Если список еще не существует или пуст,
//добавляем в начало
begin
New(PointerEndListTwo);
PointerEndListTwo^.Info := X;
PointerEndListTwo^.Next := nil;
PointerEndListTwo^.Prev := nil;
end
else
begin
New(PointerEndListTwo^.Next);
PointerEndListTwo := PointerEndListTwo^.Next;
PointerEndListTwo^.Info := X;
PointerEndListTwo^.Next := nil;
PointerEndListTwo^.Prev := nil;
end;
end;
procedure AddToListTwoAfterPos(X: Integer; Position: Integer);
var //Добавить элемент в двунап. список после Position
i: Integer;
q, qNew: ListTwo;
begin
ifPosition = 0 then //Если позиция = 0, вставляем в начало
begin
New(qNew);
qNew^.Info := X;
qNew^.Next := ListTwoBegin;
ListTwoBegin := qNew;
end
else
begin
q := ListTwoBegin;
i := 0;
while (i < Position) and (q <> nil) do //Ищем элемент после которого
//нужно вставить
begin
q := q^.Next;
Inc(i);
end;
ifq <> nilthen // Если элемент существует то вставляем
begin
New(qNew);
qNew^.Info := X;
qNew^.Next := q^.Next;
qNew^.Prev := q;
q^.Next := qNew;
end
elseShowMessage('Элемент, после которого хотите вставить, удален');
end;
end;
procedure DeleteFromListTwo(Position: Integer); //Удаляет элемент
//под номером Position
var
i: Integer;
q, r: ListTwo;
begin
q := ListTwoBegin;
ifq <> nilthen //Если удаляемый элемент существует, то
begin
ifPosition = 0 then //Если позиция = 0, то удаляем первый элемент
begin
ListTwoBegin^.Prev := nil;
ListTwoBegin := q^.Next;
if q <> nil then Dispose(q);
end
else
begin
i := 0;
while (i < Position - 1) and (q <> nil) do //Ищем элемент
// после которого нужно удалить
begin
q := q^.Next;
Inc(i);
end;
r := q^.Next;
ifr <> nilthen //Если он существует, то удаляем его
begin
if r^.Next <> nil then r^.Next^.Prev := q;
q^.Next := r^.Next;
if r <> nil then Dispose(r);
end
elseShowMessage('Элемент уже не существует');
end;
end
else
begin
ShowMessage('Список пуст');
Form1.Image2.Hide;
end;
end;
procedure AddToQueue(X: Integer; var PointerEndQueue: List); //Добавить элемент
//в конец очереди (PointerEnd - указатель на последний элемент очереди)
begin
ifPointerEndQueue = nilthen //Если очередь еще не существует или пуста
//добавляем в начало
begin
New(PointerEndQueue);
PointerEndQueue^.Info := X;
PointerEndQueue^.Next := nil;
end
else
begin
New(PointerEndQueue^.Next);
PointerEndQueue := PointerEndQueue^.Next;
PointerEndQueue^.Info := X;
PointerEndQueue^.Next := nil;
end;
end;
function GetQueue(var PointerBegin: List): Integer; //ф-ия получает элемент из
// очереди и возвращает указатель на начало очереди
var
rQueue: List;
begin
rQueue := PointerBegin;
ifrQueue <> nilthen //Если очередь не пуста
begin
PointerBegin := PointerBegin^.Next;
Result := rQueue^.Info;
if rQueue <> nil then Dispose(rQueue);
end
else
begin
ShowMessage('Очередь пуста');
Form1.Edit3.Text := '';
Form1.Button10.Enabled := False;
Form1.Button11.Enabled := False;
Form1.Button12.Enabled := False;
Form1.Image3.Hide;
end;
end;
procedure AddToEndQueue(X: Integer);
var
Info: Integer;
rQueue, qQueue: List;
FlagList: Boolean;
begin
FlagList := True; //Для выделения первого элемента
qQueue := nil;
rQueue := nil;
whileQueueBegin <> nildo //Ищем указатель на последний элемент очереди
begin
Info := GetQueue(QueueBegin);
AddToQueue(Info, rQueue); //Формируем новую очередь из элементов старой
//очереди, чтобы не потерять ее
if FlagList then /////////////////////////////////////
begin // //
qQueue := rQueue; // формируем указатель на очередь //
FlagList := False; // //
end; // //////////////////////////////////
end;
AddToQueue(X, rQueue);
if qQueue <> nil then QueueBegin := qQueue // определяем указатель на очередь
else QueueBegin := rQueue; //////////////////////////////////
end;
procedure AddToStack(X: Integer; var PointerStack: List); //Добавить элемент в
//стек (PointerStack - указатель на стек)
var
Stacks: List;
begin
if PointerStack = nil then //Если стек пуст, то формируем его
begin
New(PointerStack);
PointerStack^.Info := X;
PointerStack^.Next := nil;
end
else //иначе добавляем элемент
begin
New(Stacks);
Stacks^.Info := X;
Stacks^.Next := PointerStack;
PointerStack := Stacks;
end;
end;
function GetStack(var PointerStack: List): Integer; //ф-ия получает элемент из
// стека и возвращает указатель на стек
var
rStack: List;
begin
rStack := PointerStack;
ifrStack <> nilthen //Если стек еще не пуст
begin
PointerStack := PointerStack^.Next;
Result := rStack^.Info;
if rStack <> nil then Dispose(rStack);
end
else
begin
ShowMessage('Стек пуст');
Form1.Button14.Enabled := False;
Form1.Image4.Hide;
end;
end;
procedure AddToDeck(X: Integer; var PointerDeckBegin, PointerDeckEnd: ListTwo;
Flag: Integer); //Добавить элемент в дек
//PointerDeckBegin - указатель на начало дека
//PointerDeckEnd - указатель на конец дека
var
Decks: ListTwo;
begin
if PointerDeckBegin = nil then //Если дек пуст, то формируем его
begin
New(PointerDeckBegin);
PointerDeckBegin^.Info := X;
PointerDeckBegin^.Next := nil;
PointerDeckBegin^.Prev := nil;
PointerDeckEnd := PointerDeckBegin;
end
else //иначе добавляем элемент
begin
if Flag = 0 then //добавляем в начало
begin
New(Decks);
Decks^.Info := X;
Decks^.Next := PointerDeckBegin;
Decks^.Prev := nil;
PointerDeckBegin^.Prev := Decks;
PointerDeckBegin := Decks;
end
else //добавлям в конец
begin
New(Decks);
Decks^.Info := X;
Decks^.Next := nil;
Decks^.Prev := PointerDeckEnd;
PointerDeckEnd^.Next := Decks;
PointerDeckEnd := Decks;
end;
end;
end;
function GetDeckBegin(var PointerDeckBegin: ListTwo): Integer;
//ф-ия получает элемент из начала дека и возвращает указатель на начало дека.