Записи (структуры)геометрия(прямоугольники) - Pascal ABC - Ответ 1271853

const nmax=5;
type
    prm=record
    x,y,w,h:integer;
    end;
         
function NoPer(a,b:prm):boolean;
begin
NoPer:=(a.x+a.w<b.x)or(a.x>b.x+b.w)or(a.y+a.h<b.y)or(a.y>b.y+b.h);
end;
 
var a : array[1..nmax] of prm;
    perem : prm;
    b,n,i,j,k : byte;
    f : boolean;
    Tfile:file of prm;
    Ttext:text;
begin
Assign(Tfile,'file');
Assign(Ttext,'final.txt');
{reset(Tfile);
    repeat
    write('Количество прямоугольников до ',nmax,' n=');
    read(n);
    until n in [1..nmax];
    writeln('Введите параметры прямоугольников');
 
    for i:=1 to n do
        begin
            writeln('Прямоугольник ',i);
            writeln('Координаты левого верхнего угла:');
            read(a[i].x,a[i].y);
            writeln('Ширина и высота:');
            read(a[i].w,a[i].h);
            perem:=a[i];
            write(Tfile,perem);
        end;
close(Tfile);}
 
reset(Tfile);
    i:=1;
    while not eof(Tfile) do
    begin
        read(Tfile,perem);
        a[i]:=perem;
        inc(i);
        inc(b);
    end;
close(Tfile);
 
k:=0;
for i:=1 to b-1 do
    begin
        j:=i+1;
        f:=true;
        while(j<=(b-1))and f do
        if not (NoPer(a[i],a[j]))and(i<>j)then f:=false
        else j:=j+1;
        
        if f then
            begin
                k:=1;
                rewrite(TText);
                writeln(TText,'Не пересекаются с другими:');
                writeln(TText,'Прямоугольник ',i,' x=',a[i].x,' y=',a[i].y,' w=',a[i].w,' h=',a[i].h);
                close(TText);
            end;
    end;
    
if k=0 then
    begin
        rewrite(TText);
        writeln(TText,'Не пересекаются с другими:');
        write(TText,'Таких прямоугольников нет!');
        close(TText);
    end;
end.