Курсовой проект - Автоматизация укладки плитки / MyUnit

unit MyUnit;

interface

uses SysUtils, Windows, Dialogs, Math;

const Epsilon = 1e-8; // выставлять в зависимости от точности IReal

type
IReal = Double;
T2DPlate = record
Points : array [0..3] of TPoint;
whole: boolean;
end;
T2DPointPolygon = array of TPoint;
T2DPlateSet = array of T2DPlate;

function Dist(const P1, P2:TPoint): IReal; overload;// расстояние между точками
function GetLineCross // возвращает дополнительно места пересечения (K1 и K2) см. AnyPoint
(const A1,A2, B1,B2: TPoint; var Cross:TPoint; var K1,K2:IReal): Boolean; overload;
function GetPolygonCross(const Points1, Points2:T2DPointPolygon):T2DPointPolygon; overload; // возвращает точки пересечения полигонов
Function PointInPolygon ( A:TPoint; P : array of TPoint; N: integer) : boolean; overload;//проверяет вхождение точки в контур многоугольника
procedure GetPlateArray(const InPointsWall : T2DPointPolygon; // опорные точки стены
const DeltaX, DeltaY, Seam : integer; // Ширина и высота плитки и толщина шва
const ShiftPlatebool : boolean; // смещать четную плитку или нет
var Min, Max : TPoint; // Максимальные и минимальные значения координат точек стены
var OutPlate:T2DPlateSet); overload; // возвращает координаты всех плиткок в массиве



implementation

//-------------------------Dist-------------------------------------------------
function Dist(const P1, P2:TPoint): IReal;
begin
Result := Sqrt(Sqr(P1.X-P2.X) + Sqr(P1.Y-P2.Y));
end;

//-------------------------GetLineCross-----------------------------------------
function GetLineCross(const A1,A2, B1,B2: TPoint; var Cross:TPoint;
var K1, K2:IReal): Boolean;
var Xa,Xb,Xc,Xd,
Ya,Yb,Yc,Yd,
dx1,dy1,dx2,dy2,
D: IReal;
begin
Xa:=A1.X; Ya:=A1.Y;
Xb:=A2.X; Yb:=A2.Y;
Xc:=B1.X; Yc:=B1.Y;
Xd:=B2.X; Yd:=B2.Y;
Result:=False;

dx1:=Xb-Xa; dy1:=Yb-Ya;
dx2:=Xd-Xc; dy2:=Yd-Yc;
D:=dy1*dx2 - dy2*dx1;

if Abs(D) < Epsilon then EXIT;

K2:=(dy1*(Xa-Xc)-dx1*(Ya-Yc))/D;
K1:=(dy2*(Xa-Xc)-dx2*(Ya-Yc))/D;
Cross.X:=round(Xc+dx2*K2);
Cross.Y:=round(Yc+dy2*K2);
Result:=True;
end;

//-------------------------GetPolygonCross--------------------------------------
function GetPolygonCross(const Points1, Points2:T2DPointPolygon):T2DPointPolygon;// возвращает точки пересечения полигонов
var f,g, Num1, Num2, Count:Integer;
K1, K2: IReal;
Cross: TPoint;
begin
SetLength(Result, 0);
Count:=0;
for f:=0 to High(Points1) do
begin
Num1:=(f+1) mod (High(Points1)+1);
for g:=0 to High(Points2) do
begin
Num2:=(g+1) mod (High(Points2)+1);
if GetLineCross(Points1[f], Points1[Num1], Points2[g], Points2[Num2],Cross, K1, K2)
then
if (K1 >= 0.0) and (K1 <= 1.0) and
(K2 >= 0.0) and (K2 <= 1.0) then
begin
if (Num2=0) and (g=length(Points2)-1) then
else begin
Inc(Count);
SetLength(Result, Count);
Result[Count-1] := Cross;
end;
end;
end;
end;
end;

//-------------------------Maxi-------------------------------------------------
function Maxi( Num1, Num2 : integer ) : integer;
begin
If Num1>Num2 then Maxi:=Num1 else Maxi:=Num2;
end;

//-------------------------Mini-------------------------------------------------
function Mini( Num1, Num2 : integer ) : integer;
begin
If Num1<Num2 then Mini:=Num1 else Mini:=Num2;
end;

//-------------------------GetPlateArray----------------------------------------
procedure GetPlateArray(const InPointsWall : T2DPointPolygon; // опорные точки стены
const DeltaX, DeltaY, Seam : integer; // Ширина и высота плитки и толщина шва
const ShiftPlatebool : boolean; // смещать четную плитку или нет
var Min, Max : TPoint; // Максимальные и минимальные значения координат точек стены

var OutPlate:T2DPlateSet); // возвращает координаты всех плиткок в массиве

var i,j,Num1,Num2, DeltaXSeam, DeltaYSeam, shiftPlate : integer;
K1, K2 : IReal;
Cross : TPoint;
fourPoints,tempPoints : T2DPointPolygon;
begin
if Length(InPointsWall)=0 then exit;
for i:=0 to Length(InPointsWall)-1 do // Проверка пересекаются ли стены, если
for j:=0 to Length(InPointsWall)-1 do // да, то выход из подпрограммы с выводом сообщения
begin // так как стены не могу пересекатся
Num1:=(i+1) mod (High(InPointsWall)+1); // иначе продолжаем
Num2:=(j+1) mod (High(InPointsWall)+1);
if (abs(i-j)>1) and (abs(i-j)<Length(InPointsWall)-1) then
if GetLineCross(InPointsWall[i],InPointsWall[Num1],InPointsWall[j],InPointsWall[Num2],Cross,K1,K2) then
if (K1 >= 0.0) and (K1 <= 1.0) and (K2 >= 0.0) and (K2 <= 1.0) then
begin
MessageDlg('Найдены пересекающиеся стены. Необходимо перестроить стены', mtInformation,[mbOk], 0);
exit;
end;
end;
// находим максимальные и минимальные координаты
{Min:=InPointsWall[0];
Max:=InPointsWall[0];
for i:=1 to Length(InPointsWall)-1 do
begin
if Min.X>InPointsWall[i].X then Min.X:=InPointsWall[i].X;
if Min.Y>InPointsWall[i].Y then Min.Y:=InPointsWall[i].Y;
if Max.X<InPointsWall[i].X then Max.X:=InPointsWall[i].X+DeltaX;
if Max.Y<InPointsWall[i].Y then Max.Y:=InPointsWall[i].Y;
end; }
//Min.X:=Min.X+Seam;
//Min.Y:=Min.Y+Seam;
// находим deltaX b deltaY - ширину и высоту плитки с учетом шва
DeltaXSeam:=DeltaX+Seam;
DeltaYSeam:=DeltaY+Seam;
// обнуляем массив для хранения координат плит
//SetLength(OutPlate,0);
SetLength(fourPoints,4);
tempPoints:=InPointsWall;
SetLength(tempPoints,Length(tempPoints)+1);
tempPoints[Length(tempPoints)-1]:=tempPoints[0];
for i:=0 to (abs(Max.X-Min.X) div deltaXSeam) do
for j:=0 to (abs(Max.Y-Min.Y) div deltaYSeam) do
begin
if (j mod 2 = 1) and (ShiftPlatebool)
then ShiftPlate:=DeltaXSeam div 2
else ShiftPlate:=0;
fourPoints[0].X:=Min.X+i*DeltaXSeam-ShiftPlate; //0
fourPoints[0].Y:=Min.Y+j*DeltaYSeam;
fourPoints[1].X:=fourPoints[0].X+DeltaX; //1
fourPoints[1].Y:=Min.Y+j*DeltaYSeam;
fourPoints[2].X:=fourPoints[0].X+DeltaX; //2
fourPoints[2].Y:=fourPoints[0].Y+DeltaY;
fourPoints[3].X:=Min.X+i*DeltaXSeam-ShiftPlate; //3
fourPoints[3].Y:=fourPoints[0].Y+DeltaY;
if Length(GetPolygonCross(fourPoints,tempPoints))>0
then begin
SetLength(OutPlate,Length(OutPlate)+1);
OutPlate[Length(OutPlate)-1].Points[0]:=fourPoints[0];
OutPlate[Length(OutPlate)-1].Points[1]:=fourPoints[1];
OutPlate[Length(OutPlate)-1].Points[2]:=fourPoints[2];
OutPlate[Length(OutPlate)-1].Points[3]:=fourPoints[3];
OutPlate[Length(OutPlate)-1].whole:=false;
end
else
if PointInPolygon(fourPoints[0],InPointsWall,Length(InPointsWall))//<>0
then begin
SetLength(OutPlate,Length(OutPlate)+1);
OutPlate[Length(OutPlate)-1].Points[0]:=fourPoints[0];
OutPlate[Length(OutPlate)-1].Points[1]:=fourPoints[1];
OutPlate[Length(OutPlate)-1].Points[2]:=fourPoints[2];
OutPlate[Length(OutPlate)-1].Points[3]:=fourPoints[3];
OutPlate[Length(OutPlate)-1].whole:=true;
end;
end;
end;

//-------------------------PointInPolygon---------------------------------------
function PointInPolygon(A : TPoint; P : array of TPoint; N : integer) : boolean;
var total,x : real;
i,j : integer;

// функция нахождения угла вектора если нулевой вектор то возвращает -1
// иначе угл в градусах в интервале [0,360)
function PolarAngel(P:TPoint):real;
var theta:real;
begin
if (P.X=0) and (P.Y=0) then begin result:=-1; exit; end;
if (P.X=0) then
begin
if (P.Y>0) then result:=90;
if (P.Y<0) then result:=270;
exit;
end;
theta:=arctan(P.Y/P.X); //находим угол в радианахж
theta:=RadToDeg(theta); // переводим в градусы
if (P.X>0) then
begin
if (P.Y>=0) then result:=theta
else result:=360+theta;
end
else result:=180+theta;
end;

//функция вычисляет и возвращает значение угла со знаком для точки А
//относительно ребра Е. После исключения случая когда точка коллинеарна
// с ребром Е. Функция различает ситуацию из учебника
// Ласло "ВГ и КГ на С++" на рисунке 4.6
function SingleAngel(A:TPoint;eOrg,eDist:TPoint):real;
var v,w:TPoint;
va,wa,x:real;
begin
v.X:=eOrg.X-a.X;
v.Y:=eOrg.Y-a.Y;
w.X:=eDist.X-a.X;
w.Y:=eDist.Y-a.Y;
va:=PolarAngel(v);
wa:=PolarAngel(w);
if (va=-1) or (wa=-1) then begin result:=180; exit; end;
x:=wa-va;
if (x=180) or (x=-180) then result:=180
else
if (x<-180) then result:=x+360
else
if (x>180) then result:=x-360
else result:=x;
end;

begin
total:=0;
for i:=0 to N-1 do
begin
if i<N-1 then j:=i+1
else j:=0;
x:=SingleAngel(A,P[i],P[j]);
if x=180 then // Точка находится на границе
begin result:=true; exit; end;
total:=total+x;
end;
if total<180 then result:=false
else result:=true;
end;

end.