Словесное описание программы. Рисование пикселя стандартными средствами Delphi. Создание области для текстуры в оперативной памяти, страница 2

  var

     c: integer;

  begin

     c :=  a;

     a :=  b;

b :=  c;

end;

//рисование горизонтальной линии =========================================

procedure TForm1.garizont ( y,  x1,  x2: integer);

  var

    x: integer;

  begin

    if ( x1 >  x2) then Swap( x1,  x2);

    if ( x1 < 0) then  x1 := 0;

    if ( x2 >= 640) then  x2 := 639;

    if ( x1 >= 640) or ( x2 < 0) then

      begin

         x1 := 1;

         x2 := 0;

      end;

    for  x :=  x1 to  x2 do Pixel( x,  y,  0,0,0);

  end;

//рисование линии ===================================================

procedure TForm1.Linia(x0, y0, x1, y1: integer);

var

  y,x,dx,dy: integer;

begin

 if x0=x1 then

  begin

   if y0<y1 then

    begin

     for y := y0 to y1 do

      Pixel(x0, y, 0, 0, 0);

    end;

   if y0>y1 then

    begin

     for y:=y1 to y0 do

      Pixel(x0, y, 0, 0, 0);

    end;

  end;

  if x0<x1 then

   begin

    for x := x0 to x1 do

     begin

       dx:=(x-x0)*(y1-y0);

       dy:=x1-x0;

       y:=(dx div dy) + y0;

       Pixel(x, y, 0, 0, 0);

     end;

   end;

   if x0>x1 then

    begin

     for x := x1 to x0 do

      begin

       dx:=(x-x0)*(y1-y0);

       dy:=x1-x0;

       y:=(dx div dy) + y0;

       Pixel(x, y, 0, 0, 0);

      end;

    end;

end;

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

procedure TForm1.Treugolneg( x1,  y1,  x2,  y2,  x3, y3: integer);

var

   a1,  b1,  c1,  a2,  b2,  c2,  dx1,  dx2,  dy1,  dy2, y,  r: integer;

begin

while ( y1 >  y2) or ( y2 >  y3) do  //сортируем по высотам врешин

begin

    if ( y1 >  y2) then

    begin

      Swap( x1,  x2);

      Swap( y1,  y2);

    end;

    if ( y2 >  y3) then

    begin

      Swap( x2,  x3);

      Swap( y2,  y3);

    end;

end;   //сортировка закончена

a1 :=  y3 -  y1;

b1 :=  x1 -  x3;

   c1 := - y1 *  b1 -  x1 *  a1;

  for  r := 0 to 1 do

  begin

    if ( r = 0) then

    begin

       a2 :=  y2 -  y1;

       b2 :=  x1 -  x2;

       c2 := - y1 *  b2 -  x1 *  a2;

       dy1 :=  y1;

       dy2 :=  y2;

    end

    else

    begin

       a2 :=  y2 -  y3;

       b2 :=  x3 -  x2;

       c2 := - y3 *  b2 -  x3 *  a2;

       dy1 :=  y2+1;

       dy2 :=  y3;

    end;

    if ( a1 <> 0) and ( a2 <> 0) then

    begin

      if ( dy1 < 0) then  dy1 := 0;

      if ( dy2 >= 480) then  dy2 := 480 - 1;

      if ( dy1 >= 480) or ( dy2 < 0) then

      begin

         dy1 := 1;

         dy2 := 0;

      end;

      for  y :=  dy1 to  dy2 do

      begin

         dx1 := (- c1 -  b1 *  y) div  a1;

         dx2 := (- c2 -  b2 *  y) div  a2;

        garizont( y,  dx1,  dx2);

      end;

    end;

  end;

  if ( a1 = 0) and ( a2 = 0) then

  begin

    while ( x1 >  x2) or ( x2 >  x3) do

    begin

      if ( x1 >  x2) then Swap( x1,  x2);

      if ( x2 >  x3) then Swap( x2,  x3);

    end;

    garizont( y1,  x1,  x3);

  end;

end;

// кнопки ==================================================================

procedure TForm1.Button1Click(Sender: TObject);

  begin

    clear;

    Pixel(strtoint(Edit1.text),strtoint(Edit2.Text),0,0,0);

  end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  clear;

  Linia(strtoint(Edit1.text),strtoint(Edit2.Text),strtoint(Edit3.text),strtoint(Edit4.Text));

end;

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

procedure TForm1.Button3Click(Sender: TObject);

var

x1,y1,x2,y2,x3,y3:integer;

begin

x1:=strtoint(Edit1.text);

y1:=strtoint(Edit2.text);

x2:=strtoint(Edit3.text);

y2:=strtoint(Edit4.text);

x3:=strtoint(Edit5.text);

y3:=strtoint(Edit6.text);

 clear;

 Linia(x1,y1,x2,y2);

 Linia(x2,y2,x3,y3);

 Linia(x3,y3,x1,y1);

end;

//закрашенный треугольник

procedure TForm1.Button6Click(Sender: TObject);

var

x1,y1,x2,y2,x3,y3:integer;

begin

x1:=strtoint(Edit1.text);

y1:=strtoint(Edit2.text);

x2:=strtoint(Edit3.text);

y2:=strtoint(Edit4.text);

x3:=strtoint(Edit5.text);

y3:=strtoint(Edit6.text);

  clear;

  Treugolneg(x1,y1,x2,y2,x3,y3);

end;

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

procedure TForm1.Button4Click(Sender: TObject);

var

x1,y1,x2,y2,x3,y3:integer;

begin

tex:=true;

x1:=strtoint(Edit1.text);

y1:=strtoint(Edit2.text);

x2:=strtoint(Edit3.text);

y2:=strtoint(Edit4.text);

x3:=strtoint(Edit5.text);

y3:=strtoint(Edit6.text);

  clear;

  Treugolneg(x1,y1,x2,y2,x3,y3);

tex:=false;

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

clear;

end;

end.