
Среда программирования:
Lazarus
Задача - определить, находится точка внутри многоугольника, снаружи или на границе, используя метод трассировки лучом. Создадим форму с двумя полями для ввода координат проверяемой точки и кнопкой. При нажатии на кнопку, поле для рисования заливается цветом clDefault для того, чтобы стереть предыдущие результаты построения(если таковые имеются), рисуется точка и выводится результат при помощи процедуры ShowMessage.
Используемые функции и процедуры:
Init() - Определение точек многоугольника
classify(),edgeType() - классифицируют точку
Код программы:
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.
Прикрепленный файл | Размер |
---|---|
trass_example1.zip | 884.42 кб |