Контрольная работа по "Программирование"

n="justify">                a:=0;

                line(b2,x1,j,x2,j);

             end;

           end;

        end;

    end;

    Image1.Canvas.CopyMode:=cmSrcAnd;

    Image1.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));

    bp.Canvas.CopyMode:=cmSrcCopy;

    bp.Canvas.CopyRect(Rect(0,0,500,300),Image1.Canvas,Rect(0,0,500,300));

    b1.Canvas.CopyMode:=cmSrcCopy;

    b1.Canvas.CopyRect(Rect(0,0,500,300),Image1.Canvas,Rect(0,0,500,300));

end; 

procedure TRed.duga(x1,x2,y1,y2,r: integer);

type s= -1..1;

var

   xser,yser: real;

   la1,lb1,la2,lb2: real;

   xpr,ypr: real;

   dlina1{,dlina2}: real;

   xmin{,xmax}: integer;

   ymin{,ymax}: integer;

   xc1,yc1,xc2,yc2,xc,yc: integer;

   x,y,di,db,xpr2,ypr2: integer;

   t,t2: s;

   per1,par1,per2,par2: boolean;

   col:TColor;

function sign(d: real): s;

begin

if d<0 then sign:=-1

  else if d>0 then sign:=1

   else sign:=0;

end; 

begin

per1:=false;

par1:=false;

per2:=false;

par2:=false;

col:=Red.Shape1.Brush.Color;

if y1=y2 then

begin

  if x1=x2 then

  begin

   ShowMessage('Вы ввели точку!');

   exit;

  end;

  par1:=true;

end

else if x1=x2 then

per1:=true; 

 if x1>x2 then xmin:=x2

          else xmin:=x1; 
 

if y1>y2 then ymin:=y2

          else ymin:=y1; 
 

xser:=abs(x1-x2)/2+xmin;

yser:=abs(y1-y2)/2+ymin;

if (not per1)and(not par1) then

begin

  la1:=(y2-y1)/(x2-x1);

  lb1:=(y1*x2-x1*y2)/(x2-x1); 

  la2:=-1/la1;

  lb2:=yser-la2*xser; 
 

  xpr:=xser;

  ypr:=la2*xpr+lb2;

  dlina1:=sqrt(sqr(xpr-x1)+sqr(ypr-y1));

  While dlina1<r do

  begin

   xpr:=xpr+1;

   ypr:=la2*xpr+lb2;

   dlina1:=sqrt(sqr(xpr-x1)+sqr(ypr-y1));

  end;

end else

  if par1 then

  begin

   xpr:=xser;

   ypr:=yser+sqrt( r*r-(sqr(x2-xser)+sqr(y2-yser)) );

  end else

  begin

   xpr:=xser+sqrt( r*r-(sqr(x2-xser)+sqr(y2-yser)) );

   ypr:=yser;

  end; 
 

xc1:=round(xpr);

yc1:=round(ypr); 

xc2:=round(xser-(xpr-xser));

yc2:=round(yser-(ypr-yser)); 

if sqrt(sqr(xc1)+sqr(yc1))<sqrt(sqr(xc2)+sqr(yc2)) then

begin

  xc:=xc1;

  yc:=yc1;

end else

     begin

      xc:=xc2;

      yc:=yc2;

    end; 

x:=0;

y:=r;

di:=2*(1-r); 
 

  xpr2:=xc;

  ypr2:=yc;

  t2:=1; 

  {рисование  центра}

  b1.canvas.pen.Width:=1;

  b1.canvas.pen.color:=col;

  b1.canvas.pixels[xpr2,ypr2]:=col; 

  if par1 then

   if yc<yser then t:=-1

              else t:=1; 

  if per1 then

   if xc<xser then t:=-1

              else t:=1; 

  if (not per1)and(not par1) then

  begin

   t2:=0;

   if (xc*la1+lb1-yc)<0

   then t:=-1

   else t:=1;

  end; 

//  if CheckBox1.Checked then t:=-t; 
 

  repeat

  if t2=0 then

  begin

  if t*((xc+x)*la1+lb1-(yc-y))<=0 then b1.canvas.pixels[xpr2+x,ypr2-y]:=col;

  if t*((xc+x)*la1+lb1-(yc+y))<=0 then b1.canvas.pixels[xpr2+x,ypr2+y]:=col;

  if t*((xc-x)*la1+lb1-(yc-y))<=0 then b1.canvas.pixels[xpr2-x,ypr2-y]:=col;

  if t*((xc-x)*la1+lb1-(yc+y))<=0 then b1.canvas.pixels[xpr2-x,ypr2+y]:=col;

  end else

  if par1 then

  begin

  if t*((yc-y)-yser)<=0 then b1.canvas.pixels[xpr2+x,ypr2-y]:=col;

  if t*((yc+y)-yser)<=0 then b1.canvas.pixels[xpr2+x,ypr2+y]:=col;

  if t*((yc-y)-yser)<=0 then b1.canvas.pixels[xpr2-x,ypr2-y]:=col;

  if t*((yc+y)-yser)<=0 then b1.canvas.pixels[xpr2-x,ypr2+y]:=col;

  end else

  begin

  if t*((xc+x)-xser)<=0 then b1.canvas.pixels[xpr2+x,ypr2+y]:=col;

  if t*((xc+x)-xser)<=0 then b1.canvas.pixels[xpr2+x,ypr2-y]:=col;

  if t*((xc-x)-xser)<=0 then b1.canvas.pixels[xpr2-x,ypr2+y]:=col;

  if t*((xc-x)-xser)<=0 then b1.canvas.pixels[xpr2-x,ypr2-y]:=col;

  end; 

  if di<0 then

  begin

   db:=2*di+2*y-1;

   if db<=0 then begin

                  x:=x+1;

                  di:=di+2*x+1;

                 end

            else begin

                  x:=x+1;

                  y:=y-1;

                  di:=di+2*(x-y+1);

                 end

  end else if di>0 then

           begin

            db:=2*di-2*x-1;

            if db<0 then begin

                          x:=x+1;

                          y:=y-1;

                          di:=di+2*(x-y+1);

                         end

                    else begin

                          y:=y-1;

                          di:=di-2*y+1;

                         end

           end else begin

                     x:=x+1;

                     y:=y-1;

                     di:=di+2*(x-y+1);

                    end; 

until y<0; 

end; 
 

procedure TRed.Ellips(xc,yc,enx,eny:integer);

var

   x,y,a,b:integer;

   a2,b2,dds,ddt,dxt,t,s,e,ca,cd,indx:longint;

   col:TColor;

begin 

  col:=Red.Shape1.Brush.Color;

  a:=abs(enx-xc);

  b:=abs(eny-yc);

  a2:=a*a;

  b2:=b*b;

  dds:=4*a2;

  ddt:=4*b2;

  dxt:=round(a2/sqrt(a2+b2));

  t:=0;

  s:=-4*a2*b;

  e:=round((-s/2)-2*b2-a2);

  ca:=-6*b2;

  cd:=ca-4*a2;

  x:=xc;

  y:=yc+b;

  b1.canvas.pixels[x,y]:=col;

  b1.canvas.pixels[2*xc-x,2*yc-y]:=col;

  b1.canvas.pixels[x,2*yc-y]:=col;

  b1.canvas.pixels[2*xc-x,y]:=col;

  for indx:=1 to dxt do

  begin

    x:=x+1;

    if e>=0 then e:=e+t+ca

    else

    begin

      y:=y-1;

      e:=e+t-s+cd;

      s:=s+dds;

   end;

    t:=t-ddt;

    b1.canvas.pixels[x,y]:=col;

    b1.canvas.pixels[2*xc-x,2*yc-y]:=col;

    b1.canvas.pixels[x,2*yc-y]:=col;

    b1.canvas.pixels[2*xc-x,y]:=col;

  end;

  dxt:=abs(y-yc);

  e:=round(e-(t/2+s/2+b2+a2));

  ca:=-6*a2;

  cd:=ca-4*b2;

  for indx:=1 to dxt do

  begin

    y:=y-1;

    if e<=0 then e:=e-s+ca

    else

    begin

      x:=x+1;

      e:=e-s+t+cd;

      t:=t-ddt;

    end;

    s:=s+dds;

    b1.canvas.pixels[x,y]:=col;

    b1.canvas.pixels[2*xc-x,2*yc-y]:=col;

    b1.canvas.pixels[x,2*yc-y]:=col;

    b1.canvas.pixels[2*xc-x,y]:=col;

  end;

end; 

procedure TRed.krug(xc,yc, x2, y2:integer);

var

  x3,y3,i,dxt: integer;

  r2,dst,t,s,e,ca,cd,indx: double;

  radius:integer;

  col:TColor;

begin

  col:=Red.Shape1.Brush.Color;

  radius:=Round(sqrt((x2-xc)*(x2-xc)+(y2-yc)*(y2-yc)));

  r2:=radius*radius;

  dst:= 4*r2;

  dxt:=Round(radius/1.414213562373);

  t:=0;

  s:=s-4*r2*radius;

  e:=(-s/2)-3*r2;

  ca:=ca-6*r2;