
20.12.2009, 03:41
|
|
Познающий
Регистрация: 19.02.2009
Сообщений: 83
С нами:
9065564
Репутация:
50
|
|
Сообщение от Si{R}ius
Как по четырем вводимым точкам определить, выпуклый ли четырехугольник? (не пересекаются ли его стороны) (Pascal/Delphi)
Тоже нужно было нечто подобное, покопался нашел у себя прогу, переписал немного под твои нужды, вот:
Код:
function Sign(const v:Integer):shortint;
begin Result:=0;if v<0 then Result:=-1
else if v>0 then Result:=1;end;
...
function WhichSide(p,q,r:TPoint):Integer;begin
Result:=Sign((p.x-q.x)*(q.y-r.y)-(p.y-q.y)*(q.x-r.x));end;
...
function Compare(p,q:TPoint):Integer;begin if p.x<q.x then
Result:=-1 else if p.x>q.x then Result:=1 else if p.y<q.y then
Result:=-1 else if p.y>q.y then Result:=1 else Result:=0;end;
...
function Vypukl(p: array of TPoint):boolean;
var i,n,d1,d2,s1,s2,c:Integer;p1,p2,p3:tPoint;
function CheckTriple:Boolean;begin Result:=True;
d1:=compare(p2,p3);if d1=-d2 then inc(c);d2:=d1;
s1:=WhichSide(p1,p2,p3);if s1<>0 then begin if s2=-s1
then begin Result:=False;Exit;end;s2:=s1;end;end;
begin result:=true;s2:=0;c:=0;
n:=Length(p);d2:=Compare(p[0],p[1]);
for i:=0 to High(p)do begin p1:=p[i];
p2:=p[(i+1)mod n];p3:=p[(i+2)mod n];
if not CheckTriple then begin Result:=false;Exit;end;
end;end;
...
var i:tImage; ms:tLabel;
...
procedure TForm1.iClick(Sender: TObject);
var p:array of tPoint; k,m:byte;
begin
m:=4;
setlength(p,m);
for k:=0 to m-1 do begin
p[k].X:=random(i.Width-10)+5;
p[k].Y:=random(i.Height-10)+5;
end;
i.Canvas.FillRect(i.ClientRect);
i.Canvas.Polygon(p);
ms.Caption:='Не выпуклый!';
if Vypukl(p)then ms.Caption:='Выпуклый';
end;
работает, но не 100%но =(
З.Ы. код определения выпуклости я откуда-то скопипастил (непомню уже) и переделал под свои нужды 
|
|
|