program Lab3; // один параметр - имя текстового файла
{$APPTYPE CONSOLE}
uses
//SysUtils,
// Windows,
UnList in 'UnList.pas', // подключаем модули с типами и процедурами, а затем и с переменными
UnVar in 'UnVar.pas';
// добавить элемент со значением R в соответствии с заданным порядком в список
procedure AddR(var ListN, ListK: PElem; r: TInfo); // адреса начала и конца списка и R
begin
if ListN = nil then CreateList(ListN, ListK, r) // если список пуст
else
if (UpCase(r) = 'A') or (UpCase(r) = 'E') or (UpCase(r) = 'I') or (UpCase(r) = 'O') or (UpCase(r) = 'U') or (UpCase(r) = 'Y') then
AddFirst(ListN, ListK, r) // добавить в начало
else
AddLast(ListN, ListK, r); // добавить в конец
end;
// "Добавить псевдослучайные N элементов" в текущий список
procedure AddN;
var n,i: integer; s:string; r: TInfo;
begin
write('Сколько N=?'); readln(s);
if not TryStrToInt(s,n) then n:=1;
for i:=1 to n do
begin
r := chr(33 + Random(32));
AddR(NachaloSpiska, KonecSpiska, r);
end;
end;
// Добавление всех данных из текстового файла в текущий список
procedure AddFromTextFile;
var
f: TextFile;
r: TInfo;
begin
if ParamCount=1 then writeln('Введите элементы и Ctrl+Z') ;
AssignFile(f, ParamStr(1));
try
Reset(f);
try
try
while not eof(f) do
begin
readln(f, r);
AddR(NachaloSpiska, KonecSpiska,r);
end;
writeln('Список создан');
except
writeln('Некорректные данные в текстовом файле '+ ParamStr(1));
end;
finally
CloseFile(f);
end;
except
writeln('Не удалось открыть текстовый файл '+ ParamStr(1));
end;
end;
// Добавить один элемент в текущий список
procedure Add1;
var
r: TInfo;
begin
try
write('введите символ (знак препинания или латиницы) R=?'); readln(r);
AddR(NachaloSpiska, KonecSpiska, r);
except
writeln('Некорректный символ или ошибка добавления');
end;
end;
// "Найти в списке"
procedure SearchIt;
var
ListC: PElem;
count: integer;
flag: boolean;
begin
count := 0;
flag := false;
ListC:=NachaloSpiska;
while (ListC<>nil) and not flag do // или while (ListC<>nil) and not flag do
begin
Inc(count);
if ListC^.info = '.' then
flag := true;
ListC:=ListC^.next;
end;
if flag then
writeln('Номер первого символа "." в списке: ', count)
else
writeln('Символ "." не найден в списке');
end;
// "Что сейчас в списке?" - вывод на экран консоли
procedure ViewList;
var
ListC: PElem;
begin
writeln('Список:');
ListC:=NachaloSpiska;
if ListC=nil then writeln('Пустой');
while ListC<>nil do
begin
writeln(ListC^.info:5);
ListC:=ListC^.next;
end;
end;
//--------------------главная программа-------------------------
var
ch: char;
begin
//SetConsoleCP(1251); // из модуля Windows
//SetConsoleOutputCP(1251);
{ Для того, чтобы каждый раз при запуске программы генерировалась
НОВАЯ последовательность псевдослучайных чисел.
Одна и та же последовательность удобна для отладки программы. }
Randomize;
repeat
writeln('--------------------------------------');
writeln('Q - добавить в список из текстового файла; ');
writeln('W - сгенерировать и добавить в список; ');
writeln('E - добавить в список; ');
writeln('R - найти в списке;');
writeln('T - удалить(очистить) список;');
writeln('Y - просмотр;');
writeln('U - конец.');
write('Ваш выбор?'); readln(ch);
writeln('--------------------------------------');
ch:= UpCase(ch);
case ch of
//----------создать список из текстового файла------------------
'Q': AddFromTextFile;
//----------сгенерировать список -------------------------------
'W': AddN;
//----------добавить в список ----------------------------------
'E': Add1;
//-----------поиск----------------------------------------------
'R': SearchIt;
//-----------освобождение памяти--------------------------------
'T': FreeList(NachaloSpiska, KonecSpiska);
//-----------просмотр----------------------------------------------
'Y': ViewList;
//-----------выход----------------------------------------------
'U': exit;
//--------------------------------------------------------------
else
begin
writeln('Нет такой команды');
write('Press ENTER'); readln;
end;
end;
until ch='U';
end.
Код (Модуль UnList):
unit UnList;
interface
type
TInfo = char;
PElem = ^TElem;
TElem = record
info: TInfo;
next: PElem;
end;
// создать список из одного элемента
procedure CreateList(var ListN, ListK: PElem; r: TInfo);
// добавить новый элемент перед первым
procedure AddFirst(var ListN: PElem; ListK: PElem; r: TInfo);
// добавить новый элемент в конец списка
procedure AddLast(ListN: PElem; var ListK: PElem; r: TInfo);
// добавить новый элемент в середину после ListC (не в конец)
procedure AddMedium(ListN,ListC,ListK: PElem; r: TInfo);
// очистить список
procedure FreeList(var ListN, ListK: PElem);
implementation
// создать список из одного элемента
procedure CreateList(var ListN, ListK: PElem; r: TInfo);
begin
New(ListN);
ListK:=ListN; // конец и начало совпадают
ListN^.info:=r;
ListN^.next:=nil;
end;
// добавить новый элемент перед первым
procedure AddFirst(var ListN: PElem; ListK: PElem; r: TInfo);
var Elem: PElem;
begin
new(Elem);
Elem^.info:=r;
Elem^.next:=ListN;
ListN:=Elem; // теперь он 1-ый
end;
// добавить новый элемент в конец
procedure AddLast(ListN: PElem; var ListK: PElem; r: TInfo);
begin
new(ListK^.next);
ListK^.next^.info:=r;
ListK^.next^.next:=nil;
ListK:= ListK^.next;
end;
// добавить новый элемент в середину после ListC (не в конец)
procedure AddMedium(ListN,ListC,ListK: PElem; r: TInfo);
var Elem: PElem;
begin
new(Elem);
Elem^.info:=r;
Elem^.next:=ListC^.next; // после него то, что было после ListC
ListC^.next:=Elem; // а он сам после ListC
end;
// очистить список
procedure FreeList(var ListN, ListK: PElem);
var Elem: PElem;
begin
Elem:=ListN;
while Elem<>nil do
begin
ListN:=ListN^.next;
Dispose(Elem);
Elem:=ListN;
end;
ListK:=nil;
end;
end.
Код (Модуль UnVar):
unit UnVar;
interface
uses UnList; // описание типа и все процедуры
var NachaloSpiska, KonecSpiska: PElem; // начало и конец списка
implementation
// пусто
initialization
NachaloSpiska:=nil; // инициализация переменных
KonecSpiska:=nil;
finalization
FreeList(NachaloSpiska, KonecSpiska); // освобождение памяти
end.