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

Вход на сайт

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

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

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

dobryj den, popytalas otkryt prikreplionnyj fail ctoby posmotret kak rabotaet, no mne ego ne pokazyvaet vydajet osibku. Pochemu?
Очень интересно! ии сайт крутой жалко что умирает(
У Вас число превысит максимальное число int. Можно использовать в Вашем случае uint, но лучше все переписать на double.
Добавление к программе строки glutReshapeFunc(changeSize); приводит к тому, что треугольник перестаёт совсем отрисовываться.
Выдаёт ошибку glut32.dll не найден! При том, что он лежит в System32! Всё решил) Нужно отправить не в System32, а в System.

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

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