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

Вход на сайт

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

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

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

dobryj den, popytalas otkryt prikreplionnyj fail ctoby posmotret kak rabotaet, no mne ego ne pokazyvaet vydajet osibku. Pochemu?
Очень интересно! ии сайт крутой жалко что умирает(
У Вас число превысит максимальное число int. Можно использовать в Вашем случае uint, но лучше все переписать на double.
Добавление к программе строки glutReshapeFunc(changeSize); приводит к тому, что треугольник перестаёт совсем отрисовываться.
Выдаёт ошибку glut32.dll не найден! При том, что он лежит в System32! Всё решил) Нужно отправить не в System32, а в System.

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

Рейтинг@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 кб