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

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

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

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

У меня проблема вот с этим: gl.Clear(OpenGL.GL_COLOR_BUFFER_BIT | OpenGL.GL_DEPTH_BUFFER_BIT);. Вылезает ошибка: CS1061 "object" не содержит определения "GL_COLOR_BUFFER_BIT", и не удалось найти доступный метод расширения "GL_COLOR_BUFFER_BIT",...
Большое спасибо. Единственный код который прошел без каких либо ошибок. Ура!!!
Скажите пожалуйста, подскажите алгоритм по которому по заданным точкам можно определить тип многогранника, скажем это куб или прямоугольный параллелепипед. Нашел теорию по этим фигурам: https://www.mat... https://www.mat... Акцентировать внимание...
Всем у кого не работает. файл wizard.script Ещё одно упоминание Glut32 в строке "if (!VerifyLibFile(dir_nomacro_lib, _T("glut32"), _T("GLUT's"))) return false;" меняем на "if (!VerifyLibFile(dir_nomacro_lib, _T("freeglut"), _T("GLUT's"))) return...
Не получается, емаё

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

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