Нахождение диагоналей оси

[Эцио]

Мои наработки:

procedure TForm1.Button1Click(Sender: TObject);
Var C:array of tCube;
i,j,n,d:Integer;
begin
n:=StrToInt(Edit1.Text);
SetLength(C,n);
for i := Low(C) to High(C) do
begin
C[I].x:=StrToFloat(InputBox('Ввод данных','Введите абсциссу ' + IntToStr(i+1)+' квадрата','0'));
C[I].y:=StrToFloat(InputBox('Ввод данных','Введите ординату ' + IntToStr(i+1)+' квадрата','0'));
C[I].r:=StrToFloat(InputBox('Ввод данных','Введите длину сторон ' + IntToStr(i+1)+' квадрата','0'));
PaintBox1.Canvas.Rectangle(Round(C[I].x),Round(C[I].y),Round(C[I].x + C[i].r),Round(C[I].y + C[i].r));
end;
for i := Low(C) to High(C)-1 do
for j := i+1 to High(C) do
if Peres(C[i],C[j]) then
Memo1.Lines.Add(IntToStr(i+1)+','+IntToStr(j+1)+' Пересекающиеся квадраты');
if Memo1.Lines.Count <= 0 then
Memo1.Lines.Add('Таких пересекающихся квадратов нет');
Finalize(C);
end;
procedure TForm1.Lf1Click(Sender: TObject);
begin
ShowMessage('стороны');
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
Edit1.Text:='';
Memo1.Clear;
end;
function TForm1.Peres(a,b: tCube):Boolean;
begin
if
((a.x = b.x + b.r) and (a.y = b.y + b.r)) or
((a.x + a.r = b.x) and (a.y = b.y + b.r)) or
((a.x = b.x+b.r) and (a.y + a.r = b.y)) or
((a.x + a.r = b.x) and (a.y + a.r = b.y))
then
Peres:=True else Peres:=False;
end;
end.

Это нахождение сторон параллельных оси. Мне ещё нужно добавить нахождение диагоналей оси.
Кто знает помогите пожалуйста.

[evg_m]

Мои наработки:

к ЧЕМУ?

нахождение диагоналей оси.

что есть диагональ линии? А ось это есть линия.

[Эцио]

Ээээ... Что? Я не понимаю вопрос.
Мне нужно прокомментировать код что-ли?

[Serge_Bliznykov]

Сообщение от Эцио

Я не понимаю вопрос.

задание какое?

и в чём, собственно вопрос?

[Эцио]

Сообщение от Serge_Bliznykov

задание какое?

и в чём, собственно вопрос?

На плоскости имеется N квадратов с диагоналями, параллельными осям координат. Найти все пары, пересекающиеся в одной точке.

[Serge_Bliznykov]

так. задание понятно.

хочу уточнить. что такое "пересекающиеся в одной точке" ?
может быть, вопрос звучит "имеющие хотя бы одну ОБЩУЮ точку"?

[Serge_Bliznykov]

вопрос про пересечения особенно актуален после того, как я посмотрел работу вашей программы:

primer_square.png

если что, вот код, которым я это проверил:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TSquare = record
    x, y, r: Double;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    function Peres(a, b: TSquare): Boolean;
    procedure Lf1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  primerArray: array[0..3] of TSquare =
  (
    (x: 22; y: 32; r: 20),
    (x:100; y:100; r:300),
    (x: 10; y: 10; r: 300),
    (x: 20; y: 20; r: 100)
  );
var C: array of TSquare;
  i, j, n, d: Integer;
begin
  Memo1.Lines.Clear;
  //n:=StrToInt(Edit1.Text);
  n := Length(primerArray); Edit1.Text := IntToStr(n);
  SetLength(C, n);
  PaintBox1.Canvas.Brush.Style := bsClear;
  for i := Low(C) to High(C) do
  begin
    C[i] := primerArray[i];
    (*C[I].x := StrToFloat(InputBox('Ввод данных', 'Введите абсциссу ' + IntToStr(i + 1) + ' квадрата', '0'));
    C[I].y := StrToFloat(InputBox('Ввод данных', 'Введите ординату ' + IntToStr(i + 1) + ' квадрата', '0'));
    C[I].r := StrToFloat(InputBox('Ввод данных', 'Введите длину сторон ' + IntToStr(i + 1) + ' квадрата', '0'));
    *)
    PaintBox1.Canvas.Rectangle(Round(C[I].x), Round(C[I].y), Round(C[I].x + C[i].r), Round(C[I].y + C[i].r));
  end;
  for i := Low(C) to High(C) - 1 do
    for j := i + 1 to High(C) do
      if Peres(C[i], C[j]) then
        Memo1.Lines.Add(IntToStr(i + 1) + ',' + IntToStr(j + 1) + ' Пересекающиеся квадраты');
  if Memo1.Lines.Count <= 0 then
    Memo1.Lines.Add('Таких пересекающихся квадратов нет');
  Finalize(C);
end;

procedure TForm1.Lf1Click(Sender: TObject);
begin
  ShowMessage('стороны');
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  Edit1.Text := '';
  Memo1.Clear;
end;

function TForm1.Peres(a, b: TSquare): Boolean;
begin
  if
    ((a.x = b.x + b.r) and (a.y = b.y + b.r)) or
    ((a.x + a.r = b.x) and (a.y = b.y + b.r)) or
    ((a.x = b.x + b.r) and (a.y + a.r = b.y)) or
    ((a.x + a.r = b.x) and (a.y + a.r = b.y))
    then
    Peres := True else Peres := False;
end;

end.

исходники проекта: SquareCrossed.rar

[evg_m]

может быть, вопрос звучит "имеющие хотя бы одну ОБЩУЮ точку"?

Найти все пары, пересекающиеся в одной точке.

Имеющие РОВНО одну общую точку.
Для квадратов имеющих параллельные стороны такое возможно только для ОБЩЕЙ вершины и "диагонального" расположения.
диагональное для квадратов со сторонами параллельными осям это

a -  - a  b -  - b
- b  b -  - a  a -

[Serge_Bliznykov]

Сообщение от evg_m

Имеющие РОВНО одну общую точку.

ага. согласен.


вот только сравнивать вещественные числа на равенство с помощью = нельзя!

[Serge_Bliznykov]

А вот вариант для квадратов, диагонали которых расположены параллельно осям координат:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TSquare = record
    x, y, diag: Double;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    function Peres(a, b: TSquare): Boolean;
    procedure Lf1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  primerArray: array[0..4] of TSquare =
  (
    (x: 60; y: 160; diag: 100),
    (x: 160; y: 160; diag: 100),
    (x: 260; y: 160; diag: 100),
    (x: 10; y: 310; diag: 200),
    (x: 60; y: 460; diag: 100)
  );
var C: array of TSquare;
  i, j, n, d: Integer;
begin
  Memo1.Lines.Clear;
  //n:=StrToInt(Edit1.Text);
  n := Length(primerArray); Edit1.Text := IntToStr(n);
  SetLength(C, n);
  PaintBox1.Canvas.Brush.Style := bsClear;
  for i := Low(C) to High(C) do
  begin
    C[i] := primerArray[i];
    (*C[I].x := StrToFloat(InputBox('Ввод данных', 'Введите абсциссу крайней левой вершины ' + IntToStr(i + 1) + ' квадрата', '0'));
    C[I].y := StrToFloat(InputBox('Ввод данных', 'Введите ординату крайней левой вершины ' + IntToStr(i + 1) + ' квадрата', '0'));
    C[I].diag := StrToFloat(InputBox('Ввод данных', 'Введите длину диагонали ' + IntToStr(i + 1) + ' квадрата', '0'));
    *)
    PaintBox1.Canvas.Polygon([Point(Round(C[I].x), Round(C[I].y)),Point(Round(C[I].x+C[i].diag/2), Round(C[I].y-C[i].diag/2)),
       Point(Round(C[I].x+C[i].diag), Round(C[I].y)),Point(Round(C[I].x+C[i].diag/2), Round(C[I].y++C[i].diag/2))]);
  end;
  for i := Low(C) to High(C) - 1 do
    for j := i + 1 to High(C) do
      if Peres(C[i], C[j]) then
        Memo1.Lines.Add(IntToStr(i + 1) + ',' + IntToStr(j + 1) + ' Пересекающиеся квадраты');
  if Memo1.Lines.Count <= 0 then
    Memo1.Lines.Add('Таких пересекающихся квадратов нет');
  Finalize(C);
end;

function isEqual(a,b : Double ) : boolean;
begin
  isEqual := abs(a-b)<0.00001;
end;

function TForm1.Peres(a, b: TSquare): Boolean;
begin
   Peres := (isEqual( a.x, b.x+b.diag ) and isEqual( a.y, b.y ))
             or
            (isEqual( a.x+a.diag/2, b.x+b.diag/2 ) and isEqual( a.y-a.diag/2, b.y+b.diag/2 ))
             or
            (isEqual( a.x+a.diag, b.x ) and isEqual( a.y, b.y ))
             or
            (isEqual( a.x+a.diag/2, b.x+b.diag/2 ) and isEqual( a.y+a.diag/2, b.y-b.diag/2 ))
end;