Задание
Разработать универсальный контейнер для хранения разнотипных объектов. Обеспечить возможность добавления элементов, отображение информационных полей, группирование разнотипных элементов по данному критерию сортировки данных
Выбор алгоритма решения задачи
Разработаем универсальный контейнер данных, который будет иметь возможность сохранять разнотипные данные.Создадим базовый объект и два разнотипных объекта-потомка(например возьмем круг и треугольник), которые будут иметь по три информационных поля, два из которых будут одинаковые(площадь и цвет - общие; третье поле для круга - радиус, для треугольника - высота).Значение площади, радиуса и высоты генерируются случайно, цвет вводится пользователем. Реализуем возможность группирования разнотипных объектов. Объекты можно будет сгруппировать за цветом. Также прибавим возможность сортировки в двух направлениях за площадью. Программа будет иметь диалоговый интерфейс, и проводить мониторинг памяти.
Описание алгоритма решения задачи
Программа состоит из следующих элементов:
- Главная программа
- Модуль с базовым объектом
- Модуль с объектом типа
- Модуль с объектом типа
- Модуль для хранения и обработки списка объектов
Контейнер данные реализованы в виде двунаправленного списка, одним из полей которого есть указатели на базовый объект. Данные сохраняются в самых объектах, с помощью записей.
Структура объекта:
Pbase=TBase;
TBase=object
constructor Init;
procedure show;virtual;
function znach:byte;virtual;
function znach2:string;virtual;
destructor Done;virtual;
end;
Структура модуля хранения и обработки данных:
prec=trec;
trec=record
prev:prec;
n:integer;
pob:pbase;
next:prec;
end;
procedure append(k:integer);
procedure showobj;
function elem(first:prec;pos:word):prec;
procedure delete;
procedure insertItem(x:prec;k:integer);
function deleteitem(pos:integer):prec;
procedure zamena(i,j:integer);
procedure sort;
procedure grup;
Описание программы
При запуске программы появляется меню.В зависимости от выбора пользователя выполняется определенная операция.
При нажиме «1»:
Выполняется вызов процедуры Append:
В список прибавляется объект первого типа(круг). При истечении ввода записей программа возвращается к главному меню.
При нажиме «2»:
Выполняется вызов процедуры Append:
В список прибавляется объект второго типа(треугольник).При истечении ввода записей программа возвращается к главному меню.
При нажиме «3»:
Выполняется вызов процедуры Delete:
Программа очищает экран(clrscr) и выводит на экран список студентов за их номера. Потом программа предлагает удалить элемент списка и спрашивает номер нужной строки. После удаления элемента со списка программа выходит к главному меню.
При нажиме «4»:
Выполняется вызов процедуры Sort:
Пользователю предлагается избрать направление сортировки.В зависимости от его выбора происходит сортировка списка.Визуально никаких изменений не происходит.Посмотреть на результат сортировки можно при просмотре списка, выбрав для этого соответствующий пункт меню.
При нажиме «5»:
Выполняется вызов процедуры Grup:
Группирования происходит по цвету.Пользователю предлагается ввести цвет для группирования.Потом программа возвращается к главному меню. Посмотреть на результат группирования можно при просмотре списка, выбрав для этого соответствующий пункт меню.
При нажиме «6»:
Выполняется вызов процедуры Vivod:
Программа выводит все элементы списка. При нажатии клавиши enter программа возвращается к главному меню.
При нажиме «7»:
Происходит деинсталляция списка и выход из программы.
Текст программы
1 Главная программа
program obj;
uses
crt, uupr;
var
c:char;
p:pointer;
begin
randomize;
clrscr;
mark(p);
writeln('[Mem: ',MemAvail,' b]'); {проверка свободной памяти}
readln;
clrscr;
new(first); {выделение памяти}
ctr:=0;
repeat
clrscr;
writeln('1 - obj1'); {информационное меню}
writeln('2 - obj2');
writeln('3 - delete');
writeln('4 - sortirovka po ploshadi');
writeln('5 - gruppirovka po colour');
writeln('6 - vivod');
writeln('7 - exit');
c:=readkey;
case c of
'1':append(1);
'2':append(2);
'3':delete;
'4':sort;
'5':grup;
'6':showobj;
'7':begin
release(p) {процедура возврата кучи}
clrscr;
writeln('[Mem: ',MemAvail,' b]'); {проверка свободной памяти}
readln;
exit;
end;
end
until c='7';
end.
2 Базовый объект Ubase
unit Ubase;
interface
type
Pbase=TBase;
TBase=object
constructor Init; {конструктор. Он необходим для инициализации}
procedure show;virtual; {процедура вывода}
function znach:byte;virtual; {функция получения значения}
function znach2:string;virtual; {функция получения значения}
destructor Done;virtual; {деструктор}
end;
implementation
constructor TBase.Init; {конструктор}
begin
end;
procedure TBase.show; {процедура вывода}
begin
end;
function Tbase.znach:byte; {функция получения значения}
begin
end;
function Tbase.znach2:string; {функция получения значения}
begin
end;
destructor Tbase.Done; {деструктор}
begin
end;
end.
3 Объект Uobj01
unit Uobj01;
interface
uses
Ubase, crt;
type
trec1=record {объявление списка}
name:string;
plos:byte;
rad:real;
colour:string;
end;
PObj1=TObj1;
TObj1=object(TBase) {наследник от базового}
public
tt:trec1;
constructor Init;
procedure show; virtual;
function znach:byte;virtual;
function znach2:string;virtual;
destructor Done; virtual;
end;
implementation
constructor TObj1.Init;
begin
inherited init; {при инициализации происходит ввод случайных значений}
tt.name:='KRUG';
tt.plos:=random(99)+1;
tt.rad:=random(10)+random;
writeln('colour?');
readln(tt.colour); {необходимо ввести цвет}
end;
procedure TObj1.show; {процедура вывода}
begin
writeln(tt.name:15,'ploshad:':10,tt.plos:7,'radius:':10,tt.rad:7:2,'colour:':10,tt.colour:10);
end;
function Tobj1.znach; {функция получения значения}
begin
znach:=tt.plos;
end;
function Tobj1.znach2; {функция получения значения}
begin
znach2:=tt.colour;
end;
destructor TObj1.Done; {деструктор}
begin
inherited Done;
end;
end.
4 Объект Uobj02
unit Uobj02;
interface
uses
Ubase, crt;
type
trec2=record {объявление списка}
name:string;
plos:byte;
visota:real;
colour:string;
end;
PObj2=TObj2;
TObj2=object(TBase) {наследник от базового}
public
tt:trec2;
constructor Init;
procedure show; virtual;
function znach:byte;virtual;
function znach2:string;virtual;
destructor Done; virtual;
end;
implementation
constructor TObj2.Init; {при инициализации происходит ввод случайных значений}
begin
inherited init;
tt.name:='TREUGOLNIK';
tt.plos:=random(99)+1;
tt.visota:=random(10)+3;
writeln('colour?');
readln(tt.colour); {необходимо ввести цвет}
end;
procedure TObj2.show; {процедура вывода}
begin
writeln(tt.name:15,'ploshad:':10,tt.plos:7,'visota:':10,tt.visota:7:2,'colour:':10,tt.colour:10);
end;
function Tobj2.znach; {функция получения значения}
begin
znach:=tt.plos;
end;
function Tobj2.znach2; {функция получения значения}
begin
znach2:=tt.colour;
end;
destructor TObj2.Done; {деструктор}
begin
inherited Done;
end;
end.
5 Модуль управления Uupr
unit uupr;
interface
uses
crt,ubase,uobj01,uobj02; {подключение модулей}
type
prec=trec;
trec=record {список}
prev:prec; {указатель на предыдущий список}
n:integer; {номер}
pob:pbase; {данные}
next:prec; {указатель на следующий список}
end;
procedure append(k:integer); {процедура добавления}
procedure showobj; {процедура вывода списка}
function elem(first:prec;pos:word):prec; {функция, которая находит указатель на элемент pos и возвращает его}
procedure delete; {процедура удаления}
procedure insertItem(x:prec;k:integer);
function deleteitem(pos:integer):prec; {функция удаления элемента под номером pos}
procedure zamena(i,j:integer); {процедура замены}
procedure sort; {процедура сортировки}
procedure grup; {процедура группировки}
var
first, glavn:prec;
ctr:integer;
implementation
procedure append(k:integer); {процедура добавления}
var
tec:prec;
kk:integer;
begin
clrscr;
kk:=ctr;
if kk=0 then {если список еще не создан}
begin
ctr:=1;
first.n:=ctr;
first.next:=nil;
first.prev:=nil;
case k of
1: first.pob:=new(pObj1,Init); {создание и добавление к первому объекту }
2: first.pob:=new(pObj2,Init); {создание и добавление к второму объекту }
end;
glavn:=first; {текущий указатель принимает значение первого}
end
else {иначе список существует}
begin
new(tec);
inc(ctr);
tec.prev:=glavn;
tec.n:=ctr;
tec.next:=nil;
glavn.next:=tec;
case k of
1: tec.pob:=new(PObj1,Init); {добавление к первому объекту }
2: tec.pob:=new(PObj2,Init); {добавление к второму объекту }
end;
if ctr=2 then first:=glavn; {если это уже 2-й элемент списка, тогда first = glavn}
glavn:=tec;
end;
end;
procedure showobj; {процедура вывода списка}
var
i:word;
t:prec;
o:pbase;
begin
clrscr;
t:=first;
i:=1;
while i-1<>ctr do {цикл, пока номер не дойдет до последнего}
begin
writeln;
write(t.n); {вывод номера}
o:=t.pob; {в переменную o вноситься список}
o.show; {вывод списка}
t:=t.next; {переход на следующий элемент списка}
inc(i);
end;
readln;
end;
function elem(first:prec;pos:word):prec; {функция перемещения до элемента pos}
var
tec:prec;
i:integer;
begin
tec:=first;
for i:=1 to pos-1 do tec:=tec.next;
elem:=tec;
end;
procedure delete; {процедура удаления}
var
tec,x:prec;
pos,i:byte;
begin
clrscr;
writeln('Vvedite nomer udalyaemogo elementa');
readln(pos); {ввод номера, который нужно удалить}
tec:=first;
if pos=1 then {если этот элемент первый}
begin
first:=tec.next; {тогда указатель на первый элемент принимает значение второго}
tec.prev:=nil; {а предыдущий равен нулю}
end;
if pos<>ctr then {если удаляемый элемент не равен текущему}
begin
tec:=elem(first,pos); {tec принимает указатель на тот элемент, который нам нужно удалить}
x:=tec.prev; {сохранение указателя}
tec:=tec.next;
x.next:=tec;
dispose(tec.prev); {удаление элемента под номером pos}
tec.prev:=x; {возвращение указателя, который мы сохраняли}
end;
if pos=ctr then {если значения pos равно последнему}
begin
tec:=elem(first,pos); {tec принимает указатель на тот элемент, который нам нужно удалить }
glavn:=tec^.prev; {текущий указатель принимает значение предыдущего}
tec^.next:=nil; {указатель на следующий принимает значение ноль}
end;
dec(ctr); {декрементирование значения ctr}
tec:=first;
for i:=1 to ctr do {цикл выравнивания списка}
begin
tec.n:=i;
tec:=tec.next;
end;
end;
procedure insertItem(x:prec;k:integer); {процедура вставки списка в динамически список}
var
tec,next:prec;
begin
if k>ctr then k:=ctr; {если k выходит за пределы номера списка, то он принимает значение последнего}
tec:=elem(first,k); {переход на номер k}
next:=tec.next;
tec.next:=x;
x.prev:=tec;
x.next:=next;
next.prev:=x;
if k=ctr then glavn:=x;
inc(ctr);
end;
function deleteitem(pos:integer):prec; {функция удаления элемента списка}
var
tec,x:prec;
begin
tec:=elem(first,pos); {tec принимает указатель на тот элемент, который нам нужно удалить}
deleteItem:=tec;
if pos=1 then {если элемент первый}
begin
first:=tec.next; {тогда второй стает первым}
x:=tec.next;
x.prev:=nil;
end
else {иначе он не первый}
begin
x:=tec.prev; {сохранение связи списка}
tec:=tec.next;
x.next:=tec;
tec.prev:=x;
end;
dec(ctr); {декрементирование номера списка}
end;
procedure zamena(i,j:integer); {процедура замены}
var
v:prec;
begin
v:=deleteItem(j);
InsertItem(v,i);
v:=deleteItem(i);
InsertItem(v,j);
end;
procedure sort; {процедура сортировки}
var
i,j,k:integer;
n:char;
begin
clrscr;
writeln('1-po vozrostaniu');
writeln('2-po ubivaniu');
n:=readkey;
case n of {оператор выбора}
'1':k:=1;
'2':k:=-1;
end;
for i:=1 to ctr-1 do {циклы в которых происходит сортировка}
for j:=i+1 to ctr do
if k*elem(first,j).pob.znach<k*elem(first,i).pob.znach then zamena(i,j);
end;
procedure grup; {процедура группировки}
var
st:string;
pt,z:prec;
i,t:byte;
pz:PBase;
begin
clrscr;
writeln('Vvedite colour dla gruppirovki');
readln(st);
t:=0;
z:=first;
repeat
if z.pob.znach2=st then {если полученная строка равна цвету, который мы ввели}
begin
inc(t); {инкрементируем значение t}
pt:=first;
for i:=1 to t-1 do pt:=pt.next;
pz:=pt.pob; {происходит замена местами, т. е. цвет, который мы ввели, идет на верх списка. И при выводе стоит на первых рядах списка}
pt.pob:=z.pob;
z.pob:=pz;
end;
z:=z.next;
until z=nil;
end;
end.
Результат работы программы
