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

Вход на сайт

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

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

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

Здравствуйте, Ильгиз. Математика - царица наук (Карл Гаусс). Изучение математики начинается с детского сада, когда нас учат считать и выполнять простые арифметические операции. Любой, даже самый простейший алгоритм будет связан с арифметическими...
Я хотел узнать математика это обязательно в программирование. Пять лет назад просто из любопытства я увлекся HTML потом изучил CSS и JvaScript потом изучил PHP и Java. Как то не задумывался и начал смотреть форумы и узнал что без математики не...
Все верно, но так же необходимо зайти в: Компоновщик -> Ввод -> Дополнительные зависимости Здесь необходимо нажать изменить и в Дополнительные зависимости прописать это: SDL2.lib SDL2main.lib SDL2test.lib Без этого не заработает. (MVS 2015)
Спасибо за реализацию, она действительно быстрая. Но не все линии отрисовывает в нужную сторону... Необходимо добавить проверку для случая X-линии if(y1 "<" y0) grad=-grad; и аналогично для Y-линии if(x1 "<" x0) grad=-grad; P.S. На...
Отличные уроки(учу GL по ним), только в renderScene нужно добавить очистку буфера цвета и буфера глубины. При изменении размеров треугольники размножаются)

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

Яндекс.Метрика Рейтинг@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 Мб