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

Вход на сайт

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

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

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

torrvic, возможно, Вам нужно добавить -lGLU
Извините за тупой вопрос. У меня при сборке Вашего примера выходит ошибка: "undefined reference to gluLookAt". Не могу найти в какой библиотеке находится эта функция. У меня задано: -lGL -lglut ... Искал в /usr/lib таким образом: nm lib*so* | grep...
Здравствуйте. Спасибо за проект. У меня вопрос, по какой причине определение принадлежности точки многоугольнику работает некорректно, если координаты из больших чисел состоят, например: int[] vertex = new int[] {...
Сейчас проверила нашла причину не запускания // Создание контекста воспроизведения OpenGL и привязка его к панели на форме OpenGLControl1:=TOpenGLControl.Create(Self); with OpenGLControl1 do begin Name:='OpenGLControl1'; //вот тут...
Ну..кажется что то пошло не так http://pp.usera...

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

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

В программе используется алгоритм Алгоритм Сазерленда-Коэна отсечения отрезка.

Для построения сцены необходимо щелкнуть на форме левой кнопкой мыши. По нажатию левой кнопки мыши на экране появляется прямоугольник и видимая часть отрезка в нём.

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

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
    edge = (LEFT,RIGHT,BOTTOM,TOP);
    outcode = set of edge;
  { TForm1 }
    TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure PaintBox1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
  xmin,ymin,xmax,ymax: Integer; // Координаты вершин прямоугольника
  x0,y0,x1,y1: Integer; // Координаты начала и конца отрезка
  accept,done : boolean;
  outcode0,outcode1,outcodeOut : outcode;
  x,y : Double;
implementation
 
{$R *.lfm}
 
{ TForm1 }
procedure CompOutCode(x,y: real; var code:outcode);
// Процедура вычисления кодов для точки(конца/начала отрезка)
   begin
     code := [];
     if y > ymax then code := [TOP]
     else if y < ymin then code := [BOTTOM];
     if x > xmax then code := code +[RIGHT]
     else if x < xmin then code := code +[LEFT]
   end;
 procedure clip(x0,y0,x1,y1: Integer);
 // Процедура отсечения отрезка
 begin
 accept := false;  done := false;
    CompOutCode (x0,y0,outcode0);
    CompOutCode (x1,y1,outcode1);
    repeat
      if(outcode0=[]) and (outcode1=[]) then
        // Отрезок целиком лежит внутри окна
        begin accept := true; done:=true end
      else if (outcode0*outcode1) <> [] then
        //Отрезок лежит за пределами окна и не будет отрисован
        done := true
      else // Часть отрезка лежит внутри прямоугольника
        begin
          if outcode0 <> [] then // Если начальная точка лежит вне прямоугольника
            outcodeOut := outcode0 else outcodeOut := outcode1;
         // Найдём точку пересечения отрезка с границей прямоугольника
          if TOP in outcodeOut then
            begin
              x := x0 + (x1 - x0) * (ymax - y0) / (y1 - y0);
              y := ymax ;
            end ;
          if BOTTOM in outcodeOut then
            begin
              x := x0 + (x1 - x0) * (ymin - y0) / (y1 - y0);
              y := ymax
            end
          else if RIGHT in outcodeOut then
            begin
              y := y0 + (y1 - y0) * (xmax - x0) / (x1 - x0);
              x := xmax
            end
          else if LEFT in outcodeOut then
            begin
              y := y0 + (y1 - y0) * (xmin - x0) / (x1 - x0);
              x := xmin
            end;
// Переместили внешнюю точку в точку пересечения
          if (outcodeOut = outcode0) then
            begin
              x0 := round(x); y0 := round(y); CompOutCode(x0,y0,outcode0)
            end
          else
            begin
              x1 := round(x); y1 := round(y); CompOutCode(x1,y1,outcode1);
            end
        end
    until done;
        if accept then  // Рисуем видимую часть отрезка
          begin
            Form1.Paintbox1.Canvas.Line(round(x0),round(y0),round(x1),round(y1));
            end
 
end;
procedure TForm1.PaintBox1Click(Sender: TObject);
begin
   xmin:=50; ymin:=50; xmax:=200; ymax:=150;
   Form1.Paintbox1.Canvas.Rectangle(xmin,ymin,xmax,ymax); 
   // Рисуем окно
   x0:=20; y0:=60; x1:=120; y1:=120;
  clip(x0,y0,x1,y1); // Рисуем видимую часть отрезка
end;
 
end.

Прикрепленный файлРазмер
clip_of_line.rar2.03 кб