Среди чисел заданной строки матрицы найти такое, которое принадлежит наибольшему количеству столбцов

uses crt;
{$R-}
type
     TElem=single;
     TArr=array[1..1] of TElem;
     PArr=^TArr;
     TMas=array[1..1] of PArr;
     PMas=^TMas;
     FSingle=file of single;
     TTen=1..10;
 
var
     a: PMas; //a-динамический массив
     width, height, res, i, j,flag: integer;//width-колличество строчек,height-колличество столбцов
     p1,p2: TTen;
     inp, oup: FSingle;
     err: boolean;
     need1, need2: longint;
     filename: string;
     asd:telem;
 
 
function BoolTest(const value: boolean): string;
 
const Values: array[boolean] of string = ('Нет', 'Да');
begin
BoolTest := Values[value];
end;
 
procedure Proced(var a:PMas;width,height:integer;var res:integer;var ce:boolean);
 
{процедура определяет значение и положение в таблице элемента,для которого сумма элементов,
лежащих не выше и не левее его ,максимальна.
 входные параметры:   а-указатель на таблицу(по ссылке),
                      width,heidht-фактические размеры таблицы(по значению),
 выходные параметры:  res-элемент,для которого сумма эллементов,лежащих не выше
 и не левее его,максимальна.
 ce-false,если ошибка,true,если всё правильно}
 
var i,j,k:integer;bool:boolean;
begin
if (width<0) or (height<0) or (a=nil) then ce:=false
else begin
res:=0;
for j:=1 to height do begin
    bool:=true;
    for i:=1 to width-1 do begin
       for k:=i+1 to width do begin
          if a^[i]^[j]=a^[k]^[j] then bool:=false
 
       end ;
 
    end;
if bool then inc(res);
end;
ce:=true;
end;
end;
 
 
begin
clrscr;
repeat
clrscr;
writeln;
writeln(' Меню пользователя');
writeln;
writeln('1. Задать размеры таблицы');
writeln('2. Заполнить таблицу случайными числами');
writeln('3. Заполнить таблицу с клавиатуры');
writeln('4. Создать файл элемнтов таблицы ');
writeln('5. Заполнить таблицу из файла');
writeln('6. Просмотреть таблицы');
writeln('7. Выполнить подпрограмму');
writeln('8. Завершеть работу программы');
writeln;
write('Выберите пункт меню: ');
     repeat
     {$I-} readln(p1); {$I+}
     until (IORESULT=0) and ((p1>=1) and (p1<=8));
 
case p1 of
     1:begin
       clrscr;
       writeln('1. Задание размеров таблицы');
       if a<>NIL then begin {если указатель не пуст,то освобождаем память}
         for i:=1 to width do FreeMem(a^[i], need2);
         FreeMem(a, need1);
         a := NIL;
       end;
       repeat
       write('Введите колличество строчек');
       {$I-}readln(width);{$I+}
       until (IORESULT=0);
       repeat
       write('Введите колличество столбиков ');
       {$I-}readln(height);{$I+}
       until (IORESULT=0);
 
       need1 := longint(width) * sizeof(PArr);{считаем сколько нам памяти нужно}
       need2 := longint(height) * sizeof(TElem);
       GetMem(a, need1);{выделяем память}
       for i:=1 to width do GetMem(a^[i], need2);
       flag:=1;
       writeln;
       writeln('Для возврата в главное меню нажмите ENTER');
       end;
 
     2:begin
       clrscr;
       randomize;
       writeln('2.Заполнение таблицы случайными числами');
       if flag=0 then writeln('Размеры не заданы')
       else begin
       for i:=1 to width do
       for j:=1 to height do begin
          a^[i]^[j]:=random(100);
       end;
       writeln('Выполнено');flag:=2; end;
       writeln;
       writeln('Для возврата в главное меню нажмите ENTER');
       end;
 
     3:begin
       clrscr;
       writeln('3.Заполнение таблицы с клавиатуры');
       if flag=0 then writeln('Размеры не заданы')
       else begin
       for i:=1 to width do
       for j:=1 to height do begin
          repeat
          write('а[', i, ', ', j, '] = ');
          {$I-}read(a^[i]^[j]);{$I+}
          until (IORESULT=0);
       end;
        flag:=2;
       writeln('Выполнено'); end;
       writeln;
       writeln('Для возврата в главное меню нажмите ENTER');
       end;
 
     4:begin
 
 
             write('Введите имя файла');
             readln(filename);
             Assign(oup, filename);//ф.п. oup связывается с именм файла
             {$I-} rewrite(oup); {$I+}//инициирует запись информации в файл
             if IORESULT = 0 then begin
             asd:=width;
             write(oup, asd);
             asd:=height;
             write(oup, asd);
             writeln('Просмотр');
               for i:=1 to width do begin
                  for j:=1 to height do begin
                    write(a^[i]^[j]:8:2);
                     write(oup, a^[i]^[j]);
                  end;
              writeln;
              end;
 
             close(oup);
              end;
             filename := '';
             writeln;
 
 
 
 
      writeln;
      writeln('Для возврата в главное меню нажмите ENTER');
      end;
 
     5:begin
       clrscr;
       writeln('5.Заполнеие таблицы из файла');
      { if flag<>3 then writeln('Файл не создан')
       else} begin
       if a <> NIL then begin
        need1 := longint(width) * longint(height) * sizeof(PArr);
       need2 := longint(height) * sizeof(TElem);
         for i:=1 to width do FreeMem(a^[i], need2);
         FreeMem(a, need1);
         a := NIL;
       end;
       write('Введите имя файла ');
       readln(filename);
 
       assign(inp, filename);
       {$I-} reset(inp); {$I+}//чтение файла
       if IORESULT = 0 then begin
       read(inp, asd);
       width:=round(asd);
       read(inp, asd);
       height:=round(asd);
 
       need1 := longint(width) * longint(height) * sizeof(PArr);
       need2 := longint(height) * sizeof(TElem);
       GetMem(A, need1);
       for i:=1 to width do GetMem(a^[i], need2);
 
       for i:=1 to width do begin
          for j:=1 to height do begin
          {$I-} read(inp, a^[i]^[j]); {$I+}
          if IORESULT = 0 then write(a^[i]^[j]:8:2);
          end; // while [j]
 
       end; // while [i]
 
 
       {$I-} close(inp); {$I+}
       filename := '';
       flag:=2; end else         writeln('no');
       writeln('Для возврата в главное меню нажмите ENTER');
       end;
       end;
 
     6:begin
       clrscr;
       writeln('6.Просмотр таблицы');
       if flag<>2 then writeln('Таблица не создана')
       else begin
       for i:=1 to width do begin
          for j:=1 to height do write(a^[i]^[j]:8:2);
          writeln;
       end; end;
       writeln;
       writeln('Для возврата в главное меню нажмите ENTER');
       end;
 
     7:begin
       clrscr;
       writeln('7.Выполнение подпрограммы');
       if flag<>2 then writeln('Таблица не создана.Невозможно выполнить подпрограмму')
       else begin
       Proced(a, width, height,res,err);
       writeln('Правильно ли выполнилась программа?',BoolTest(err));
       writeln('Ответ:', res);
       end;
       writeln;
       writeln('Для возврата в главное меню нажмите ENTER');
       end;
 
end; //case
 
if p1<>8 then readln;
until p1=8; //repeat
clrscr;
writeln('Завершение работы');  //освобождаем память
for i:=1 to width do FreeMem(a^[i], need2); //удаляем все строки
FreeMem(a, need1);//удаляем указатели на них
a := NIL;
 
{$R+}
writeln('Для продолжения нажмите ENTER');
readln;
end.