Графика в TP: Построчная закраска фигуры.

Program KompGraph_Laba3;
Uses Crt, graph;
 
var
  driver,mode:integer;
  i:integer;
  {1-i kvadrat}
  a,b:integer;                    {koordinati verhnego levogo ygla}
  ac,bc:integer;                 {koordinati centra kvadrata}
 
 
{proceduri dlya 1-go kvadrata}
 procedure DrawLine1(a1,b1,a2,b2,Color:integer);  {risovanie linii}
 var
  i,a,b,da,db,sa,sb,e,tmp,flag:integer;
 begin
  a:=a1;                                          {inicializaciya peremennih}
  b:=b1;
  da:=abs(a2-a1);
  db:=abs(b2-b1);
  if a2-a1>0 then sa:=1 else sa:=-1;
  if b2-b1>0 then sb:=1 else sb:=-1;
  if db>da then                                   {obmen znachenii da i db}
            begin
             tmp:=da;
             da:=db;
             db:=tmp;
             flag:=1;
            end
           else
            flag:=0;
  e:=2*db-da;                            {inicializaciya oshibki}
for i:=1 to da do
   begin
    PutPixel(a,b,Color);
   if e>=0  then                             {izmenenie dopolnitelnoi}
     begin                                   {koordinati}
      if flag=1 then a:=a+sa
                else b:=b+sb;
      e:=e-2*da;                             {korrekciya oshibki}
     end;
 if flag=1 then b:=b+sb                      {izmenenie osnovnoi koordinati}
              else a:=a+sa;
    e:=e+2*db;                               {nakoplenie oshibki}
   end;
 end;
 
 
procedure Rotation1(angle:real;color:integer);  {povorot}
 var
    a1,b1,ar,br:integer;
 begin
  a1:=a-ac;                     {pomestit v nachalo koordinat}
  b1:=b-bc;
  ar:=round(a1*cos(angle)-b1*sin(angle));       {povernyt}
  br:=round(a1*sin(angle)+b1*cos(angle));
  ar:=ar+ac;                       {vernyt v nachalinoe polojenie}
  br:=br+bc;
  DrawLine1(a,b,round(ar),round(br),color);
  a:=ar;
  b:=br;
 end;
 
 procedure DrawRectangle1(angle:real;Color:integer); {risovanie kvadrata}
 begin
 for i:=1 to 4 do         {povorot tochki 4 raza na 90 gradysov vokryg centra}
  Rotation1(angle,Color);
 end;
 
 
procedure Intersection (x1,y1,x2,y2,x3,y3,x4,y4:integer; var m,n:integer);
var
znam1,znam2,chis1,chis2:integer;
ua,ub:real;
begin
chis1:=(x4-x3)*(y1-y3)-(y4-y3)*(x1-x3);
znam1:=(y4-y3)*(x2-x1)-(x4-x3)*(y2-y1);
if (chis1<>0) and (znam1<>0) then
ua:=chis1/znam1
else
ua:=10000;
chis2:=(x2-x1)*(y1-y3)-(y2-y1)*(x1-x3);
znam2:=(y4-y3)*(x2-x1)-(x4-x3)*(y2-y1);
if (chis2<>0) and (znam2<>0) then
ub:=chis2/znam2
else
ub:=10000;
if (ub<1000) and (ua<1000) then
begin
m:=round(x1+ua*(x2-x1));
n:=round(y1+ua*(y2-y1));
end
else
begin
m:=700;
n:=700;
end;
end;
 
procedure zakraska(yn,yk,color:integer);
var
yp,xp,m1,n1,m2,n2:integer;
begin
yp:=yn+1;
While(yp<yk) do begin
intersection(100,yp,435,yp,a,b,a,b+90,m1,n1);
intersection(100,yp,435,yp,a,b,a+90,b+90,m2,n2);
xp:=m1;
while(xp<=m2) do
begin
putpixel(xp,yp,color);
xp:=xp+1;
end;
yp:=yp+1;
end;
end;
 
begin
 
 driver:=Detect;                                 {inicializaciya}
 initgraph(driver,mode,'C:\TP\BGI');             {graficheskoro rejima}
 cleardevice;
 OutTextXY(5,5,'Mihail. Gruppa S-52. Variant # 34. LabRab # 3.');
 OutTextXY(5,20,'Dlya postroeniya drygoi figyri najmite lubyu klavishy.');
 
 ac:=350;
 bc:=250;
 a:=ac-45;                       {opredelenie koordinat}
 b:=bc-45;                       {verhnego levoro ygla}
 
 DrawRectangle1(pi/2,2);                         {risovanie kvadrata 1}
 readkey;
 zakraska(b,b+90,red);
 readkey;
 
Closegraph;
end.