[Процедуры и функции]Оформление матрицы в виде крест-накрест

PROGRAM k_prj;
USES Crt;
CONST
ng=5;
nv=5;
a=ng/20;
b=(ng+nv)/20;
VAR
 n:integer;
 t:text;
 inMidR:real;
{------------------------------}
FUNCTION F(x:real):real;
 BEGIN
  F:=sqr(sin(2*x))/cos(2*x);
 END;
{------------------------------}
PROCEDURE MidR(x1,x2:real;n:integer;var sum:real);
 VAR
  h,x,xm:real;
  i,im,jm:integer; 
  c: array [0..ng,0..nv] of real;
 BEGIN
 h:=(x2-x1)/n;
 x:=x1-h/2;
 xm:=x;
 sum:=0;
 FOR im:=0 TO ng DO
  FOR jm:=0 TO nv DO
   BEGIN
   c[im,jm]:=F(xm);
   xm:=xm+h;
   WRITE(t,'',F(xm):5:4,' ');
   WRITE('',F(xm):5:4,' ');
 IF jm=nv THEN
  BEGIN
  WRITELN(t);
  WRITELN;
  END;
END;
 FOR i:=0 TO n-1 DO
BEGIN
 sum:=sum+F(x);
 x:=x+h;
END;
 sum:=sum*h;
END;
{------------------------------}
BEGIN
CLRSCR;
ASSIGN(t,'C:\integral.txt');
REWRITE(t);
WRITE(' Kolichestvo otrezkov: ');
READLN(n);
{---------------------------------------------------------------------------}
WRITELN(' Method of the midle rectangulars: ');
WRITELN(t,' Method of the midle rectangulars: ');
MidR(a,b,n,inMidR);
WRITELN(' Otvet: ',inMidR:6:5);
WRITELN(t,' Otvet: ',inMidR:6:5);
{---------------------------------------------------------------------------}
CLOSE(t);
READKEY
END.

for i:=1 to n do
 begin
  for j:=1 to n do
   begin
     if(i=j)or(j=n-i+1)then a[i,j]:=1
     else a[i,j]:=0;
     write(a[i,j]:4:1);
   end;
  writeln;
 end;

for i:=1 to n do
 begin
  for j:=1 to n do
   begin
     if(i=j)or(j=n-i+1)then a[i,j]:=a[i,j]
     else a[i,j]:=0;
     write(a[i,j]:8:2);
   end;
  writeln;
 end;

for i:=1 to n do
 begin
  for j:=1 to n do
   begin
     if(i=3)or(j=3)then a[i,j]:=a[i,j]
     else a[i,j]:=0;
     write(a[i,j]:8:2);
   end;
  writeln;
 end;

program test;
uses crt;
const n=5;
var a:array [1..n,1..n] of integer;i,j:integer;
begin
clrscr;
randomize;
for i:=1 to n do
for j:=1 to n do
a[i,j]:= 1;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
for i:=1 to n do
for j:=1 to n do
if (i=3) or (j=3) then
a[i,j]:=1 else a[i,j]:=0;
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
for i:=1 to n do
for j:=1 to n do
if (i=j) or (j=n-i+1) then
a[i,j]:=1 else a[i,j]:=0;
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
readln;
end.