analogicznie do pozostałych dwóch par.
Dla kolejnego trójkąta powtórzyć od pkt 2.
Kopiuj
unit TriangleAroundPointsMain;
{$mode objfpc}{$H+}
interface uses
Classes,
SysUtils,
FileUtil,
Forms,
Controls,
Graphics,
Dialogs,
ExtCtrls;
type
TPointArray=array of TPoint;
TATriangleAroundPoint = class(TForm)
procedure FormClick(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
arr:TPointArray;
a,b,c:TPoint;
public
function RandRect:TRect;
procedure RandPoints(Size:Integer);
procedure RandTriangle;
end;
var ATriangleAroundPoint:TATriangleAroundPoint;
implementation
{$R *.lfm}
function RandPoint(const Rect:TRect):TPoint;
begin
Result.x:=Rect.Left+Random(Rect.Right-Rect.Left+1);
Result.y:=Rect.Top+Random(Rect.Bottom-Rect.Top+1);
end;
procedure RandPointArray(var arr:TPointArray;const Rect:TRect;Size:Integer);
var I:Integer;
begin
SetLength(arr,Size);
for I:=0 to Size-1 do arr[i]:=RandPoint(Rect);
end;
function DistancePointFromLine(const P,A,B:TPoint):Double;
var dx,dy,sdx,sdy,qx,qy,qdx,qdy:Integer;
begin
dx:=B.x-A.x; dy:=B.y-A.y;
qx:=P.x-A.x; qy:=P.y-A.y;
sdx:=dx*dx; sdy:=dy*dy;
qdx:=qy*dx-qx*dy;
qdy:=qx*dy-qy*dx;
Result:=Sqrt(0.25*qdx*qdx*sdy+0.25*qdy*qdy*sdx)/(sdy+sdx);
if qdy<0 then Result:=-Result;
end;
procedure ShiftLineByValue(const a,b:TPoint;V:Double;out ap,bp:TPoint);
var dx,dy:Integer;
var Len:Double;
begin
dx:=b.x-a.x;
dy:=b.y-a.y;
Len:=V*Sqrt(dy*dy+dx*dx);
ap:=Point(Round((dy*a.x+Len)/dy),Round((dx*a.y-Len)/dx));
bp:=Point(Round((dy*b.x+Len)/dy),Round((dx*b.y-Len)/dx));
end;
function CrossLines(const a,b,c,d:TPoint):TPoint;
var bax,bay,dcx,dcy,qab,qdc:Integer;
begin
bax:=b.x-a.x;
bay:=b.y-a.y;
dcx:=d.x-c.x;
dcy:=d.y-c.y;
qab:=b.x*a.y-b.y*a.x;
qdc:=d.x*c.y-d.y*c.x;
Result:=Point
(
Round((bax*qdc-dcx*qab)/(bay*dcx-dcy*bax)),
Round((dcy*qab-bay*qdc)/(dcy*bax-bay*dcx))
);
end;
function TATriangleAroundPoint.RandRect:TRect;
var sx,sy,mx,my:Integer;
begin
sx:=(ClientWidth)shr(1);
sy:=(ClientHeight)shr(1);
mx:=(sx)shr(2);
my:=(sy)shr(2);
Result:=Rect(sx-mx,sy-my,sx+mx,sy+my);
end;
procedure TATriangleAroundPoint.RandPoints(Size:Integer);
begin
RandPointArray(arr,RandRect,Size);
end;
procedure TATriangleAroundPoint.RandTriangle;
var ab,bc,ca,d:Double;
var pca,pcb,pab,pac,pbc,pba:TPoint;
var I:Integer;
var R:TRect;
begin
R:=RandRect;
while ((a.x=b.x)and(a.y=b.y))or((a.x=c.x)and(a.y=c.y))or((b.x=c.x)and(b.y=c.y)) do
begin
a:=RandPoint(R);
b:=RandPoint(R);
c:=RandPoint(R);
end;
ab:=0;
bc:=0;
ca:=0;
for I:=0 to Length(arr)-1 do
begin
d:=DistancePointFromLine(arr[i],a,b);
if ab<d then ab:=d;
d:=DistancePointFromLine(arr[i],b,c);
if bc<d then bc:=d;
d:=DistancePointFromLine(arr[i],c,a);
if ca<d then ca:=d;
end;
ShiftLineByValue(a,b,ab,pca,pcb);
ShiftLineByValue(b,c,bc,pab,pac);
ShiftLineByValue(c,a,ca,pbc,pba);
a:=CrossLines(pbc,pba,pca,pcb);
b:=CrossLines(pca,pcb,pab,pac);
c:=CrossLines(pab,pac,pbc,pba);
end;
procedure TATriangleAroundPoint.FormClick(Sender: TObject);
begin
RandTriangle;
Invalidate;
end;
procedure TATriangleAroundPoint.FormDblClick(Sender: TObject);
begin
RandPoints(20);
RandTriangle;
Invalidate;
end;
procedure TATriangleAroundPoint.FormPaint(Sender: TObject);
var I:Integer;
begin
Canvas.Brush.Style:=bsClear;
Canvas.Pen.Style:=psSolid;
Canvas.Pen.Width:=1;
Canvas.Pen.Color:=clSkyBlue;
Canvas.MoveTo(A.x,A.y);
Canvas.LineTo(B.x,B.y);
Canvas.LineTo(C.x,C.y);
Canvas.LineTo(A.x,A.y);
Canvas.Pen.Style:=psClear;
Canvas.Brush.Style:=bsSolid;
Canvas.Brush.Color:=clBlack;
for I:=0 to Length(arr)-1 do Canvas.Ellipse(arr[I].x-2,arr[I].y-2,arr[I].x+3,arr[I].y+3);
Canvas.Brush.Color:=clRed;
Canvas.Ellipse(A.x-2,A.y-2,A.x+3,A.y+3);
Canvas.Brush.Color:=clBlue;
Canvas.Ellipse(B.x-2,B.y-2,B.x+3,B.y+3);
Canvas.Brush.Color:=clGreen;
Canvas.Ellipse(C.x-2,C.y-2,C.x+3,C.y+3);
end;
initialization
Randomize;
end.
Pod Delphi też powinno działać bez problemów.