Подчсет количества многоугольников

← →
bogdan (2005-08-27 17:54) [0]

Привет, и вновь я со своими вопросами. У меня задание : нужно на image построить n прямых и посчитать все многоугольники , которые появились и закрасить их разными цветами. Вот я сделал расстановку прямых и вроде рассчет количества многоугольников, но он почему то не пашет. Может вы проверите.
алгоритм подсчета придумал следующий. есть массив координат точек создающих прямые.
через функцию yx(x,x1,..):real узнаю значение функции в даной точке графика и сравниваю со значением функции из массива в той же точке.
я посчитал что если одна прямаяя пересекает n прямых то создается n+1 многоугольников. а если не пересекает так логично +1. А почему не работает не знаю. вот то что я натворил.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Edit1: TEdit;
Edit2: TEdit;
procedure FormCreate(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public

{ Public declarations }
end;
TPointReal= packed record
x1,x2,y1,y2:real;
end;
function yx(x,x1,x2,y1,y2:real):real;
function peret(y1,y2:real):boolean;
var
Form1: TForm1;
KPr,ktoch,ktoch1:integer;
par:array [1..10] of TPointReal;
xper,yper,x1,x2,y1,y2:real;
a,b,c,d:integer;
implementation

{$R *.DFM}
function peret(y1,y2:real):boolean;
begin
result:=false;
if y1=y2 then result:=true;
end;
function yx(x,x1,x2,y1,y2:real):real;
begin
result:=0;
if x2<>x1 then
result:=x*((y2-y1)/(x2-x1))+ ((y2*x2-2*x1*y2+x1*y1)/(x2-x1));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.Canvas.Create;
a:=0;b:=Image1.Picture.Width;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var i,k,j:integer;

begin
try
KPr:=strtoint(Edit2.Text);
except on EConvertError do
begin
MessageDlg("Error",mtError,[mbOK],0);
end;
end;
ktoch:=0;
ktoch1:=0;
// dali perevirjajemo 4y je spilni to4ky elementiv masyvu

for i:=1 to KPr-1 do
begin
for j:=i+1 to KPr do
begin
ktoch1:=0;
for k:=a to b do
begin // сравниваем значения в одинаковых точках
y1:=yx(k,par[i].x1,par[i].x2,par[i].y1,par[i].y2);
y2:=yx(k,par[j].x1,par[j].x2,par[j].y1,par[j].y2);
if peret(y1,y2) then begin
xper:=k;
yper:=trunc(y1);
ktoch1:=ktoch1+1;// количество пересекаемых прямых i-той прямой
end; //if
end;//k:=a
end; //j
if ktoch1=0 then ktoch:=ktoch+1 else // сумарное количество многоугольников
ktoch:=ktoch1+1;
end; //i
edit1.Text:=inttostr(ktoch);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var i:integer;
x1p,x2p,y1p,y2p:integer;
s,ss:integer;
begin
KPr:=strtoint(edit2.text);
Image1.Canvas.Rectangle(0,0,image1.Picture.Width,image1.Picture.Height);
randomize;
for i:=1 to kpr do
begin
s:=random(4);
edit1.Text:=inttostr(s);
case s of
0: begin
x1p:=0;
y1p:=random(289);
end;
1: begin
x1p:=random(473);
y1p:=0;
end;
2: begin
x1p:=483;
y1p:=random(289);
end;
3: begin
x1p:=random(473);
y1p:=289;
end;
end;
repeat
ss:=random(4);
until s<>ss;
case ss of
0: begin
x2p:=0;
y2p:=random(289);
end;
1: begin
x2p:=random(473);
y2p:=0;
end;
2: begin
x2p:=473;
y2p:=random(289);
end;
3: begin
x2p:=random(473);
y2p:=289;
end;
end;
par[i].x1:=x1p;
par[i].x2:=x2p;
par[i].y1:=y1p;
par[i].y2:=y2p;
Image1.Canvas.MoveTo(x1p,y1p);
Image1.Canvas.LineTo(x2p,y2p);
end;
end;

end.

← →
bogdan (2005-08-28 11:49) [1]

allo

слушаю вас

Подчсет количества многоугольников Найти похожие ветки