Nadesłany przez Tomasz Lubiński, 12 grudnia 2009 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Algorytm Cohena-Sutherlanda - Delphi/Cohen_Sutherland.pas:
//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.