Программа рисования многоугольника. Описание алгоритмов процедур и функций. Описание интерфейсной части программы, страница 2

procedure Variant_3Click(Sender: TObject);

procedure LuchiClick(Sender: TObject);

procedure Variant_5Click(Sender: TObject);

procedure Variant_4Click(Sender: TObject);

procedure TeksturaClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

type

TDraw_PLT = object

procedure Draw_Pixel(x, y: integer; R, G, B: byte);

procedure Draw_Line(x1, y1, x2, y2: integer);

procedure Draw_TriangleZakr(x1, y1, x2, y2, x3, y3: integer);

procedure Draw_Texture(x1,y1,x2,y2: integer);

procedure Draw_Mnogougolnik(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: integer);

procedure Draw_MnogougolnikZakr(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: integer);

procedure Draw_luchi(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: integer);

procedure Draw_MnogougolnikText(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: integer);

procedure Put_Texture(x1: Integer; y1: Integer; x2: Integer; y2: Integer; x3: Integer; y3: Integer);

end;

var

Form1: TForm1;

BitMap:TBitMap;

Draw_PLT: TDraw_PLT;

OsnVer:integer;

implementation

{$R *.dfm}

procedure TDraw_PLT.Draw_Pixel(x, y: integer; R, G, B: byte);

var

c: TColor;

begin

c:=RGB(R,G,B); //задание цветовой палитры пиксела

Form1.Canvas.Pixels[x, y]:=c //вывод пиксела на форму

end;

//Рисование линии

procedure TDraw_PLT.Draw_Line(x1, y1,x2, y2: integer);

var

x, y, dx, dy:integer;

begin

if x1=x2 then

begin

if y1<y2 then

begin

for y := y1 to y2 do

Draw_Pixel(x1, y, 0, 150, 254);

end;

if y1>y2 then

begin

for y:=y2 to y1 do

Draw_Pixel(x1, y, 0, 150, 254);

end;

end;

if x1<x2 then

begin

for x := x1 to x2 do

begin

dx:=(x-x1)*(y2-y1);

dy:=x2-x1;

y:=(dx div dy) + y1;

Draw_Pixel(x, y, 0, 150, 254);

end;

end;

if x1>x2 then

begin

for x := x2 to x1 do

begin

dx:=(x-x1)*(y2-y1);

dy:=x2-x1;

y:=(dx div dy) + y1;

Draw_Pixel(x, y, 0, 150, 254);

end;

end;

end;

// Закраска треугольника

procedure TDraw_PLT.Draw_TriangleZakr(x1, y1, x2, y2, x3, y3: integer);

var

ya,yb,d,x:integer;

begin

//сортировка

while  (x1<=x2)and(x2<=x3)=false do

begin

if x2<x1 then

begin

d:=x2;

x2:=x1;

x1:=d;

d:=y2;

y2:=y1;

y1:=d;

end

else if x2>x3 then

begin

d:=x2;

x2:=x3;

x3:=d;

d:=y2;

y2:=y3;

y3:=d;

end;

end;

//рисование

if x1=x2 then

for x:=x3-1 downto x1 do

begin

ya:=(x-x3)*(y1-y3) div (x1-x3)+y3;

yb:=(x-x3)*(y2-y3) div (x2-x3)+y3;

Draw_PLT.Draw_Line(x,ya,x,yb);

end

else if x2=x3 then

for x:=x1+1 to x2 do

begin

ya:=(x-x1)*(y2-y1) div (x2-x1)+y1;

yb:=(x-x1)*(y3-y1) div (x3-x1)+y1;

Draw_PLT.Draw_Line(x,ya,x,yb);

end

else begin

for x:=x1+1 to x2 do

begin

ya:=(x-x1)*(y2-y1) div (x2-x1)+y1;

yb:=(x-x1)*(y3-y1) div (x3-x1)+y1;

Draw_PLT.Draw_Line(x,ya,x,yb);

end;

for x:=x3-1 downto x2 do

begin

ya:=(x-x3)*(y2-y3) div (x2-x3)+y3;

yb:=(x-x3)*(y1-y3) div (x1-x3)+y3;

Draw_PLT.Draw_Line(x,ya,x,yb);

end;

end;

end;

//Рисование текстуры

procedure TDraw_PLT.Draw_Texture(x1: Integer; y1: Integer; x2: Integer; y2: Integer);

var

x, y, dx, dy:integer;

begin

if x1=x2 then

begin

if y1<y2 then

begin

for y := y1 to y2 do

Form1.Canvas.Pixels[x1,y]:=BitMap.Canvas.Pixels[x1,y]

end;

if y1>y2 then

begin

for y:=y2 to y1 do

Form1.Canvas.Pixels[x1,y]:=BitMap.Canvas.Pixels[x1,y]

end;

end;

if x1<x2 then

begin

for x := x1 to x2 do

begin

dx:=(x-x1)*(y2-y1);

dy:=x2-x1;

y:=(dx div dy) + y1;

Form1.Canvas.Pixels[x,y]:=BitMap.Canvas.Pixels[x,y]

end;

end;

if x1>x2 then

begin

for x := x2 to x1 do

begin

dx:=(x-x1)*(y2-y1);

dy:=x2-x1;

y:=(dx div dy) + y1;

Form1.Canvas.Pixels[x,y]:=BitMap.Canvas.Pixels[x,y]

end;

end;

end;

//Наложение текстуры

procedure TDraw_PlT.Put_Texture(x1: Integer; y1: Integer; x2: Integer; y2: Integer; x3: Integer; y3: Integer);

var

m:array[1..3, 1..2] of integer;

i, j, xa, xb, y, x:integer;

begin

//сортировка вершин треугольника  по возрастанию

m[1,1]:=y1;

m[2,1]:=y2;

m[3,1]:=y3;

m[1,2]:=x1;

m[2,2]:=x2;

m[3,2]:=x3;

for j:= 1 to 3 do

begin

for i:= 1 to 2 do

begin

if m[i+1, 1]<m[i, 1] then

begin

y:= m[i+1, 1];

x:= m[i+1, 2];

m[i+1, 1]:=m[i, 1];

m[i+1, 2]:=m[i, 2];

m[i, 1]:= y;

m[i, 2]:= x;

end;

end;

end;

BitMap:=TBitMap.Create;

BitMap.LoadFromFile('111.bmp');

for y:=m[1,1] to m[2,1] do