Найти новый одномерный массив "С" из произведений элементов каждой строки матрицы А

var
a:array[1..5,1..5] of integer;
c:array[1..5] of integer;
i,j,pr,max:integer;
begin
max:=a[1,1];
writeln('massiv A');
for i:=1 to 5 do begin
pr:=1;
for j:=1 to 5 do begin
write('Введите a[',i,',',j,']= '); 
readln(a[i,j]);
pr:=pr*a[i,j];
if a[i,j]>max then
max:=a[i,j];
end;
c[i]:=pr;
writeln;
end;
writeln('massiv C');
for i:=1 to 5 do begin
write(c[i],' ');
end;
if max>0 then
begin
a[1,3]:=max;
writeln;
writeln('maximalnuj element ',max);
writeln('poslesmenumassiv A');
for i:=1 to 5 do begin
for j:=1 to 5 do begin
write(a[i,j]:4);
end;
writeln;
end;
end;
end.

const
    n = 5;
 
type
    TLine = Array[1..n] Of LongInt;
    TMass = Array[1..n] Of TLine;
 
procedure InitMass(var ar : TMass);
var
    ans : 1..2;
    i, j : Byte;
begin
    WriteLn('Vvedite metod zapolnenija massiva:');
    WriteLn('   1. Random.');
    WriteLn('   2. Manual.');
    {$R+}
    ReadLn(ans);
    {$R-}
    if (ans = 1)
    then
        for i := 1 to n do
        begin
            for j := 1 to n do
            begin
                ar[i, j] := Random(51) - 25;
                Write(ar[i, j]:5);
            end;
            WriteLn;
        end
    else
        for i := 1 to n do
            for j := 1 to n do
            begin
                Write('a[', i, '][', j, ']=');
                ReadLn(ar[i, j]);
            end;
    WriteLn; WriteLn;
end;
 
procedure FindC(var c : TLine; const ar : TMass);
var
    i, j : Byte;
begin
    WriteLn; Write('c: ');
    for i := 1 to n do
    begin
        c[i] := 1;
        for j := 1 to n do
            c[i] := c[i] * ar[i, j];
        Write(c[i], ' ');
    end;
    WriteLn;
end;
 
procedure FindMax(const ar : TMass; var Result : LongInt; var err : Boolean);
var
    i, j : Byte;
begin
    Result := ar[1, 1];
    for i := 1 to n do
        for j := 1 to n do
            if ((ar[i, j] > 0) And (Result < ar[i, j]))
            then
                Result := ar[i, j];
    err := (Result > 0);
end;
 
procedure Replace(var ar : TMass; const x : LongInt);
var
    i, j : Byte;
begin
    ar[1, 3] := x;
    WriteLn;
    for i := 1 to n do
    begin
        for j := 1 to n do
            Write(ar[i, j]:5);
        WriteLn;
    end;
    WriteLn;
end;
 
var
    arr : TMass;
    c : TLine;
    max : LongInt;
    e : Boolean;
begin
    Randomize;
    InitMass(arr);
    FindC(c, arr);
    FindMax(arr, max, e);
    if e
    then
        Replace(arr, max)
    else
        WriteLn('Polozhitelnyh elementov net!')
end.