Преобразовать матрицу по правилу

Program lab8_2;
var a,b: array[1..100,1..100] of real;
n,m: integer;
i,j:integer;
slid_A,slid_B: real;
 
type Tmass = array[1..100,1..100] of real;
 
{type
 Matrix = array of array of real; 
function slid(const Matrix: TMatrix): real;
var
 i: integer;
begin
 Result := 0;
 for i := 0 to High(Matrix) do
  Result := Result + Matrix[i, i];
end;}
 
function Slid(Matrix:Tmass):real;
var 
  i:integer;
  begin
    Result:=0;
    for i:= 0 to n do
      Result:= Result + Matrix[i,i];
      end;
 
begin
  writeln('Vvedit rozmirnist n ta m: ');
  readln(n);
  readln(m);
 
  writeln('------------------- Matrutcia A:-----------------------------------');
  for i:=1 to n do
    for j:=1 to m do
      begin
      writeln('A[',i,',',j,']=');
      readln(a[i,j]);
      end;
  writeln('------------------- Matrutcia A:-----------------------------------');    
  for i :=1 to n do 
      begin
      for j :=1 to n do 
      write ( a [ i , j ]:4); 
      writeln ; 
      end ;
      writeln('------------------- Matrutcia B:-----------------------------------');  
    for i:=1 to n do
    for j:=1 to m do
      begin
      writeln('B[',i,',',j,']=');
      readln(b[i,j]);
      end;
  writeln('------------------- Matrutcia B:-----------------------------------');    
  for i :=1 to n do 
      begin
      for j :=1 to n do 
      write ( b [ i , j ]:4); 
      writeln ; 
      end ;
  writeln('------------------- Matrutcia B:-----------------------------------'); 
  slid_A:=Slid(a);
writeln(slid_A);
 
  end.

type
    TArray = Array[Byte, Byte] Of Real;
procedure InputSize(const c: Char; var x: Byte);
begin
    repeat
        Write(c, '=');
        ReadLn(x);
    until (x > 0);
end;
procedure GenerateArray(var x: TArray; var n, m: Byte);
var
    i, j: Byte;
begin
    WriteLn;
    Randomize;
    InputSize('n', n); InputSize('m', m);
    for i := 0 to n - 1 do
    begin
        for j := 0 to m - 1 do
        begin
            x[i, j] := Random() * 100 - 50;
            Write(' ', x[i, j]:6:2);
        end;
        WriteLn;
    end;
end;
procedure ProcessArray(var x: TArray; const n, m: Byte);
var
    i, j: Byte;
    trace, temp: Real;
begin
    WriteLn;
    trace := 0;
    for i := 0 to n - 1 do
        trace := trace + x[i, i];
    if (trace < 1)
    then
    begin
        for i := 0 to n - 1 do
        begin
            temp := Ord(Not Odd(i));
            for j := 0 to m - 1 do
            begin
                x[i, j] := temp;
                Write(x[i, j]:2:0);
            end;
            WriteLn;
        end;
    end
    else
        WriteLn('trace >= 1');
end;
var
    a, b: TArray;
    nA, mA, nB, mB: Byte;
begin
    GenerateArray(a, nA, mA); ProcessArray(a, nA, mA);
    GenerateArray(b, nB, mB); ProcessArray(b, nB, mB);
end.