Метод трассировки лучом

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Init();
    function classify(xb,yb,xe,ye : Integer):Integer;
    function edgeType(xb,yb,xe,ye : Integer):Integer;
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
  x, y, i, check_point, parity, mult, tmp : Integer;
  px,py : array[0..100] of Integer;
implementation
 
{$R *.lfm}
 
{ TForm1 }
//проверяем расположение точки :1-пересекается, -1 - касательно, 0 - безразлично
function TForm1.classify(xb,yb,xe,ye : Integer):Integer;
begin
     mult := ((x-xb)*(ye-yb))-((y-yb)*(xe-xb));
     if(mult > 0) then
     begin
        Result:= 1;
     end;
     if(mult < 0) then
     begin
        Result:= -1;
     end;
     if(mult = 0) then
     begin
        Result:= 0;
     end;
end;
//классифицируем ребро:Касается, пересекает или безразлично
function TForm1.edgeType(xb,yb,xe,ye : Integer):Integer;
begin
     tmp := classify(xb,yb,xe,ye);
     case tmp of
          1:
          begin
               if((ye<y)and(y<=yb)) then
               begin
                    Result:=1;
               end
               else
                   Result := 0;
               end;
          -1:
          begin
               if((yb<y)and(y<=ye)) then
               begin
                    Result:=1;
               end
               else
                   Result := 0;
               end;
          0: Result := -1;
          end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
     check_point:=0;
     parity := 0;
     x:=StrToInt(Edit1.Text);
     y:=StrToInt(Edit2.Text);
     Form1.PaintBox1.Canvas.Brush.Color:=clDefault;
     Form1.PaintBox1.Canvas.Rectangle(0,0,PaintBox1.Width,PaintBox1.Height);
     Form1.PaintBox1.Canvas.Brush.Color:=clRed;
     Form1.PaintBox1.Canvas.Ellipse(x-3,y-3,x+2,y+2);
     Form1.PaintBox1.Canvas.Brush.Color:=clDefault;
     for i := 0 to 3 do
     begin
          if(edgeType(px[i],py[i],px[i+1], py[i+1]) = 1) then
          begin
              parity := 1-parity;
          end;
          if(edgeType(px[i],py[i],px[i+1], py[i+1]) = -1) then
          begin
              check_point := 2;
          end;
     end;
     if(check_point = 2) then
     begin
          ShowMessage('Точка лежит на границе многоугольника');
     end
     else
     if(parity = 1) then
     begin
          ShowMessage('Точка лежит внтури многоугольника');
     end
     else
          ShowMessage('Точка лежит снаружи многоугольника');
end;
 
// Определяем координаты многоугольника
procedure TForm1.Init();
begin
     px[0]:=120;
     py[0]:=80;
     px[1]:=170;
     py[1]:=260;
     px[2]:=220;
     py[2]:=80;
     px[3]:=170;
     py[3]:=140;
     px[4]:=120;
     py[4]:=80;
     parity:=0;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
     Form1.Init();
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
     //отрисовываем многоугольник
     with PaintBox1.Canvas do
     begin
          MoveTo(px[0],py[0]);
          for i:=1 to 4 do
          begin
               LineTo(px[i],py[i]);
               MoveTo(px[i],py[i]);
          end;
     end;
end;
 
end.