Объектно-ориентированное программирование. Разработка программы, имеющей графическую заставку, работу с массивом, матрицей и со связным списком, страница 5

{правила массива}

{ввод массива}

constructor objmas.Init(minit:integer);

var

i:integer;

begin

parent.Init(minit);

clrscr;

writeln('Введите ',m,' элементов массива:');

for i:=1 to m do

read(a[i]);

k:=m

end;

{вывод массива}

procedure objmas.OutData;

var

i:integer;

begin

writeln;

writeln;

for i:=1 to k do

write(a[i]:6:0,'  ');

writeln;

readkey

end;

{удаление положительных элементов}

procedure objmas.Job;

var

i:integer;

begin

k:=0;

for i:=1 to n do

if a[i]<0 then

begin

k:=k+1;

a[k]:=a[i];

end;

end;

{разрушение массива}

destructor objmas.Done;

begin

{пустое правило}

end;

{правила матрицы}

{ввод матрицы}

constructor objmatr.Init(minit,ninit:integer);

var

i,j:integer;

begin

m:=minit;

n:=ninit;

clrscr;

writeln ('Введите матрицу:');

for i:=1 to n do

for j:=1 to m do

read (b[i,j]);

end;

{вывод матрицы}

procedure objmatr.OutData;

var

i,j:integer;

begin

for i:=1 to m do

begin

writeln;

writeln;

for j:=1 to n do

write(b[i,j]:6:0);

end;

writeln('');

readkey;

end;

{замена нулями локальных минимумов}

procedure objmatr.Job;

var

i,j:integer;

begin

k:=0;

for i:=2 to (n-1) do

for j:=2 to (m-1) do

if (b[i,j]<b[i-1,j]) and (b[i,j]<b[i+1,j])

and (b[i,j]<b[i,j-1]) and  (b[i,j]<b[i,j+1]) then

begin

k:=k+1;

b[i,j]:=0;

end;

end;

{разрушение матрицы}

destructor objmatr.Done;

begin

{пустое правило}

end;

{правила связанного списка}

{ввод связанного списка}

constructor objspis.Init(minit:integer);

var

z:zapis;

buff,buff1:link;

ans:char;

i,j:integer;

begin

i:=0;

k:=0;

repeat

clrscr;

i:=i+1;

textcolor(lightgreen);

writeln('Bвод записей');

writeln('Введите ',i,' запись');

textcolor(white);

with z do begin

write('Номенклатурный номер : ');

readln(nomnom);

write('Номер накладной: ');

readln(nomnak);

write('Дата из накладной: ');

readln(dat);

write('Приход: ');

readln(prih);

write('Расход : ');

readln(rash);

write('Наименование товара: ');

readln(naim);

end;

new(buff);

if buff=nil then

begin

writeln('Память не выделена!');

readkey;

exit;

end;

new(buff1);

if buff1=nil then

begin

write('Память не выделена!');

readkey;

exit;

end;

buff^.data:=z;

if k=0 then                             {добавление 1 элемента}

begin

buff^.next:=list;

list:=buff

end

else

begin                                 {добавление в конец списка}

buff1:=list;

for j:=2 to k do

buff1:=buff1^.next;

buff^.next:=buff1^.next;

buff1^.next:=buff

end;

gotoxy(15,10);

textcolor(lightred);

writeln('Продолжить (y/n)');

textcolor(white);

ans:=readkey;

k:=k+1;

until ans in ['n','N','Т','т'];

end;

{вывод связанного списка}

procedure objspis.OutData;

var

buff:link;

i:integer;

begin

clrscr;

if list=nil then

begin

writeln('База пуста');

readkey;

exit

end;

new(buff);

if buff=nil then

begin

writeln('Память не выделена!');

readkey;

exit

end;

buff:=list;

for i:=1 to k do

begin

clrscr;

textcolor(lightgreen);

writeln('Bывод связанного списка:');

writeln('Запись ',i,':');

textcolor(white);

writeln('');

with buff^.data do

begin

writeln('Номенклатурный номер: ',nomnom:2);

writeln('Номер накладной:   ',nomnak:5);

writeln('Дата из накладной: ',dat:5);

writeln('Приход: ',prih:16);

writeln('Расход: ',rash:16);

writeln('Наименование товара:',naim:5);

end;

buff:=buff^.next;

readkey;

end;

end;

{поиск элементов}

Procedure objspis.Job;

var

buff:link;

flag:boolean;

i:integer;

str:string;

begin

clrscr;

if list=nil then

begin

writeln('База пуста!');

readkey;

exit

end;

new(buff);

if buff=nil then

begin

writeln('Память не выделена!');

readkey;

exit

end;

writeln('поиск элементов');

writeln('Введите наименование товара для поиска элементов: ');

readln(str);

flag:=true;

buff:=list;

for i:=1 to k do

begin

if buff^.data.naim=str then               {поиск записей по полю}

begin

clrscr;

flag:=false;

textcolor(lightgreen);

writeln('Запись ',i,':');

textcolor(white);

writeln;

with buff^.data do

begin

writeln('Номенклатурный номер : ',nomnom:1);

writeln('Номер накладной:  ',nomnak:6);

writeln('Дата из накладной: ',dat:5);

writeln('Приход: ',prih:16);

writeln('Расход: ',rash:16);

writeln('Наименование товара: ',naim:4);

end;

readkey;

end;

buff:=buff^.next;

end;

if flag then

begin

clrscr;

writeln('Нет такой записи!');

readkey;