Задача триангуляции многоугольника

PolyTri.gif

Задача нахождения площади невыпуклого многоугольника.
Найти площадь невыпуклого многоугольника.
Задача проверки принадлежности точки невыпуклому полигону.
Проверить принадлежит ли точка невыпуклому полигону, заданнному координатами вершин.
Задача разбиения невыпуклого многоугольника на треугольники.
Произвести разбиение невыпуклого многоугольника, заданного координатами вершин на треугольники.

Решение
Алгоритм триангуляции:
1. Берем три вершины A1, A2, A3
2. Проверяем образуют ли вектора A1A3, A1A2 левую тройку векторов (векторное произведение положительно).
3. Проверяем нет ли внутри треугольника A1A2A3 какой-либо из оставшихся вершин многоугольника.
4. Если оба условия выполняются, то строим треугольник A1A2A3, а вершину A2 исключаем из многоугольника, не трогая вершину A1, сдвигаем вершины A2 (A2 на A3), A3 (A3 на A4)
5. Если хоть одно условие не выполняется переходим к следующим трем вершинам.
6. Повторяем с 1 шага, пока не останется три вершины.
триангуляция многоугольника
На рисунке:

  • треугольник A1 A2 A3 удовлетворяет обоим условиям(2,3).
  • треугольник A2 A3 A4 не удовлетворяет условию (2).
  • треугольник A3 A4 A5 не удовлетворяет условию (3).

    Материалы по теме:
    Триангуляция Делоне и её применение. Скворцов А.В.
    Программа

    unit Unit1;
     
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls, StdCtrls;
     
    type
      TListPoints = ^TNodePoint;
      TNodePoint = record
         X,Y  : Integer;
         Next : TListPoints;
      end;
     
     
    type
      TForm1 = class(TForm)
        Panel1: TPanel;
        Panel2: TPanel;
        btDraw: TButton;
        pBox: TPaintBox;
        btTriangle: TButton;
        Panel3: TPanel;
        procedure FormShow(Sender: TObject);
        procedure btTriangleClick(Sender: TObject);
        procedure btDrawClick(Sender: TObject);
        procedure pBoxMouseDown(Sender: TObject; Button: TMouseButton; 
                                                     Shift: TShiftState; X, Y: Integer);
      private
         ListPoints :  TListPoints;   // Однонаправленный циклический список вершин полигона
         //Добавить точку в список
         procedure AddPoint( Node: TListPoints; Var Points: TListPoints);
         // Удалить точку из списка
         procedure DelPoint( Node: TListPoints; Var Points: TListPoints);
         // Нарисовать фигуру полигон
         procedure DrawPolygon( Points: TListPoints);
         // Векторное произведение двух векторов А12 и А13
         function  Det(x1, y1, x2, y2, x3, y3: Integer): Double;
         // Проверить лежит ли точка x,y  внутри треугольника А123
         function  InTriangle(x,y, x1, y1, x2, y2, x3, y3: Integer): Boolean;
      public
      end;
     
    var
      Form1: TForm1;
     
    implementation
     
    {$R *.dfm}
     
    // Процедура триангуляции (разбиение многоугольника на треугольники)
    procedure TForm1.btTriangleClick(Sender: TObject);
    Var p1, p2, p3 : TListPoints;
        inPoint    : Boolean;
        Node       : TListPoints;
    begin
       p1 := ListPoints;
       p2 := p1^.Next;
       p3 := p2^.Next;
       while p3^.next <> p1 do begin    // Цикл, пока не останется три точки
         inPoint := false;              // Проверка не попала ли вершина в отсекаемый треугольник
         Node := p3^.Next;
         while Node <> p1 do begin
           if InTriangle( Node^.x, Node^.Y, p1^.X, p1^.y, p2^.X, p2^.y, p3^.X, p3^.y) then 
              inPoint := true;
           Node := Node^.Next;
         end;
         // Проверка образуют ли вектора левую тройку и не лежит ли вершина внутри треугольника
         if (det(p1^.X, p1^.y, p2^.X, p2^.y, p3^.X, p3^.y) > 0) and (not InPoint) then begin
          // Если условие выполнено, то рисуем треугольник
           pBox.Canvas.Brush.Color := RGB(Random(100)+100,Random(100)+100,Random(100)+100);
           pBox.Canvas.Polygon([Point(p1^.X, p1^.y), Point(p2^.X, p2^.y), Point(p3^.X, p3^.y)]);
           DelPoint(p2, ListPoints);     // Удаляем вершину из расмотрения
           p2 := p1^.Next;               // Переходим к следущему треугольнику
           p3 := p2^.Next;
         end else begin
           p1 := p1^.Next;          //  в противном случае, переходим к следущему треугольнику
           p2 := p1^.Next;
           p3 := p2^.Next;
         end;
       end;
       // Рисуем последний, оставшийся треугольник
       pBox.Canvas.Brush.Color := RGB(Random(100)+100,Random(100)+100,Random(100)+100);
       pBox.Canvas.Polygon([Point(p1^.X, p1^.y), Point(p2^.X, p2^.y), Point(p3^.X, p3^.y)]);
       btTriangle.Enabled := false;
    end;
     
     
    procedure TForm1.AddPoint(Node: TListPoints; var Points: TListPoints);
    Var
      Last : TListPoints;
    begin
      if Points = nil then begin    // Если список вершин пуст
         Points := Node;            // то добавляемая вершина равна первой
         Points^.Next := Points;
      end else begin
         Last := Points;         // находим последнюю
         while Last^.Next<>Points do Last := Last^.Next;
         Last^.Next := Node;     // добавляем вершину после нее
         Node^.Next := Points;
      end;
    end;
     
     
    procedure TForm1.DelPoint(Node: TListPoints; var Points: TListPoints);
    Var
      Elem, Last : TListPoints;
    begin
      // Если в списке одна вершина
      if (Points^.Next = Points) and (Points=Node)  then begin
        Dispose(Node);     // то удаляем ее
        Points := nil;     // список пуст
      end else
        if Node = Points then begin   // Если удаляемая вершина равна указателю на список
          Last := Points;      // находим последнюю
          while Last^.Next<>Points do Last := Last^.Next;
          Last^.Next := Points^.Next;   // перенаправляем указатели
          Points := Points^.Next;
          Dispose(Node);                // удалеям ее
        end else begin                 // В противном случае,
          Elem := Points;              // находим удаляемую вершину
          while Elem^.Next <> Node do Elem := Elem^.Next;
          Elem^.Next := Node^.Next;     // перенаправляем указатели
          Dispose(Node);                // удалеям ее
        end;
    end;
     
     
    function TForm1.Det(x1, y1, x2, y2, x3, y3: Integer): Double;
    begin
      // Векторное произведение
      Result := (x2-x1)*(y3-y1) - (y2-y1)*(x3-x1); // Если положительно, то левая тройка векторов
    end;
     
     
    function TForm1.InTriangle(x, y, x1, y1, x2, y2, x3, y3: Integer): Boolean;
    Var a,b,c : Double;
    begin
       a := det(x,y,x1,y1,x2,y2);
       b := det(x,y,x2,y2,x3,y3);
       c := det(x,y,x3,y3,x1,y1);
       // Если все три тройки векторов однонаправленные, то  точка(x,y) внутри треугольника
       if ((a>0) and (b>0) and (c>0))or ((a<0) and (b<0) and (c<0)) then
         Result:=true
       else
         Result := false;
    end;
     
     
    procedure TForm1.DrawPolygon(Points: TListPoints);
    Var Node : TListPoints;
    begin
       Node := Points;
       pBox.Canvas.MoveTo( Node^.X, Node^.Y);
       repeat
         pBox.Canvas.LineTo( Node^.X, Node^.Y);
         Node := Node^.Next;
       until node = Points;    // Пройти по списку соединить все точки линиями
       pBox.Canvas.LineTo( Points^.X, Points^.Y);
    end;
     
     
    procedure TForm1.FormShow(Sender: TObject);
    begin
        ListPoints := nil;   // Список вершин полигона на момент запуска пуст
    end;
     
     
    procedure TForm1.pBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Var Node: TListPoints;
    begin
      pBox.Canvas.Ellipse(X-2,Y-2,X+2,Y+2);
      if ListPoints=nil then
        pBox.Canvas.MoveTo(X, Y)
      else
        pBox.Canvas.LineTo(X, Y);
      New(Node);
      Node^.X := X;
      Node^.Y := Y;
      AddPoint( Node, ListPoints);    // По щелчку мыши добавляем вершины
      btDraw.Enabled := true;
    end;
     
     
    procedure TForm1.btDrawClick(Sender: TObject);
    begin
      btTriangle.Enabled := true;
      btDraw.Enabled := false;
      DrawPolygon( ListPoints);
    end;
     
    end.

  • Ключевые слова: 
    триангуляция, многоугольник, полигон, треугольник, разбиение на треугольники, тесселяция
    ВложениеРазмер
    Программа триангуляции178.89 кб