program tablica;
uses crt;
type
TInt=integer;
MyType=real;
Matrix=array[1..1] of MyType;
PMatrix=^Matrix;
{cтроки}
MyArray=array[1..1] of PMatrix;
PMyArray=^MyArray;
{массив указателей на строки}
TF=file of MyType;
TStr=string;
const k=50;
var
n,m,i,j,key,z,q:TInt;
a:PMyArray;
IOR:word;
flag1, flag2: boolean;
f: TF;
name: Tstr;
{------------------------------------}
Function GetMemory(m,n: TInt; var a: PMyArray):boolean;
{Функция выделяет память под динамический массив, входные параметры:
m- столбцы, n- строки, а- двумерный динамический массив}
var i: TInt;
begin
{ Выделяем память под указатели на "строки" }
getmem(a, n*sizeof(PMatrix));
if(a<>nil) then
begin
for i:= 1 to n do
getmem(a^[i], m*sizeof(MyType));
GetMemory:=true;
end
else
GetMemory:=false;
end;
{--------------------------------}
Function Summa( a:PMyArray; c,d,n,m: TInt): MyType;
{функция считает для каждого элемента сумму элементов,
стоящих не выши и не правее, а также не ниже и не левее его,
c- счетчик по столбцам, d-счетчик по строкам}
var i,j: TInt;
s: MyType;
begin
s:=0;
for i:=1 to d do
for j:=1 to c do
s:=s+a^[i]^[j];
for i:=d to n do
for j:=c to m do
s:=s+a^[i]^[j];
summa:=s-2*a^[d]^[c];
end;
{------------------------------}
Function Tabl (var a:PMyArray; n,m: TInt): Boolean;
{функция присваивает элементам одномерного массива b
значения функции Summa, затем переприсваивает их массиву а,
тем самым изменяя его}
var
b: PMatrix;
c,d,e,i,j: TInt;
begin
if(m<0) or (n<0) or (a=nil)
then
Tabl:=false
else
begin
Tabl:=true;
GetMem(b, n*sizeof(MyType));
for c:=1 to m do
begin
for d:=1 to n do
b^[m*(d-1)+c]:=summa(a,c,d,n,m);
for i:=1 to n do
for j:=1 to m do
for e:=1 to m*n do
a^[i]^[j]:=b^[e];
end;
for i:=1 to n do
begin
for j:=1 to m do
write(a^[i]^[j]:6:2);
writeln;
end;
readln;
FreeMem(b, n*sizeof(MyType));
end;
end;
{---------------------------------------------------------------}
Procedure FreeMemory(var a:PMyArray;n,m:TInt);
var i:TInt;
begin
for i := 1 to m do
freemem(a^[i], m*sizeof(MyType));
freemem(a, n*sizeof(PMatrix));
end;
{--------------------------------}
Procedure Make_Tabl(n,m: TInt; var a: PMyArray);
var
i,j: TInt;
f: file of MyType;
temp: MyType;
begin
n:=-1;
m:=-1;
{$I-}
repeat
clrscr;
writeln ('Введите длину таблицы. ');
readln (n);
IOR:=ioresult;
until (IOR=0) and (n>=1);
repeat
clrscr;
writeln ('Введите ширину таблицы. ');
readln (m);
IOR:=ioresult;
until (IOR=0) and (m>=1);
{$I+}
if(GetMemory(m,n,a)=true)
then
begin
{$I-}
repeat
clrscr;
writeln ('Выберете способ ввода значений таблицы');
writeln ('1- если хотите выполнить ввод с клавиатуры');
writeln ('2- для случайного вводa');
writeln ('3- для чтения из файла');
readln (z);
IOR:=ioresult;
until (IOR=0) AND ((z=1) or (z=2) or (z=3));
{$I-}
if z=1
then
begin
for i:=1 to n do
for j:=1 to m do
begin
{$I-}
repeat
write('Введите значение ячейки таблицы a[',i,',',j,'] ');
readln (a^[i]^[j]);
IOR:=ioresult;
if IOR<>0 THEN WriteLn('Неверное значение!');
until IOR=0;
{$I+}
end;
end;
if z=2
then
begin
randomize;
for i:=1 to n do
for j:=1 to m do
a^[i]^[j]:=random(k);
end;
if z=3
then
begin
{$I-}
repeat
writeln('Введите полное имя файла: ');
readln(name);
assign(f,name);
reset(f);
IOR:=IOResult;
if IOR<>0 then writeLn('Неверное имя файла!');
until IOR=0;
{$I+}
read(f,temp); {строки}
n:=trunc(temp);
read(f,temp); {cтолбцы}
m:=trunc(temp);
FreeMemory(a,n,m);
if (GetMemory(m,n,a)=true)
then
begin
for i:=1 to n do
for j:=1 to m do
begin
{$I-}
read(f, a^[i]^[j]);
IOR:=IOResult;
{$I+}
if IOR<>0
then
begin
writeLn('Неверное содержание файла. Нажмите Enter для выхода.');
readLn;
close(f);
halt; {завершение работы программы, код завершения 0}
end;
end;
close(f);
end
else
writeln('Произошла ошибка.');
end
else
writeln('Error!');
end;
end;
{-------------------------------------------}
begin
repeat
clrscr;
writeln('Меню');
writeln('1.Создание таблицы.');
writeln('2.Обработка таблицы и вывод результата.');
writeln('3.Сохранение файла.');
writeln('4.Выход из программы.');
readln(key);
case key of
1:
begin
Make_Tabl(n,m,a);
flag1:=true;
end;
2:
if flag1 then
begin
Tabl(a,m,n);
end;
end;
until key=4;
end.
