evo jos malo :)
:: ovaj kod odredjuje da li se linije presecaju ::
Code:
function Intersect(const x1,y1,x2,y2,x3,y3,x4,y4:Double):Boolean;
var UpperX,UpperY : Double;
LowerX,LowerY : Double;
Ax,Bx,Cx : Double;
Ay,By,Cy : Double;
D,F,E : Double;
begin
Result := false;
Ax := x2 - x1;
Bx := x3 - x4;
if Ax < 0.0 then
begin
LowerX := x2;
UpperX := x1;
end
else
begin
UpperX := x2;
LowerX := x1;
end;
if Bx > 0.0 then
begin
if (UpperX < x4) or (x3 < LowerX) then
Exit;
end
else if (Upperx < x3) or (x4 < LowerX) then
Exit;
Ay := y2 - y1;
By := y3 - y4;
if Ay < 0.0 then
begin
LowerY := y2;
UpperY := y1;
end
else
begin
UpperY := y2;
LowerY := y1;
end;
if By > 0.0 then
begin
if (UpperY < y4) or (y3 < LowerY) then
Exit;
end
else if (UpperY < y3) or (y4 < LowerY) then
Exit;
Cx := x1 - x3;
Cy := y1 - y3;
d := (By * Cx) - (Bx * Cy);
f := (Ay * Bx) - (Ax * By);
if f > 0.0 then
begin
if (d < 0.0) or (d > f) then
Exit;
end
else if (d > 0.0) or (d < f) then
Exit;
e := (Ax * Cy) - (Ay * Cx);
if f > 0.0 then
begin
if (e < 0.0) or (e > f) then
Exit;
end
else if(e > 0.0) or (e < f) then
Exit;
Result := true;
(*
//Simple method, yet not so accurate for certain situations:
Result := (Orientation(x1,y1,x2,y2,x3,y3) <> Orientation(x1,y1,x2,y2,x4,y4))
and
(Orientation(x3,y3,x4,y4,x1,y1) <>
Orientation(x3,y3,x4,y4,x2,y2));
*)
end;
(* End Of SegmentIntersect *)
:: ovaj kod odredjuje gde se presecaju (a samim tim i da li se presecaju) ::
Code:
Procedure IntersectPoint(x1,y1,x2,y2,x3,y3,x4,y4:Double; Var Nx,Ny:Double);
Var R : Double;
dx1,dx2,dx3 : Double;
dy1,dy2,dy3 : Double;
Begin
dx1 := x2 - x1;
dx2 := x4 - x3;
dx3 := x1 - x3;
dy1 := y2 - y1;
dy2 := y1 - y3;
dy3 := y4 - y3;
R:= dx1*dy3 - dy1*dx2;
If R <> 0 Then
Begin
R := (dy2*(x4-x3)-dx3*dy3)/R;
Nx := x1 + R*dx1;
Ny := y1 + R*dy1;
End
Else
Begin
If Collinear(x1,y1,x2,y2,x3,y3) Then
Begin
Nx := x3;
Ny := y3;
End
Else
Begin
Nx := x4;
Ny := y4;
End;
End;
End;
Function Collinear(x1,y1,x2,y2,x3,y3:Double):Boolean;
Begin
Result := (((x2-x1)*(y3-y1)-(x3-x1)*(y2-y1))=0);
End;
(* End Of Collinear *)
izvor: Google :P
i jos ovo (mrzi me da se regujem):
http://codecentral.borland.com...ral/ccweb.exe/listing?id=18220
p.s. tip:
http://www.delphipages.com/tips/index.cfm kao i
http://www.delphiforfun.org/
p.p.s. Geometry Junkyard (trebalo bi pogledati, mada ja nisam :() -
http://www.ics.uci.edu/~eppstein/junkyard/
Laravel Srbija.
[NE PRUŽAM PODRŠKU ZA PHP PREKO PRIVATNIH PORUKA!]
Jos jedna igra - klasicni tetris
Re: Jos jedna igra - klasicni tetris
Re: Jos jedna igra - klasicni tetris
