Редактирование многоугольника и нахождение меньшего угла

[niki_bleak]

Написать программу графического ввода и редактирования ломанной (многоугольника) на PaintBox. Программа должна иметь следующие функции:
- пользователь нажал левую кнопку мыши – нарисовалась точка; еще одно нажатие приводит к рисованию еще одной точки и линии соединяющей две точки и т.д. (в задачах с многоугольником первая и последняя точки должны совпадать).
- пользователь нажал правую кнопку мыши ( с нажатием клавиши клавиатуры) – должна выполниться одна из операций (в зависимости от клавиши):
- удаление точки на которой стоит курсор;
- добавление точки на отрезок к которому эта точка ближе всего;
- перемещение существующей точки.
- Выделить самый маленький внутренний угол выпуклого многоугольника.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Math;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

type TPoints = array of TPoint;

const
  tolerance = 10;//расстояние в пикселях, при котором две точки сольются в одну

var
  Form1: TForm1;
  Done:boolean;//true, если многоугольник создан
  p:TPoints;//массив точек
  count,selindex:integer;
  ShiftDown,CtrlDown,move,select:boolean;
implementation

{$R *.dfm}

procedure PaintPoly(Canvas:TCanvas;points:array of tpoint);
var i:integer;
min,r:real;
p1:TPoint;
x1,x2,y1,y2:Real;
begin
   min:=360;
   Canvas.Pen.Color:=clgreen;
   Canvas.Pen.Width:=2;
   Canvas.Brush.Color := clBtnFace;
   Canvas.FillRect(Canvas.ClipRect);
   for i:=0 to high(points)-1 do begin
      Canvas.MoveTo(points[i].X,points[i].Y);
      Canvas.LineTo(points[i+1].X,points[i+1].Y);
      form1.Canvas.Ellipse(points[i].X-3,points[i].Y-3,points[i].X+3,points[i].Y+3);
   end;

   for i:=1 to high(points)-1 do begin

           x1:=points[i+1].X-points[i].X;
           x2:=points[i-1].X-points[i].X;
           y1:=points[i+1].Y-points[i].Y;
           y2:=points[i-1].Y-points[i].Y;
           r:=arctan(((sqr(x1)+sqr(y1))*(sqr(x2)+sqr(y2))/sqr(x1*x2+y1*y2))-1);
           r:=RadToDeg(r);
           if r<min then begin
             min:=r;
             p1:=points[i];

           end;

   end;
   if high(points)>=4 then begin
     Canvas.Brush.Color := clred;
     Canvas.Ellipse(p1.X-5,p1.Y-5,p1.X+5,p1.Y+5);

   end;

end;

function distance(p1,p2:TPoint;x,y:integer):real;//расстояние от точки до отрезка
var left,right:real;
begin
    left:=sqrt(sqr(x-p1.X)+sqr(y-p1.Y));
    right:=sqrt(sqr(x-p2.X)+sqr(y-p2.Y));
    result:=left;
    if right<result then result:=right;
end;

function AddPoint(points:TPoints;x,y:integer):TPoints;//добавление точки в массив
var i,count,index:integer;
min,r:real;
begin
   min:=1000000;
   count:=0;
   SetLength(Result,length(points)+1);
   for i:=0 to high(Points)-1 do begin
       r:=distance(points[i],points[i+1],x,y);
       if r<min then begin
          min:=r;
          index:=i;
       end;
   end;
   for i:=0 to high(points) do begin
       Result[count]:=points[i];
       count:=count+1;
       if i=index then begin
           Result[count].X:=x;
           Result[count].Y:=y;
           count:=count+1;
       end;
   end;
end;

[niki_bleak]

function DelPoint(points:TPoints;index:integer):TPoints;//удалени точки из массива точек многоугольника
var i,count:integer;
begin
  if Length(points)>=5 then begin
     count:=0;
     SetLength(Result,Length(points)-1);
     for i:=0 to High(points) do begin
        if i<>index then begin
            Result[count]:=points[i];
            count:=count+1;
        end;
     end;
     if index=0 then Result[count-1]:=Result[0];
  end else begin
     Result:=points;
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
begin
   select:=false;
   //построение многоугольника
   if (not Done)and(Button = mbleft) then begin
       SetLength(p,count+1);
       if count<>0 then begin
          if (sqrt(sqr(x-p[0].X)+sqr(y-p[0].Y))<=tolerance)and(count>3) then begin
             p[count]:=p[0];
             form1.Canvas.Ellipse(p[0].X-3,p[0].Y-3,p[0].X+3,p[0].Y+3);
             form1.Canvas.MoveTo(p[count-1].X,p[count-1].Y);
             form1.Canvas.LineTo(p[0].X,p[0].Y);
             Done:=true;
             PaintPoly(form1.Canvas,p);
          end else begin
             p[count].X:=x;
             p[count].Y:=y;
             form1.Canvas.Ellipse(x-3,y-3,x+3,y+3);
             form1.Canvas.MoveTo(p[count-1].X,p[count-1].Y);
             form1.Canvas.LineTo(x,y);
          end;
       end else begin
             p[count].X:=x;
             p[count].Y:=y;
             form1.Canvas.Ellipse(x-3,y-3,x+3,y+3);
       end;
       count:=count+1;
   end;
   //выбор точки
   if Done then for i:=0 to high(p) do begin
       if sqrt(sqr(x-p[i].X)+sqr(y-p[i].Y))<=tolerance then begin
           select:=true;
           selindex:=i;
           if Button = mbLeft then move:=true;
           break;
       end;
   end;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Done:=false;
   form1.Canvas.Pen.Color:=clgreen;
   form1.Canvas.Pen.Width:=2;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
	If (key = vk_Shift) then
		 ShiftDown := true;
	If (key = vk_Control) then
		 CtrlDown:= true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if Move then begin
       if selindex=0 then begin
          p[0].X:=x;
          p[0].Y:=y;
          p[high(p)].X:=x;
          p[high(p)].Y:=y;
       end else begin
          p[selindex].X:=x;
          p[selindex].Y:=y
       end;
       PaintPoly(form1.Canvas,p);
   end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Move:=false;
   //удаление точки
   if select and CtrlDown and (Button = mbRight) then begin
       p:=DelPoint(p,selindex);
       PaintPoly(form1.Canvas,p);
   end;
   //добавление точки
   if Done and ShiftDown and (Button = mbRight) then begin
       p:=AddPoint(p,x,y);
       PaintPoly(form1.Canvas,p);
   end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   ShiftDown:=false;
   CtrlDown:=false;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if Done then PaintPoly(form1.Canvas,p);
end;

end.

Проблема с нахождением меньшего угла. После того как нарисована фигура не правильно находится угол и вылетает ошибка.
Подскажите что не так.

[denisbrain]

uses math;
Function Ugol(a,b:Tpoint):real;
var Ch:integer;
begin
  result:=arctan2((a.y-b.y),(a.x-b.x));
end;

[niki_bleak]

мне не понятно, между чем и чем находит угол arctan2?

[denisbrain]

угол наклона прямой

[niki_bleak]

а как найти угол между двумя прямыми?

[Rin]

Угол в градусах между двумя отрезками

arccos(  (x1*x2+y1*y2)  /   (sqrt(sqr(x1)+sqr(y1))*sqrt(sqr(x2)+sqr(y2)))  )*180/pi

где x1,y1,x2,y2 - направляющие вектора.

Вот ещё вариант, предложенный amk с другого форума:

dx1 = x1 - x2
dy1 = y1 - y2
dx2 = x3 - x2
dy2 = y3 - y2

a = dx1*dy2 - dy1*dx2
b = dx1*dx2 + dy1*dy2

θ = arctan(a/b)

Угол будет в радианах. Усножишь на 180/pi и получишь в градусах.

[denisbrain]

Сообщение от Rin

Угол в градусах между двумя отрезками

arccos(  (x1*x2+y1*y2)  /   (sqrt(sqr(x1)+sqr(y1))*sqrt(sqr(x2)+sqr(y2)))  )*180/pi

где x1,y1,x2,y2 - направляющие вектора.

Вот ещё вариант, предложенный amk с другого форума:


Угол будет в радианах. Усножишь на 180/pi и получишь в градусах.

т.е. в данном случаи оба отрезка задаются координатами ?
AB(x1,y1,x2,y2)
BC(x2,y2,x3,y3) ???

[Rin]

Да, задаются координатами . В любом из двух случаев ищем направляющие вектора.
Кстати, может вылететь ошибка "Devision by zero". Так что проверяйте делители, и если что подставляйте БМВ.