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

Вход на сайт

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

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

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

Здравствуйте. Спасибо за проект. У меня вопрос, по какой причине определение принадлежности точки многоугольнику работает некорректно, если координаты из больших чисел состоят, например: int[] vertex = new int[] {...
Сейчас проверила нашла причину не запускания // Создание контекста воспроизведения OpenGL и привязка его к панели на форме OpenGLControl1:=TOpenGLControl.Create(Self); with OpenGLControl1 do begin Name:='OpenGLControl1'; //вот тут...
Ну..кажется что то пошло не так http://pp.usera...
Пример, к которому вы оставили комментарий строит именно то самое изображение на языке с#, которое вам необходимо. Отличается только цветовая палитра.

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

Рейтинг@Mail.ru
Скриншот к примеру
Среда программирования: 
Lazarus

Определить точку пересечения двух отрезков. Решение состоит из нахождения векторного произведения function VM(), определения факта пересечения 2 отрезков function LC(), составления уравнений прямых procedure PtL() и определения точки пересечения function LtP(), собственно.

Код программы: 

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;
type
  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;      //поле, где отображаются координаты точки пересечения
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);  //определяет координаты курсора
    procedure PtL(cx,cy,ex,ey:double;var ap, bp, cp:double);
    function LtP(a1,b1,c1,a2,b2,c2: double; var x,y:double):Boolean;
     function VM(ax,ay,bx,by:double): double;
     Function LC(x1,y1,x2,y2,x3,y3,x4,y4:integer): boolean;
  private
    { private declarations }
  public
      x1, y1 ,x2, y2, x3, y3, x4, y4 : integer;  //точки,задающие 2 отрезка
      a, b, c, g, e, f :double; 
      dx, dy, x, y:double;
      v1,v2,v3,v4: double;
    { public declarations }
  end;
 
var
  Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
 
function TForm1.VM(ax,ay,bx,by:double): double;  //векторное произведение
begin
  vm:= ax*by-bx*ay;
end;
 
Function TForm1.LC(x1,y1,x2,y2,x3,y3,x4,y4:integer): boolean; //проверка
begin                                                         //пересечения
  v1:=vm(x4-x3,y4-y3,x1-x3,y1-y3);        
  v2:=vm(x4-x3,y4-y3,x2-x3,y2-y3);
  v3:=vm(x2-x1,y2-y1,x3-x1,y3-y1);
  v4:=vm(x2-x1,y2-y1,x4-x1,y4-y1);
  if (v1*v2<0) and (v3*v4<0)
    then LC:= true
    else LC:= false
end;
 
//построение уравнения прямой
procedure TForm1.PtL(cx,cy,ex,ey:double; var ap, bp, cp:double);  
begin                                                              
   ap:=ey-cy;                                            
   bp:=cx-ex;
   cp:=-cx*(ey-cy)+cy*(ex-cx);
end;
 
//поиск точки пересечения
Function TForm1.LtP(a1,b1,c1,a2,b2,c2: double; var x,y:double):Boolean; 
var d:double;                               
begin
  d:=a1*b2-b1*a2;
  if LC(x1,y1,x2,y2,x3,y3,x4,y4)
    then
      begin
      LtP:=True;
        dx:=-c1*b2+b1*c2;
        dy:=-a1*c2+c1*a2;
        x:=dx/d;
        y:=dy/d;
      end
    else
      LtP:=False
End;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with Paintbox1.Canvas do begin
  //прорисовка отрезков
    Pen.Width:=2;
    Pen.Color:=clBlack;
    x1:=20;
    y1:=20;
    x2:=70;
    y2:=30;
    x3:=19;
    y3:=40;
    x4:=60;
    y4:=15;
    Line (x1, y1, x2, y2);
    Line (x3, y3, x4, y4);
    PtL( x1,y1,x2,y2,a,b,c); //строится уравнение прямой для каждого отрезка
     f:=a;
     e:=b;
     g:=c;
    PtL( x3,y3,x4,y4,a,b,c);
    if LtP(f,e,g,a,b,c,x,y)  //проверка пересечения
      then begin
       Form1.Memo1.Clear;
      Form1.Memo1.Lines.Append(FloatToStr(x)); //вывод точки пересечения
      Form1.Memo1.Lines.Append(FloatToStr(y));
      end
      else ShowMessage('no crossing');//если не пересекаются:вывод сообщения
      end;
end;
 
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  caption:= 'X:'+IntToStr(x) +' Y:'+ IntToStr(y);
end;
 
end.

Прикрепленный файлРазмер
CrossingPoint.rar1.77 Мб