if PointsInSquare.Count = 0 then
continue
else
//Иначе берем один из углов как базовый
BasePoint := TRealPoint(PointsInSquare[0]);
//Добавим в список пересечения первой стороны с контурами
// if CornerInSquare[1] or CornerInSquare[2] then
Contours.AddLineIntersections(CurX, CurY, CurX, NewY, Model, PointsInSquare);
//Добавим в список пересечения второй стороны с контурами
// if CornerInSquare[1] or CornerInSquare[4] then
Contours.AddLineIntersections(CurX, CurY, NewX, CurY, Model, PointsInSquare);
//Добавим в список пересечения третьей стороны с контурами
// if CornerInSquare[2] or CornerInSquare[3] then
Contours.AddLineIntersections(CurX, NewY, NewX, NewY, Model, PointsInSquare);
//Добавим в список пересечения четвертой стороны с контурами
// if CornerInSquare[3] or CornerInSquare[4] then
Contours.AddLineIntersections(NewX, CurY, NewX, NewY, Model, PointsInSquare);
//Если в результате в квадрате получилось меньше трех точек - треугольников не строим
if PointsInSquare.Count < 3 then
continue;
//Иначе удалим из списка базовую точку
PointsInSquare.Remove(BasePoint);
//отсортируем остальные по углу относительно базовой точки
if (BasePoint.X = CurX)and(BasePoint.Y = CurY) then
begin
__X := CurX+1;
__Y := CurY;
end
else
begin
__X := BasePoint.X;
__Y := BasePoint.Y;
end;
// if (BasePoint.X <> NewX)or(BasePoint.Y <> NewY) then continue;
PointsInSquare.Sort(@DistCompare);
//И заполним квадрат треугольниками
for I := 0 to PointsInSquare.Count - 2 do
Model.AddTria(BasePoint, TRealPoint(PointsInSquare[I]), TRealPoint(PointsInSquare[I+1]));
end;
end;
PointsInSquare.Free
end;
{ TContour }
function TContour.Inside(aX, aY: Extended; WithEdge: boolean): boolean;
var
A, B: Extended;
begin
A := GetMinY;
B := GetMaxY;
if WithEdge then
begin
A := A - 0.01;
B := B + 0.01;
end
else
begin
A := A+0.01;
B := B - 0.01;
end;
if not InRange(aY, A, B) then
Result := false
else
begin
A := GetX(aY, True);
B := GetX(aY, False);
if WithEdge then
begin
A := A - 0.01;
B := B + 0.01;
end
else
begin
A := A+0.01;
B := B - 0.01;
end;
Result := InRange(aX, A, B);
end;
end;
function TContour.IntersectLine(X1, X2, Y1, Y2: Extended; var X, Y: Extended): boolean;
var
A: Extended;
begin
// Result := false;
if Y1 = Y2 then
begin
Result := InRange(Y1, GetMinY, GetMaxY);
if not Result then exit;
if X1 > X2 then
SwapReal(X1, X2);
A := GetX(Y1, True);
if InRange(A, X1, X2)then
begin
Result := True;
X := A;
Y := Y1;
exit
end;
A := GetX(Y1, False);
if InRange(A, X1, X2)then
begin
Result := True;
X := A;
Y := Y1;
exit
end;
Result := false;
end
else
begin
//X1=X2
if Y1 > Y2 then
SwapReal(Y1, Y2);
A := GetY(X1, True);
if InRange(A, Y1, Y2)then
begin
Result := True;
X := X1;
Y := A;
exit
end;
A := GetY(X1, False);
if InRange(A, Y1, Y2)then
begin
Result := True;
X := X1;
Y := A;
exit
end;
Result := false;
end;
end;
{ TContours }
procedure TContours.AddLineIntersections(X1, Y1, X2, Y2: Extended; ToModel: TModel; List: TList);
var
X, Y: Extended;
P: TRealPoint;
I: Integer;
begin
if Outer.IntersectLine(X1, X2, Y1, Y2, X, Y) and Inside(X, Y) then
begin
P := ToModel.AddVertex(X, Y);
List.Add(P);
end;
for I := 0 to Length(Inner) - 1 do
if Inner[I].IntersectLine(X1, X2, Y1, Y2, X, Y) and Inside(X, Y) then
begin
P := ToModel.AddVertex(X, Y);
List.Add(P);
end;
end;
constructor TContours.Create(aOuter: TContour; aInner: array of TContour);
var
I: Integer;
begin
inherited Create;
Outer := aOuter;
SetLength(Inner, length(aInner));
for I := 0 to Length(Inner)- 1 do
Inner[I] := aInner[I+Low(aInner)];
end;
function TContours.Inside(X, Y: Extended): boolean;
var
I: Integer;
begin
Result := False;
if not Outer.Inside(X,Y, True) then
exit;
for I := Low(Inner) to High(Inner) do
if Inner[I].Inside(X,Y, False) then
exit;
Result := True;
end;
end.
Скриншот программы:
Вывод: Изучили основы моделирования физических и технических систем. В результате сравнения метода конечных разностей и конечных элементов, метод конечных элементов более точный и быстрый.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.