i:integer;
begin
if m<1 then exit;
For i:=1 to m do begin
textattr:=$07; Write(i:2,': ');
textattr:=$0F; Write(a[i]:4,'; ');
if i mod colls = 0 then WriteLn
end;
WriteLn;
textattr:=$07;
end;
Constructor Matr.Init; {Процедура инициализации матрицы}
var i,j:integer;
begin
if (minit<1)or(ninit<1) then begin
WriteLn('Недопустимая размерность матрицы!');
readkey;
exit
end;
m:=minit;
n:=ninit;
For i:=1 to m do begin
textattr:=$07;
WriteLn('Ввод ',i,'-той строки:');
For j:=1 to n do begin
Write('Введите ',j,'-тый елемент: ');
textattr:=$0F;
Readln(a[i,j]);
textattr:=$07;
end;
end;
end;
procedure Matr.Job; {Процедура обработки матрицы}
var
i,j,plus,otric:integer;
begin
if m<1 then exit;
For j:=1 to n do begin
plus:=0;
otric:=0;
For i:=1 to m do
if a[i,j]>0 then inc(plus)
else if a[i,j]<0 then inc(otric);
if plus>otric then
For i:=1 to m do a[i,j]:=1
end
end;
procedure Matr.OutData; {Процедура вывода матрицы на экран}
const colls=5;
var i,j:integer;
begin
if m<1 then exit;
textattr:=$0F;
For i:=1 to m do begin
For j:=1 to n do
Write(a[i,j]:6,' ');
WriteLn
end;
textattr:=$07;
WriteLn;
end;
Constructor List.Init; {Процедура инициализации связанного списка}
var
now:link;
i:integer;
c:char;
begin
if minit<1 then begin
WriteLn('Неправильно введено количество записей!');
readkey;
exit
end;
clrscr;
m:=minit;
first:=nil;
last:=nil;
For i:=1 to m do begin
clrscr;
WriteLn('Введите запись:');
new(now);
if now=nil then begin
WriteLn('Не достаточно памяти!!!');
readkey;
exit
end;
With now^.data do begin
Write(' введите табельный номер: ');
Readln(tabnum);
Write(' введите месяц: ');
Readln(mesac);
Write(' введите вид начисления: ');
Readln(vidNachisl);
Write(' введите сумму: ');
Readln(summ);
Write(' введите налоги: ');
Readln(nalogi);
Write(' введите номер отдела: ');
Readln(numOtdel);
end;
if first=nil then begin
first:=now;
now^.pred:=nil end
else begin
last^.next:=now;
now^.pred:=last
end;
last:=now;
now^.next:=nil
end;
end;
procedure List.OutData; {Процедура вывода связанного списка на экран}
var
now:link;
strNow,strMax,i:integer;
ans:char;
begin
readkey;
if m<1 then exit;
if first=nil then begin
WriteLn('Нет данных для вывода!');
readkey;
exit
end;
now:=first;
strMax:=m div 11 +1;
strNow:=0;
i:=0;
Repeat
inc(StrNow);
inc(i);
clrscr;
WriteLn('г=====T===========T=======T============T===========T==========T========¬');
WriteLn('¦ № ¦ Табельный ¦ Месяц ¦ Вид ¦ Сумма ¦ Налоги ¦ № ¦');
WriteLn('¦ ¦ № ¦ ¦ начисления ¦ ¦ ¦ Отдела ¦');
WriteLn('¦=====+===========+=======+============+===========+==========+========¦');
while (now<>nil)and(WhereY<23) do begin
with now^.data do
WriteLn('¦ ',i:3,' ¦ ',tabnum:9,' ¦ ',mesac:3,' ¦ ',vidNachisl:10,' ¦ ',summ:9:2,' ¦ ',nalogi:8:2,' ¦',numOtdel:7,' ¦');
now:=now^.next;
if (now<>nil)and(WhereY<23) then
WriteLn('¦-----+-----------+-------+------------+-----------+----------+--------¦');
inc(i);
if (WhereY>=23)or(now=nil) then
WriteLn('L-----¦-----------¦-------¦------------¦-----------¦----------¦---------');
end;
WriteLn('Страница ',strNow,'/',strMax);
if now=nil then begin
exit end
else begin
Write('Вы хотите посмотреть следующую страницу? (y/n) ');
ReadLn(ans);
if upcase(ans)<>'Y' then exit;
dec(i);
end;
until false
end;
Destructor List.Done; {Деструктор Done объекта List}
var { Процедура удаления списка из памяти}
now:link;
begin
if m<1 then exit;
now:=first;
while first <> nil do begin
now:=first^.next;
dispose(first);
first:=now;
end;
end;
procedure List.Job; {Метод Job обработки полей объекта List }
var { процедура поиска элементов в связ. списке}
now:link;
answ:word;
f:boolean;
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.