задача с прямоугольниками

[ilyha93]

Дано множество прямоугольников. Среди прямоугольников лежащих слева от оси ординат найти наименьший по площади( прямоугольники параллельны друг другу) нужно написать для Delphi... помогите пожалуйста конечно не за бесплатно готов отдать 300-400 рублей

[Serge_Bliznykov]

Дано множество прямоугольников.

решение данной задачи ОЧЕНЬ сильно зависит от того, каким образов заданы прямоугольники...
У Вас есть сведения о том, как они задаются?

[denisbrain]

   TPrm=record
      x1,y1:integer;
      x2,y2:integer;
      x3,y3:integer;
      x4,y4:integer;
   end;

var
  Form1: TForm1;
  Prm:array of TPrm;
  PrmCont:integer;
implementation

{$R *.dfm}
procedure displayR(r:integer); // рисуем прямоугольник
begin
  form1.Canvas.MoveTo(Prm[r].x1,Prm[r].y1);
  form1.Canvas.LineTo(Prm[r].x2,Prm[r].y2);
  form1.Canvas.LineTo(Prm[r].x3,Prm[r].y3);
  form1.Canvas.LineTo(Prm[r].x4,Prm[r].y4);
  form1.Canvas.LineTo(Prm[r].x1,Prm[r].y1);
end;

Function GetS(R:integer):integer;  // Площадь прямоугольника
var
  x2,y2,x1,y1,x4,y4:integer;
  r1,r2:integer;
begin
 x1:=Prm[r].x1;
 y1:=Prm[r].y1;
 x4:=Prm[r].x4;
 y4:=Prm[r].y4;
 x2:=Prm[r].x2;
 y2:=Prm[r].y2;
 r1:=Round(sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)));
 r2:=Round(sqrt((x1-x4)*(x1-x4)+(y1-y4)*(y1-y4)));
 result:=r1*r2;
end;
Function GetMin:integer;
var
  minri,minr,r:integer;
  s:integer;
begin
minri:=-1;
minr:=form1.Width*form1.Height;
for r:=0 to PrmCont-1 do begin
  s:=GetS(r);
 if s<minr then begin
    minr:=s;
    minri:=r;
 end;
 end;
   result:=minri;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x,y:integer;
r1,r2:integer;
x1,y1:integer;
a:integer; // угол наклона блоков
begin
randomize;
form1.Canvas.Rectangle(form1.Canvas.ClipRect);
// создаем массив прямоугольников
PrmCont:=10;
setlength(Prm,PrmCont);
// для формирования блоков паралельно осям каординат (Простой способ)
{for x:=0 to PrmCont-1 do begin
x1:=random(form1.Width-150);y1:=random(form1.Height-150);
r1:=random(100)+25;r2:=random(100)+25;
   Prm[x].x1:=x1;
   Prm[x].y1:=y1;
   Prm[x].x2:=x1+r1;
   Prm[x].y2:=y1;
   Prm[x].x3:=x1+r1;
   Prm[x].y3:=y1+r2;
   Prm[x].x4:=x1;
   Prm[x].y4:=y1+r2;
   displayR(x);
end;}
// для формирования блоков не паралельно осям каординат

a:={45;}random(360); // угол поворота если 45 то паралельно осям каордина
for x:=0 to PrmCont-1 do begin
   x1:=random(form1.Width-150);y1:=random(form1.Height-150);
   r1:=random(100)+25;r2:=random(100)+25;
   //x1:=x*50;y1:=x*50;  // в линейку
   //r1:=r2 // только квадраты
   Prm[x].x1:=round(x1+cos((a+0)*pi/180)*r1);
   Prm[x].y1:=round(y1+sin((a+0)*pi/180)*r2);
   Prm[x].x2:=round(x1+cos((a+90)*pi/180)*r1);
   Prm[x].y2:=round(y1+sin((a+90)*pi/180)*r2);
   Prm[x].x3:=round(x1+cos((a+180)*pi/180)*r1);
   Prm[x].y3:=round(y1+sin((a+180)*pi/180)*r2);
   Prm[x].x4:=round(x1+cos((a+270)*pi/180)*r1);
   Prm[x].y4:=round(y1+sin((a+270)*pi/180)*r2);

   displayR(x);
end;


  // для отображения самых маленьких прямоугольников
   form1.Canvas.Pen.Color:=clred;
   form1.Canvas.Pen.Width:=2;
   caption:='Минимальная плошадь '+inttostr(GetMin)+'  № блока ' +inttostr(GetS(GetMin));
   displayR(GetMin); // отображаем самый маленький прямоугольник
   form1.Canvas.Pen.Width:=1;
   form1.Canvas.Pen.Color:=clblack;


end;

end.

[ilyha93]

прямоугольники заданы 4 точками должны быть параллельны. как я понял должна еще быть ось координат.. ну и найти наименьший по площади

[denisbrain]

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

прямоугольники заданы 4 точками должны быть параллельны. как я понял должна еще быть ось координат.. ну и найти наименьший по площади

функция GetMin - возвращает номер наименьшего по площади прямоугольника.
GetS(index:integer) - площадь index прямоугольника.
Добавил функцию DrawPole; для отображения сетки координат.

[Serge_Bliznykov]

denisbrain, очень рекомендую задуматься на смыслом названия "прямоугольник"!
(например, появлющиеся у Вас в программе ромбы прямоугольниками НЕ ЯВЛЯЮТСЯ)


ну и до кучи - а где у Вас прямоугольники, "лежащие слева от оси ординат " ?



p.s. хотя, безусловно, предложенного Вами примера вполне может хватить TC, чтобы разобраться и написать решение своей задачи

[denisbrain]

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

denisbrain, очень рекомендую задуматься на смыслом названия "прямоугольник"!
(например, появлющиеся у Вас в программе ромбы прямоугольниками НЕ ЯВЛЯЮТСЯ)


ну и до кучи - а где у Вас прямоугольники, "лежащие слева от оси ординат " ?



p.s. хотя, безусловно, предложенного Вами примера вполне может хватить TC, чтобы разобраться и написать решение своей задачи

для перерисовки Прямоугольника

   
Prm[x].x1:=x1+round(cos((a)*pi/180)*r1);
   Prm[x].y1:=y1+round(sin((a)*pi/180)*r1);
   Prm[x].x2:=Prm[x].x1+round(cos((a+90)*pi/180)*r2);
   Prm[x].y2:=Prm[x].y1+round(sin((a+90)*pi/180)*r2);
   Prm[x].x3:=Prm[x].x2+round(cos((a+180)*pi/180)*r1);
   Prm[x].y3:=Prm[x].y2+round(sin((a+180)*pi/180)*r1);
   Prm[x].x4:=Prm[x].x3+round(cos((a+270)*pi/180)*r2);
   Prm[x].y4:=Prm[x].y3+round(sin((a+270)*pi/180)*r2);

[ilyha93]

скажите а вот этот код правильный????

program project1;

uses 
	SysUtils;
const	
	Nmax = 25;
var
	x1,x2,y1,y2,dlina,shirina:array[1..Nmax] of integer;
	i,n:integer;
	min:real;
	
	function test(x1,x2:integer):boolean; //проверяем, лежит ли прямоугольник
	begin								  //справа от оси OY
		if (x1<0) and (x2<0) then
		test:=true
		else
		test:=false;
	end;
	
	procedure storony(x1,x2,y1,y2:integer; 
	var a:integer; var b:integer); //находим длину сторон 
	begin						   //прямоугольника							
		a:=abs(y2-y1);
		b:=abs(x2-x1);
	end;
	
	function ploshad(a,b:integer):integer;//находим площадь треугольника
	begin
		ploshad:=a*b;
	end;
	
begin
	writeln('Vvodite koordinaty vershin prjamougolnika, gde: ');
	writeln('X1-levaja koordonata po osi OX');
	writeln('X2-pravaja koordinata po osi OX');
	writeln('Y1-nizhnjaja koordinata po osi OY');
	writeln('Y2-verhnjaja koordinata po osi OY');
	writeln('********************************************');
	write('Vvedite kolichestvo prjamougolnikov: ');readln(n); //ввод количества прямоугольников
	for i:=1 to n do
	begin
		writeln(i,'-ij prjamougolnik.');
		write('x1: ');readln(x1[i]); //крайняя левая координата по X
		write('x2: ');readln(x2[i]); //крайняя правая координата по X
		write('y1: ');readln(y1[i]); //нижняя координата по Y
		write('y2: ');readln(y2[i]); //верхняя координата по Y
		storony(x1[i],x2[i],y1[i],y2[i],dlina[i],shirina[i]);//записваем длины сторон
	end;													//для очередных введенных
															//координат вершин
															
	min:=32676; //определяем изначально минимальную площадь максимальным значением
	for i:=1 to n do //для типа integer
	if test(x1[i],x2[i]) then //проверяем, лежит ли слева от OY
	if ploshad(dlina[i],shirina[i])<min then //если площадь меньше минимума
	min:=ploshad(dlina[i],shirina[i]); //перезаписываем
	writeln('Minimal`naja ploschad`: ', min);
	readln;
end.

просто у меня нет возможности проверить


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.