Отсечение отрезка

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.