Листинг модуля формы и комментарии для программы построения жадной триангуляция

   

Листинг модуля формы unit1.pas

Комментарии

unil Unit);

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls. Forms, Dialogs, ExtCtrls, StdCtrls, Spin;

type
TForm1 =class(TForm)
Image1: TImage;
SpinEdit): TSpinEdit;
Label1: TLabel;
Button1: TButton;
Memo1: TMemo;
Button2. TButton;
Memo2: TMemo;
Button3: TButton.
procedure FormCreate(Sender: TObject);
procedure lmage1MouseMove(Sender: TObject; Shift:
TShiftState; X,
Y. Integer);
procedure Image1Click(Sender: TObject);
procedure Button1Cltck(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button.3Click(Sender: TObject);

 

Private
{ Private declarations }
public
{ Public declarations }
procedure sort(1,r: integer);
end:

var
Form1: TForm1;
pts: array [1 ..100] of TPoint;
MouseX, MouseY, n, ko1_rasst: integer;
rasstord: array [1..100, 1..3] of integer;

implementation

{$R *.dfm}

 

 

Image1.Canvas.Fillrect(r);
end;

procedure TForm1.Image1MouscMove(Sender: TObject: Shift: TShiftState; X,
Y: Integer);
begin
MouseX:=X;
MouseY:=Y;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
n:=SpinEdit1.Value;
inc(n);
SpinEdit1.Value:=n;
Image1.Canvas.Brush.Color:=clBlack;
Tmage1.Canvas.Brush.Style:=bsSolid;
pts[n].x:= MouseX;
pts[n].y:=MouseY;
Image1.Canvas.Ellipse(pts[n].x- 2,pts[n].y-2,pts[n].x+2,pts[n].y+2);
Image1.Canvas.Brush.Style=bsClear;
Button1. Enabled:=true;
end;

procedure TForm1.sort(1,r: integer);
var
i,j,x: integer;
w: TPoint;
begin
i:=l;
j:=r;
x:=pts[(1+r) div 2].x;
repeat
while pts[t].x<x do inc(i);
while pts[j].x>x do dec(j);
if i<=j then begin
w:=pts[i];
pts[i]:=pts[j];
pts[j]:=w;
inc(i);
dec(t):
end
until i>j;
if 1<j then sort(1,j);
if i<r then sort(i,r);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i,j,k, rasst: integer;
begin
Image1.Enabled:=false;
sort(1,n);
for t:=1 to n do
Image1.Canvas.TcxtOut(pts[i].x,pts[i].y, IntToStr(i));
ko1_rasst:=0;

 

for i:=1 to n-1 do
for j:=i+1 to n do begin
rasst:=round(sqrt(sqr(pts[j].x-pts[i].x)+sqr(pts[ j].y-pts[i].y)));
inc(ko1_ rasst);
rasstOrd[ko1_ rasst,1]:=i;
rasstOrd[ko1_ rasst,2]:-j;
rasstOrd[ko1_ rasst,3]:=rasst;
end;
Button1.Enabled:=false;
Button2.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i, j, min. k1, k2, k3: integer;
begin
for i:=1 to ko1_rasst-1 do begin
min:=1;
for j:=i+1 to ko1_rasst do
if rasstOrd[I,3]>rasstOrd[j,3] then begin
k1:=rasstOrd[i,1];
k2:=rasstOrd[i,2];
k3:=rasstOrd[i,3];
rasstOrd[i,1]:=rasstOrd[j,1];
rasstOrd[i,2]:=rasstOrd[j,2];
rasstOrd[i,3]:=rasstOrd[j,3];
rasstOrd[j,1]:=k1;
rasstOrd[j,2]:=k2;
rasstOrd[j,3]:=k3;
end;
end;
Button2.Enabled:=false;

 

Button3.Enabled:=true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
i, j: integer;
ti, tj: double;
chisl_i, chisl_ j, znam: integer;
per: boolean;

 

 

begin
Image1.Canvas.MoveTo(pts[rasstOrd[1,1]].x,pts[rasstOrd[1,1]].y);
Image1.Canvas.LineTo(pts[rasstOrd[1,2]].x,pts[rasstOrd[1,2]].y);
for i:=2 to ko1_rasst do begin
per:=false;
for j:=i-1 downto 1 do begin
chisl_i:=(pts[rasstOrd[j,2]].x-pts[rasstOrd[j,1]].x)*(pts[rasstOrd[i,1]].y-pts[rasstOrd[j,1]].y)-(pts[rasstOrd[j,2]].y-pts[rasstOrd[j,l]].y)*(pts[rasstOrd[i,l]].x-pts[rasstOrd[j,1]].x);
chisl_j:=(pts[rasstOrd[i,2]].x-pts[rasstOrd[i,1]].x)*(pts[rasstOrd[i,1]].y-pts[rasstOrd[j,1]].y)-(pts[rasstOrd[i,2]].y-pts[rasstOrd[i,l]].y)*(pts[rasstOrd[i,l]].x-pts[rasstOrd[j,1]].x);
znam:=(pts[rasstOrd[j,2]].y-pts[rasstOrd[ j,l]].y)*(pts[rasstOrd[i,2]].x-pts[rasstOrd[i,1]].x)-(pts[rasstOrd[j,2]].x-pts[rasstOrd[j,1]].x)*(pts[rasstOrd[i,2]].y-pts[rasstOrd[i,l]].y);
ti:=chisl_i/znam;
tj:=chisl_j/znam;
tf(ti>0)and(ti<l))and((tj>0)and(tj<l))then begin
per:=true;
break;
end;
end;
if not per then begin
Image1.Canvas.MoveTo(pts[rasstOrd[i,l]].x,pts[rasstOrd[i,1]].y);
Image1.Canvas.LineTo(pts[rasstOrd[ i,2]].x.pts[rasstOrd[i,2]].y):
end;
end;
end;

end;

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

{Сортировка множества точек с 1 элемента по rметодом быстрой сортировки Хоара}

 

{pts – массив координат проставленных точек (х, у);
MouseX, MouseY соответствующие координаты (х, у) при щелчке мыши;
n - количество точек;
kol_ rasst - количество
расстояний между точками (ребер триангуляции);
rasstOrd  массив, содержащий информацию
о вершинах и расстоянии между ними}
{Процедура заливки
белым цветом прямоугольника, соответствующего размерам объекта Image1}

 

 

{Процедура события
MouseMove для фиксирования экранных координат проставляемых точек}

 

{Процедура, отвечающая за проставление точек щелчком мыши на
объекте Image1 и запись координат точек в массив pts}

 

 

 

{Непосредственная реализация сортировки
множества точек с 1-го
элемента по r (от левого края к правому) методом быстрой сортировки Хоара}

 

 

{rasst   расстояний между двумя точками}
{Сортируем исходное
множество точек по абсциссе}

{Подписываем номера отсортированных точек}
{Количество расстояний,
т.е. ребер триангуляции,
первоначально равно 0}

{Перебор всевозможных
ребер; подсчет расстояний между соответствующими вершинами;
формирование массива
rasstOrd. элементы которого содержат информацию о вершинах и расстоянии между ними}

 

 

{Сортировка ребер по возрастанию расстояний стандартным образом}

 

 

 

 

{Построение жадной
триангуляции}

{ti, tj - параметры соответствующих отрезков
прямых; chisl_i, chisl_j.
znam-соответствующие числители и знаменатель для нахождения
параметров; per- переменная для фиксирования наличия пересечения отрезков}

 

{Первое (наименьшее)
ребро включаем в триангуляцию}

{Начиная со второго,
если оно не пересекается с уже включенными
в триангуляцию ребрами, вставляем его в триангуляцию}