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

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

Построения
на плоскости (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

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

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

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

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 кб