В массиве найти все пары "дружественных" чисел, которые не больше заданного числа N

Program xxx;
Uses crt;
type
 tochka = record
x,y:real;
end;
listpoint = array[1..100] of tochka;
var
ar:listpoint;
a,b:tochka;
n:integer;
procedure ReadArrayPoint (var a:listpoint; n:integer);
var i:integer;
begin
 for i:=1 to n do
   begin
      write ('Tochka[',i,'].x='); readln (a[i].x);
      write ('Tochka[',i,'].y='); readln (a[i].y);
   end;
end;
function rass(a,b:tochka):real;
begin
Rass:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y));
end;
Procedure maxrass (ar:listpoint; n:integer; var a,b:tochka);
var
  i,j:integer;
  max:real;
  dis:real;
begin
Max:=0.0;
  for i:=1 to n-1 do
    begin
      for j:=i+1 to n do
         begin
            dis:=rass(ar[i],ar[j]);
            if (dis>=max) then
             begin
             max:=dis;
             a:=ar[i];
             b:=ar[j];
             end;
        end;
    end;
end;
begin
clrscr;
writeln ('Введите количество точек ');
write ('n= ');
readln (n);
ReadArrayPoint (ar,n);
MaxRass (ar,n,a,b);
Writeln ('Максимальное расстояние между точками');
Writeln ('A(',a.x:4:0,',',a.y:4:0,')','-',B(',b.x:4:0,',',b.y:4:0,',',b.y:4:0,')');
readln
end;

n := 4;
k := 3;
 
q := 1; // не изменять
pr := 1; // не изменять
sum := 0; // не изменять
for i:=1 to n do begin
  q := q * pr;
  if i<=k then
    sum := sum + q;
  pr := pr * 2;
end;
 
writeln('n-й член прогрессии = ', q);
writeln('сумма первых k членов = ', sum);