2.2.1 Алгоритм заповнення з упорядкованими списками ребер

Скориставшись сформульованою у роздiлi 2.2. теоремою можна розробити ефективнi алгоритми растрової розгортки суцiльних областей, якi мають назву алгоритмiв заповнення з упорядкованими списками ребер. Вони залежать вiд сортування точок перетину ребер багатокутника з рядками, що скануються. Ефективнiсть цих алгоритмiв залежить вiд ефективностi сортування. Наведемо дуже простий алгоритм.

Простий алгоритм з упорядкованим списком ребер.

Пiдготовка даних: Визначити для кожного ребра багатокутника точки перетинiв з прямими y=k+1/2, якi проведенi посерединi мiж y-рядкiв, що скануються, для чого можна скористатись алгоритмом Брезенхема або ЦДА. Горизонтальнi ребра треба iгнорувати. Занести кожний перетин (x,y)=(x,k+1/2) до списку. Сортувати список за рядками k i потiм за зростанням x у рядку, тобто точка (x₁, y₁) передує точцi (x₂,y₂), якщо y₁ > y₂ або y₁ = y₂ i x₁ ≤ x₂.

Перетворити цi данi у растрову форму: Видiлити з вiдсортованого списку пари сусiднiх елементiв (x₁, y₁) i (x₂, y₂). Побудова списку (див. попередню теорему) гарантує, що у цих елементiв y₁=y₂=y i завжди x₁≤ x₂. Далi активувати на рядку y, що сканується, пiкселi для цiлих значень x, для яких x₁≤ x+1/2 ≤ x₂.

Програма Raster1a, що реалiзує наведений алгоритм.

unit Unit1;

{Простий алгоритм з упорядкованим списком ребер}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

const _N =1000;

type TForm1 = class(TForm)

Button1, Button2, Button3: TButton;

procedure Button1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private { Private declarations }

public { Public declarations }

end;

Point = array[1..2] of real; {тип 'точка'}

Border = array[1.._N] of Point; {тип 'вершини'}

Crosses = array[1.._N] of Point; {тип 'точки перетину'}

var

Form1: TForm1;

PathToExeDir:string;

YesContour:boolean;

NP, {число вершин багатокутника}

NV, {число перетинiв сторiн багатокутника}

Color, {колiр середини багатокутника}

і : integer;

Xs,Ys,Xf,Yf,d : real;

P:Border; {вершини багатокутника}

V:Crosses; {точки перетинiв сторiн багатокутника}

fin : text;

implementation {$R *.DFM}

function Sign(x:real):integer;

begin

if x>0 then Sign:=1;if x=0 then Sign:=0;if x<0 then Sign:=-1;

end;

procedure RastrBresLine(Xs,Ys,Xf,Yf,Color:integer);

var i,Dx,Dy,De,s1,s2,x,y,Temp,Change: integer;

begin {RastrBresLine}

\\ початкове встановлення змiнних

x:=Xs; y:=Ys; Dx:=abs(Xf-Xs); Dy:=abs(Yf-Ys);

s1:=Sign(Xf-Xs); s2:=Sign(Yf-Ys);

\\ обмiн значень Dx i Dy у залежностi

\\ вiд кутового коеф. нахилу вiдрiзка

if Dy > Dx

then begin

Temp:=Dx;Dx:=Dy;Dy:=Temp;Change:=1;

end else Change:=0;

// встановлення нев'язки De з поправкою на пiв пiкселя

De:=2*Dy-Dx;

for i:=1 to Dx do

begin {Початок головного циклу}

Form1.Canvas.Pixels[x,y]:=Color;

while De>=0 do

begin

if Change=1 then x:=x+s1 else y:=y+s2; De:=De-2*Dx;

end;

if Change=1 then y:=y+s2 else x:=x+s1; De:=De+2*Dy;

end; {for i}

end; {RastrBresLine}

{Встановлення вершин багатокутника}

procedure SetP(var P:Border;var NP:integer);

var x,y:integer;

begin {SetP}

AssignFile(fin,'Raster1a.dat'); reset(fin); NP:=0;

while (not Eof(fin)) do

begin

NP:=NP+1; readln(fin,x,y); P[NP,1]:=x; P[NP,2]:=y;

end;

CloseFile(fin);

end; {SetP}

{Друкування границi багатокутника}

procedure PrintBorderP(P:Border;NP:integer;Color:integer);

var i:integer;

begin {PrintBorderP}

for i:=1 to NP-1 do

begin

RastrBresLine(round(P[i,1]),round(P[i,2]),

round(P[i+1,1]),round(P[i+1,2]),Color);

end;

RastrBresLine(round(P[1,1]),round(P[1,2]),

round(P[NP,1]),round(P[NP,2]),Color);

end; {PrintBorderP}

{сортування списку точок перетинiв

(спочатку вiдносно y, а потiм вiдносно x)}

procedure SortV(var V:Crosses;N:integer);

var Inv: boolean; i: integer; V1,V2: real;

begin {SortV}

if N>1

then begin {if N>1}

Inv:=true;

while Inv do

begin {while Inv}

Inv:=false;

for i:=1 to N-1 do

begin {for i:=1 to N-1}

if(V[i,2]>V[i+1,2])or((V[i,2]=V[i+1,2])and(V[i,1]>V[i+1,1]))

then begin {if}

Inv:=true;

V1:=V[i+1,1];V2:=V[i+1,2]; V[i+1,1]:=V[i,1];

V[i+1,2]:=V[i,2]; V[i,1]:=V1;V[i,2]:=V2;

end; {if}

end; {for i:=1 to N-1}

end; {while Inv}

end; {if N>1}

end; {SortV}

{растрова розгортка рядкiв}

procedure RasterV(V:Crosses; NV:integer; Color:integer);

var i,j,j2:integer;

begin {RasterV}

// прохiд по парам елементiв списку

for j:=1 to (NV div 2) do

begin {прохiд по парам}

j2:=2*j-1; {знаходження номера першого елемента пари}

if V[j2,2]=V[j2+1,2] {повинно бути завжди!}

then begin {V[j2,2]=V[j2+1,2]}

for i:=round(V[j2,1])-1 to round(V[j2+1,1])+1 do

if (V[j2,1]-0.5<=i)and(i<=V[j2+1,1]-0.5)

then Form1.Canvas.Pixels[i,round(V[j2,2]-0.5)]:=Color;

end {V[j2,2]=V[j2+1,2]}

else begin {V[j2,2]<>V[j2+1,2]}

if Application.MessageBox('Iгноруемо пару з рiзними Y!',

'Method Error', MB_OK)<>IDOK then begin end;

end; {V[j2,2]<>V[j2+1,2]}

end;{прохiд по парам}

end; {RasterV}

{знаходження списку точок перетинiв вiдрiзка з рядками растру}

procedure CrossLine(Xs,Ys,Xf,Yf:real;

var V:Crosses;var NV:integer);

var Dx,x,y: real;

begin {CrossLine}

if Ys<Yf

then begin {Ys<Yf}

y:=Ys-d; Dx:=(Xf-Xs)/(Yf-Ys); x:=Xs+Dx*(y-Ys);

while (y < Yf - d) do

begin

y:=y+1; x:=x+Dx; NV:=NV+1; V[NV,1]:=x; V[NV,2]:=y;

end;

end {Ys<Yf}

else begin {Ys>=Yf}

if Ys>Yf

then begin {Ys>Yf}

y:=Yf-d; Dx:=(Xf-Xs)/(Yf-Ys); x:=Xs+Dx*(y-Ys);

while (y<Ys-d) do

begin

y:=y+1; x:=x+Dx; NV:=NV+1; V[NV,1]:=x; V[NV,2]:=y;

end;

end; {Ys > Yf}

end; {Ys>=Yf}

end; {CrossLine}

{заповнення середини багатокутника}

procedure RastrPolygon1(P:Border;NP:integer);

var i:integer;

begin {RastrPolygon1}

NV:=0;

for i:=1 to NP-1 do

begin

if round(P[i,2])<>round(P[i+1,2])

then CrossLine(P[i,1],P[i,2],P[i+1,1],P[i+1,2],V,NV);

end;

if round(P[NP,2])<>round(P[1,2])

then CrossLine(P[NP,1],P[NP,2],P[1,1],P[1,2],V,NV);

SortV(V,NV); RasterV(V,NV,Color);

end; {RastrPolygon1}

procedure TForm1.Button1Click(Sender: TObject);

begin {TForm1.Button1Click}

// встановлення списку вершин

if YesContour then RastrPolygon1(P,NP);

end; {TForm1.Button1Click}

procedure TForm1.FormCreate(Sender: TObject);

begin {TForm1.FormCreate}

d:=0.5; YesContour:=false;

end; {TForm1.FormCreate}

procedure TForm1.Button2Click(Sender: TObject);

begin {TForm1.Button2Click}

SetP(P,NP); {встановлення списку вершин}

PrintBorderP(P,NP,clRed); YesContour:=true;

end; {TForm1.Button2Click}

procedure TForm1.Button3Click(Sender: TObject);

begin {TForm1.Button3Click}

Form1.Close;

end; {TForm1.Button3Click}

end. {Unit1}

Лiтература. [ 5, стор. 97-104].