Основы компьютерного моделирования физических и технических систем. Основы моделирования физических и технических систем, страница 7

for i := 1 to n-1 do

for j := i+1 to n do

begin

h := -a[j,i]/a[i,i];

for k := 1 to n do

a[j,k] := a[j,k]+h*a[i,k];

for k := 1 to n do

InvA[j, k] := InvA[j,k]+h*InvA[i,k];

end;

//Обратный ход - приведение к единичной матрице

for i:= n downto 1 do

begin

for j:= 1 to n do

InvA[i, j] := InvA[i,j]/a[i,i];

a[i,i]:=1;

for j:=1 to i-1 do

begin

h := -a[j,i];

for k := 1 to n do

a[j,k] := a[j,k]+h*a[i,k];

for k :=1 to n do

InvA[j, k] := InvA[j,k]+h*InvA[i,k];

end;

end;

End;

end.

unit uTessel;

interface

uses Math, uModel, Classes, Graphics;

type

//Класс Контур - абстрактный класс контура (окружности или квадрата)

TContour = class

//Функция возвращает координату X по заданной Y.

//Если IsFirst=True, возвращается меньшая из двух точек пересечения, иначе - большая

function GetX(aY: Extended; IsFirst: boolean): Extended; virtual; abstract;

//Функция возвращает координату Y по заданной X.

//Если IsFirst=True, возвращается меньшая из двух точек пересечения, иначе - большая

function GetY(aX: Extended; IsFirst: boolean): Extended; virtual; abstract;

//Функция возвращает минимальную координату Y

function GetMinY: Extended;virtual; abstract;

//Функция возвращает максимальную координату Y

function GetMaxY: Extended;virtual; abstract;

//Функция возвращает минимальную координату X

function GetMinX: Extended;virtual; abstract;

//Функция возвращает максимальную координату X

function GetMaxX: Extended;virtual; abstract;

//Функция возвращает True, если точка внутри контура

function Inside(aX, aY: Extended; WithEdge: boolean): boolean;

//Функция возвращает True, если контур пересекает линию x1y1-x2y2

function IntersectLine(X1, X2, Y1, Y2: Extended; var X, Y: Extended): boolean;virtual;

//Функция рисует контур

procedure Draw(C: TCanvas; Scale: Extended);virtual; abstract;

end;

{  TPolygon = class(TContour)

Points: array of TRealPoint;

constructor Create(aData: array of TRealPoint);

procedure AddPoint(aX, aY: Real);

function GetX(aY: Real; IsFirst: boolean): Real; override;

function GetMinY: Real;override;

function GetMaxY: Real;override;

end;}

//Класс окружность - переопределяет некоторые методы класса контур

TCircle = class(TContour)

CenterX, CenterY, Radius: Extended;

constructor Create(aX0, aY0, aR: Extended);

function GetX(aY: Extended; IsFirst: boolean): Extended; override;

function GetY(aX: Extended; IsFirst: boolean): Extended; override;

function GetMinY: Extended;override;

function GetMaxY: Extended;override;

function GetMinX: Extended;override;

function GetMaxX: Extended;override;

procedure Draw(C: TCanvas; Scale: Extended);override;

end;

//Класс квадрат - переопределяет некоторые методы класса контур

TSquare = class(TContour)

Top, Left, Bottom, Right: Extended;

constructor Create(X1, Y1, X2, Y2: Extended);

function GetX(aY: Extended; IsFirst: boolean): Extended; override;

function GetY(aX: Extended; IsFirst: boolean): Extended; override;

function GetMinY: Extended;override;

function GetMaxY: Extended;override;

function GetMinX: Extended;override;

function GetMaxX: Extended;override;

procedure Draw(C: TCanvas; Scale: Extended);override;

end;

//Класс набор контуров - задает объект как совокупность внешнего контура и некоторого числа внутренних дырок

TContours = class

Outer: TContour;

Inner: array of TContour;

constructor Create(aOuter: TContour; aInner: array of TContour);

function Inside(X, Y: Extended): boolean;

procedure AddLineIntersections(X1, Y1, X2, Y2: Extended; ToModel: TModel; List: TList);

end;

//ГЛАВНАЯ ПРОЦЕДУРА ТЕССЕЛЯЦИИ

procedure Tesselate(Contours: TContours; MinX, MaxX, MinY, MaxY, DX, DY: Extended; Model: TModel);

implementation

uses uSLAU, uMain;

var

__X, __Y: Extended;

function Equals(X, Y: Extended): boolean;

begin

Result := abs(X-Y)<1e-3;

end;

{ TCircle }

constructor TCircle.Create(aX0, aY0, aR: Extended);

begin

inherited Create;

CenterX := aX0;

CenterY := aY0;

Radius := aR;

end;

procedure TCircle.Draw(C: TCanvas; Scale: Extended);

begin

C.Pen.Color := clBlack;

C.Arc(

Round((CenterX-Radius)*Scale),   //X1

Round((CenterY-Radius)*Scale),   //Y1

Round((CenterX+Radius)*Scale),   //X2