Основы программирования

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.