Найти количество элементов, для которых все соседи a[i,j] меньше самого a[i,j]

Const
  cMaxIndex = 100;                           { Максимальный размер матрицы }
 
Type
  PArray = ^TArray;
  TRange = 1..cMaxIndex;                     { Диапазон индекса матрицы }
  TArray = array [TRange, TRange] of Real;   { Максимальная матрица }
  TFile  = file of Real;                     { Типизированный файл для сохранения матрицы }
 
{
  Процедура записи матрицы в файл
  Параметры:
    f - типизированный файл, открытый для записи
    a - записываемая матрица
    n - размер матрицы
}
Procedure SaveArray (var f : TFile; a : PArray; n : TRange);
var
  i, j : TRange;
  r : Real;
 
begin
  r := n;
  write (f, r);
  for i := 1 to n do
    for j := 1 to n do
      write (f, a^ [i, j]);
end;
 
{
  Процедура считывания матрицы из файл
  Параметры:
    f - типизированный файл, открытый для чтения
    a - считываемая матрица
    n - размер матрицы
}
Procedure LoadArray (var f : TFile; a : PArray; var n : TRange);
var
  i, j : TRange;
  r : Real;
 
begin
  read (f, r);
  n := round (r);
  for i := 1 to n do
    for j := 1 to n do
      read (f, a^ [i, j]);
end;
 
{
  Процедура ручного ввода матрицы
  Параметры:
    a - матрица
    n - размер матрицы
}
Procedure InputArray (a : PArray; n : TRange);
var
  i, j : TRange;
 
  s : string;
 
begin
  writeln (\'Введите элементы матрицы:\');
  for i := 1 to n do
    for j := 1 to n do
    begin
      write (\'Элемент a [\', i, \', \', j, \'] --> \');
      readln (a^ [i, j]);
  end;
end;
 
{
  Процедура ручного ввода матрицы
  Параметры:
    a     - матрица
    aName - обозначение матрицы
    n     - размер матрицы
}
Procedure PrintArray (a : PArray; aName : string; n : TRange);
var
  i, j : TRange;
 
begin
  writeln (\'Матрица \', aName, \':\');
  for i := 1 to n do
  begin
    for j := 1 to n do
      write (\' \', a^ [i, j]:12:4);
    writeln;
  end;
end;
 
{
  Процедура нахождения минимального элемента заданной строки матрицы
  Параметры:
    a - матрица
    i - номер строки
    n - размер матрицы
}
Function FindMin (a : PArray; i : TRange; n : TRange) : Real;
var
  j : TRange;
  m : Real;
 
begin
  m := a^ [i, 1];
  for j := 2 to n do
    if a^ [i, j] < m then m := a^ [i, j];
 
  FindMin := m;
end;
{
  Процедура формирования результирующей матрицы
  Параметры:
    a - первая матрица
    b - вторая матрица
    c - результирующая матрица    
    n - размер матрицы
}
Procedure CreateArray (a : PArray; b : PArray; c : PArray; n : TRange);
var
  i, j : TRange;
  min : Real;
 
begin
  for j := 1 to n do
  begin
    min := FindMin (b, j, n);
    for i := 1 to n do
      c^ [i, j] := a^ [i, j] * min;
  end;
end;
 
Var
  a : PArray;
  b : PArray;
  c : PArray;
  n : TRange;
  s : string;
  f : TFile;
 
Begin
  New (a); New (b);
  write (\'Введите имя файла для считывания или "-" для ручного ввода матриц: \');
  readln (s);
  if s [1] = \'-\' then begin
    Repeat
      write (\'Введите размер матрицы (1-100): \'); readln (n);
    Until n in [1..100];
 
    InputArray (a, n);
    InputArray (b, n);
 
    write (\'Введите имя файла для сохранения или "-" для продолжения: \');
    readln (s);
 
    if s [1] <> \'-\' then begin
      {$I-}
      Assign (f, s); Rewrite (f);
      {$I+}
      if IOResult <> 0 then writeln (\'Ошибка при создании файла! Продолжение работы без сохранения ввода!\')
      else begin
        SaveArray (f, a, n);
        SaveArray (f, b, n);
        Close (f);
      end;
    end;
  end
  else begin
    {$I-}
    Assign (f, s); Reset (f);
    {$I+}
    if IOResult <> 0 then begin
      writeln (\'Ошибка открытия файла! Работа завершена!\');
      halt (1);
    end;
 
    LoadArray (f, a, n);
    LoadArray (f, b, n);
 
    Close (f);
  end;
 
  PrintArray (a, \'A\', n);
  PrintArray (b, \'B\', n);
 
  New (c);
  CreateArray (a, b, c, n);
 
  PrintArray (c, \'C\', n);
End.

uses crt;
const nmax=20;
type matr=array[1..nmax,1..nmax] of integer;
function LokMax(i,j:integer;a:matr;m,n:integer):boolean;
begin
LokMax:=
{углы}
((i=1)and(j=1)and((a[i,j])>a[i+1,j+1])and(a[i,j]>a[i,j+1])and(a[i,j]>a[i+1,j]))
or((i=1)and(j=n)and((a[i,j])>a[i+1,j-1])and(a[i,j]>a[i,j-1])and(a[i,j]>a[i+1,j]))
or((i=m)and(j=1)and((a[i,j])>a[i-1,j+1])and(a[i,j]>a[i-1,j])and(a[i,j]>a[i,j+1]))
or((i=m)and(j=n)and((a[i,j])>a[i-1,j-1])and(a[i,j]>a[i,j-1])and(a[i,j]>a[i-1,j]))
{периметр}
or((i=1)and(j in [2..n-1])and((a[i,j])>a[i+1,j-1])and(a[i,j]>a[i+1,j+1])
and(a[i,j]>a[i+1,j])and(a[i,j]>a[i,j+1])and(a[i,j]>a[i,j-1]))
or((i=m)and(j in [2..n-1])and((a[i,j])>a[i-1,j-1])and(a[i,j]>a[i-1,j+1])
and(a[i,j]>a[i-1,j])and(a[i,j]>a[i,j+1])and(a[i,j]>a[i,j-1]))
or((j=1)and(i in [2..m-1])and((a[i,j])>a[i-1,j])and(a[i,j]>a[i-1,j+1])
and(a[i,j]>a[i,j+1])and(a[i,j]>a[i+1,j])and(a[i,j]>a[i+1,j+1]))
or((j=n)and(i in [2..m-1])and((a[i,j])>a[i-1,j-1])and(a[i,j]>a[i-1,j])
and(a[i,j]<a[i,j-1])and(a[i,j]>a[i+1,j-1])and(a[i,j]>a[i+1,j]))
{остальное}
or((i<>1)and(i<>m)and(j<>1)and(j<>n)
and(a[i,j]>a[i+1,j+1])and(a[i,j]>a[i-1,j-1])and(a[i,j]>a[i-1,j+1])and(a[i,j]>a[i+1,j-1])
and(a[i,j]>a[i-1,j])and(a[i,j]>a[i+1,j])and(a[i,j]>a[i,j+1])and(a[i,j]>a[i,j-1]));
end;
 
var a,b:matr;
    m,n,i,j,k:integer;
begin
clrscr;
randomize;
repeat
write('Количество строк до ',nmax,' m=');
readln(m);
until m in [1..nmax];
repeat
write('Количество столбцов до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to m do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(50);
    write(a[i,j]:4);
   end;
  writeln;
 end;
writeln('Матрица локальных максимумов:');
k:=0;
for i:=1 to m do
 begin
  for j:=1 to n do
   begin
    if LokMax(i,j,a,m,n) then
     begin
      b[i,j]:=1;
      k:=k+1;
     end
    else b[i,j]:=0;
    write(b[i,j]:4);
   end;
  writeln;
 end;
write('Всего локальных максимумов=',k);
readln
end.