Уроки, алгоритмы, программы, примеры

Вход на сайт

Материалы по разделам

Построения
на плоскости (2D)
Графика
в пространстве (3D)
Вычислительная
геометрия
Физическое
моделирование
Фрактальная
графика

Новые комментарии

Спасибо за реализацию, она действительно быстрая. Но не все линии отрисовывает в нужную сторону... Необходимо добавить проверку для случая X-линии if(y1 "<" y0) grad=-grad; и аналогично для Y-линии if(x1 "<" x0) grad=-grad; P.S. На...
Отличные уроки(учу GL по ним), только в renderScene нужно добавить очистку буфера цвета и буфера глубины. При изменении размеров треугольники размножаются)
как исправить это , сделал все по инструкции
Timer1 - выдает ошибку. Использовал IdleTimer1, работает! unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, OpenGLContext, GL, GLU; type { TForm1 } TForm1 =...
в коде присутствуют ошибки! // Считываем координаты procedure TForm1.getCoords(Sender: TObject); var j1:longint; begin n:= StrToInt(Edit2.Text); //число точек s1:=Edit1.Text; s2:=''; i := 1; j:=1; k:=0...

Счетчики и рейтинг

Яндекс.Метрика Рейтинг@Mail.ru
купить лосины для фитнеса женские
Скриншот к примеру
Среда программирования: 
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.zip884.42 кб