В массиве найти повторяющиеся элементы и количество их повторений

const nmax=100; 
var a,a1,b,b1:array[1..nmax] of integer; 
n,m,i,j,k,c:integer; 
begin 
 
 
repeat 
write('Размер массива до ',nmax,' n='); 
readln(n); 
until n in [1..nmax]; 
writeln('Исходный массив:'); 
for i:=1 to n do 
begin 
 
writeln(a[i]); read(a[i]); 
end; 
writeln; 
a1:=a;{сохраним исходный массив} 
m:=0; 
while n>0 do 
begin 
c:=a1[1];{первый элемент} 
m:=m+1; 
b[m]:=c; 
k:=0; {количество} 
for i:=n downto 1 do{идем с конца} 
if a1[i]=c then 
begin 
k:=k+1; {считаем и удаляем} 
if i=n then n:=n-1 
else 
begin 
for j:=i to n-1 do 
a1[j]:=a1[j+1]; 
n:=n-1; 
end; 
end; 
b1[m]:=k; 
end; 
for i:=1 to m do 
if b1[i]>1 then 
writeln(b[i],' ',b1[i],' '); 
 
end.

const
    NMAX = 100;
type
    TTypeInUse = ShortInt; //чтоб менять нужно было лишь в одном месте
    TNumber = record
        numb: TTypeInUse; //само число
        count: Byte; //количество самих повторов, не сколько раз встречается число
    end;
    TArray = Array[1..NMAX] Of TNumber;
 
procedure Process(var ar: TArray; var n: Byte; const x: TTypeInUse);
var
    id: Byte = 0;
    flag: Boolean = False;
begin
    while ((Not flag) And (id < n)) do //проверяем, есть ли такой элемент в нашей "базе"
    begin
        Inc(id);
        flag := (ar[id].numb = x);
    end;
    if (flag) //если нашли
    then //наращиваем счётчик
        Inc(ar[id].count)
    else //или добавляем новый
    begin
        Inc(n);
        ar[n].numb := x;
        ar[n].count := 0;
    end;
end;
 
function IsRepeats(const ar: TArray; const n: Byte): Boolean; //проверяем имеются ли у нас повторы
var
    i: Byte = 0;
    Result: Boolean = False;
begin
    while ((Not Result) And (i < n)) do //если количество хоть одного из чисел больше единицы
    begin
        Inc(i);
        Result := (ar[i].count > 0);
    end;
    IsRepeats := Result;
end;
 
function GetTotalSum(const ar: TArray; const n: Byte): Integer; //суммируем повторы
var
    i: Byte;
    Result: Integer = 0;
begin
    for i := 1 to n do
        with ar[i] do
            Inc(Result, ar[i].count);
    GetTotalSum := Result;
end;
 
var
    i, na, nb: Byte;
    nonuniq: TArray;
    arr: Array[1..NMAX] Of TTypeInUse;
begin
    Randomize();
    repeat
        Write('Input n(1..', NMAX, '): ');
        ReadLn(na);
    until (na in [1..NMAX]);
    nb := 0;
    for i := 1 to na do
    begin
        arr[i] := Random(199) - 99; //рандомим новое число
        Write(arr[i]:4);
        Process(nonuniq, nb, arr[i]); //проверяем "на вшивость"
    end;
    WriteLn; WriteLn;
    if (IsRepeats(nonuniq, nb)) //если были повторы
    then
    begin
        for i := 1 to nb do
            with nonuniq[i] do
                if (count > 0) //если количество данного числа выше 1 (если были повторы конкретно этого числа)
                then
                    WriteLn(numb:4, ' - ', count);
        Write('Total repeats: ', GetTotalSum(nonuniq, nb)); //и общая сумма повторений
    end
    else
        Write('All elements are uniq!');
end.