Объектно-ориентированное программирование. Модуль CRT. Вывод на экран. Системные переменные модуля CRT, страница 6

for i:=1 to m do

begin

writeln;

writeln;

for j:=1 to n do

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

end;

writeln('');

readkey;

end;

{Взаимный обмен элементов двух диагоналей}

procedure objmatr.Job;

var

i:integer;

buf:real;

begin

for i:=1 to m do

begin

buf:=b[i,i];

b[i,i]:=b[i,m-i+1];

b[i,m-i+1]:=buf

end;

end;

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

destructor objmatr.Done;

begin

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

end;

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

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

constructor objspis.Init(minit:integer);

var

z:pasient;

buff,buff1:link;

ans:char;

i,j:integer;

begin

i:=0;

k:=0;

repeat

clrscr;

i:=i+1;

textcolor(lightgreen);

writeln('Введите данные ',i,'-ого пациента');

writeln('');

textcolor(white);

with z do begin

write('Фамилия Имя Отчество: ');

readln(fio);

write('Год рождения: ');

readln(birth);

write('Адрес: ');

readln(adres);

write('Телефон: ');

readln(tel);

write('Номер участка: ');

readln(nu);

write('Номер отделения: ');

readln(no);

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                             {Добавление первого элемента}

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('ПАЦИЕНТ №',i,':');

textcolor(white);

writeln('');

with buff^.data do

begin

writeln('Фамилия Имя Отчество: ',fio:30);

writeln('Год рождения:                                   ',birth:4);

writeln('Адрес:                ',adres:30);

writeln('Телефон:                                     ',tel:7);

writeln('Номер участка:                                    ',nu:2);

writeln('Номер отделения:                                  ',no:2);

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('Введите фамилию, имя и отчество искомого пациента: ');

readln(str);

flag:=true;

buff:=list;

for i:=1 to k do

begin

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

begin

clrscr;

flag:=false;

textcolor(lightgreen);

writeln('ПАЦИЕНТ №',i,':');

textcolor(white);

writeln('');

with buff^.data do

begin

writeln('Фамилия Имя Отчество: ',fio:30);

writeln('Год рождения:                                  ',birth:4);

writeln('Адрес:                ',adres:30);

writeln('Телефон:                                     ',tel:7);

writeln('Номер участка:                                    ',nu:2);

writeln('Номер отделения:                                  ',no:2);

end;

readkey;

end;

buff:=buff^.next;

end;

if flag then

begin

clrscr;

writeln('Такой пациент в базе не зарегестрирован.');

readkey;

end;

end;

{Разрушение связанного списка}

destructor objspis.Done;

var

buff:link;

i:integer;

begin

for i:=1 to k do

begin

buff:=list^.next;

dispose(list);

list:=buff;

end;

end;

{******************Графическая заставка******************}

procedure zastavka;

var

gd,gm,x,y,x1,y1,dx:integer;

{Рисование фона}

procedure background;

var

x1,y1:integer;

begin

setfillstyle(1,3);

bar(0,0,200,130);

bar(200,0,440,100);