Numeros amigos (v. 1.0.1)

{ paulogp }
{ mac os 7 }
program Ada20p;

uses
    MemTypes, QuickDraw, OSIntf;

const
    MAX = 300;

var
    i, j, k: Integer;
    tecla: string;
    a, b: array[1..MAX] of integer;

function somadivisores(X: integer): integer;
var
    limite, soma, i: integer;

begin
    limite:= trunc(sqrt(X));
    soma:= 1;

    for i:= 2 to limite do
        if (X mod i) = 0 then soma:= soma + i + X div i;

    if sqr(limite) = X then somadivisores:= soma - limite else
        somadivisores:= soma; {Caso particular: 16}
end;

function amigos(a, b: integer): boolean;
begin
    if a = somadivisores(b) then amigos:= b = somadivisores(a) else
        amigos:= False;
end;

procedure Main;
begin
    k:= 1;
    gotoxy(35, 2);
    writeln('Amigos II');
    gotoxy(35, 3);
    writeln('~~~~~~~~~');
    gotoxy(35, 4);
    writeln('Paulo G.P.');
    writeln;
    writeln('Início do cálculo!');
    writeln;
    writeln('Procura no intervalo [0 ,', MAX, ']');
    writeln;

    for i:= 2 to MAX - 1 do
    begin
        if (i = 2) then write('|') else
        if i = (MAX - 1) then write('|') else
        if (MAX mod i) = 0 then write('-');
    end;
    writeln;
    for i:= 2 to MAX do
    begin
        if (MAX mod i)=0 then write('|');
        for j:= i+1 to MAX do
        if amigos(i, j) = True then
        begin
            a[k]:= i;
            b[k]:= j;
            k:= k + 1;
        end;
    end;
    writeln;
    writeln;
    writeln;
    writeln('Tabela: ');
    writeln;
    write('I ');
    for i:= 1 to k - 1 do write(a[i],' ');
    writeln;
    write('J ');
    for i:= 1 to k - 1 do write(b[i],' ');
    writeln;
end;

begin
    repeat
        clearscreen;
        Main;
        writeln;
        writeln;
        write('Repetir (s/n): ');
        readln(tecla);
        uprstring(tecla, true);
    until tecla = 'N';
end.