//Algorytm Cohena-Sutherlanda
//(c) 2009 by Tomasz Lubinski
//www.algorytm.org
unit Cohen_Sutherland;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, SHELLAPI;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label6: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    procedure Label6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Cohen_Sutherland(x1, y1, x2, y2: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  WIN_LEFT: Integer = 80;
  WIN_RIGHT: Integer = 420;
  WIN_TOP: Integer = 80;
  WIN_BOTTOM: Integer = 320;


implementation

{$R *.DFM}

procedure TForm1.Label6Click(Sender: TObject);
begin
  with (Sender as Tlabel) do
 ShellExecute(Application.Handle,
             PChar('open'),
             PChar(Hint), 
             PChar(0),
             nil,
             SW_NORMAL);
end;

function calcRegCode(x, y: Integer): Integer;
begin
   result := 0;
   if (x < WIN_LEFT)   then result := (result or 1);
   if (x > WIN_RIGHT)  then result := (result or 2);
   if (y > WIN_BOTTOM) then result := (result or 4);
   if (y < WIN_TOP)    then result := (result or 8);
end;

procedure TForm1.Cohen_Sutherland(x1, y1, x2, y2: Integer);
var
   rcode1, rcode2, rcode, x, y: Integer;
begin

   // Algorytm Cohena-Sutherlanda
   // 1. Zakoduj końce odcinka zgodnie z kodami obszarów
   rcode1 := calcRegCode(x1, y1);
   rcode2 := calcRegCode(x2, y2);
   // 2. Jeżeli iloczyn logiczny (AND) tych kodów <>0,
   // to odcinek może być pominięty (w całości poza
   // oknem) - zaznacz go na czerwono
   if ((rcode1 and rcode2) <> 0) then
   begin
      Image1.Canvas.Pen.Color := clRed;
      Image1.Canvas.MoveTo(x1, y1);
      Image1.Canvas.LineTo(x2, y2);
   end
   // 3. Jeżeli suma logiczna (OR)tych kodów = 0,
   // to odcinek w całości mieści się w okienku
   // - zaznacz go na zielono
   else if ((rcode1 or rcode2) = 0) then
   begin
      Image1.Canvas.Pen.Color := clGreen;
      Image1.Canvas.MoveTo(x1, y1);
      Image1.Canvas.LineTo(x2, y2);
   end
   else
   begin
      // pozostale przypadki - przeciecie z krawedzia okna
      repeat
         if (rcode1 <> 0) then
            rcode := rcode1
         else
            rcode := rcode2;

         // pozostale przypadki - przeciecie z krawedzia okna
         if (rcode and 1) <> 0 then
         begin
            y := y1+(y2-y1)*(WIN_LEFT-x1) div (x2-x1);
            x := WIN_LEFT;
         end
         else if (rcode and 2) <> 0 then
         begin
            y := y1+(y2-y1)*(WIN_RIGHT-x1) div (x2-x1);
            x := WIN_RIGHT;
         end
         else if (rcode and 4) <> 0 then
         begin
            x := x1+(x2-x1)*(WIN_BOTTOM-y1) div (y2-y1);
            y := WIN_BOTTOM;
         end
         else if (rcode and 8) <> 0 then
         begin
            x := x1+(x2-x1)*(WIN_TOP-y1) div (y2-y1);
            y := WIN_TOP;
         end;

         if (rcode = rcode1) then
         begin
            Image1.Canvas.Pen.Color := clYellow;
            Image1.Canvas.MoveTo(x1, y1);
            Image1.Canvas.LineTo(x, y);
            x1 := x;
            y1 := y;
            rcode1 := calcRegCode(x1, y1);
         end
         else
         begin
            Image1.Canvas.Pen.Color := clYellow;
            Image1.Canvas.MoveTo(x2, y2);
            Image1.Canvas.LineTo(x, y);
            x2 := x;
            y2 := y;
            rcode2 := calcRegCode(x2, y2);
         end;
      until (((rcode1 and rcode2) <> 0) or ((rcode1 or rcode2) = 0));

      if ((rcode1 or rcode2) = 0) then
      begin
         Image1.Canvas.Pen.Color := clBlue;
         Image1.Canvas.MoveTo(x1, y1);
         Image1.Canvas.LineTo(x2, y2);
      end
      else
      begin
         Image1.Canvas.Pen.Color := clYellow;
         Image1.Canvas.MoveTo(x1, y1);
         Image1.Canvas.LineTo(x2, y2);
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   i, x1, y1, x2, y2: Integer;
begin

   // wyczysc wszystko
   Image1.Canvas.Pen.Color := clBlack;
   Image1.Canvas.Pen.Width := 2;
   Image1.Canvas.Brush.Color := clWhite;
   Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height);

   // narysuj okno
   Image1.Canvas.Brush.Color := clLtGray;
   Image1.Canvas.Rectangle(WIN_LEFT, WIN_TOP, WIN_RIGHT, WIN_BOTTOM);

   // losuj odciniki 
   randomize();
   for i:=1 to 20 do
   begin
      x1 := random(Image1.Width);
      y1 := random(Image1.Height);
      x2 := x1 + random(200) - 100;
      y2 := y1 + random(200) - 100;

      Cohen_Sutherland(x1, y1, x2, y2);
   end;
end;

end.