home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / michcirc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-08-04  |  1.1 KB  |  42 lines
  1. {draws true circles, not elipses, in HiRes. Modifiable for MedRes}
  2.  procedure MichCircle(cx,cy,radius,color:integer);
  3.    var x,y,d: integer;
  4.  
  5.     procedure EightPoints(x,y,ox,oy,c:integer);
  6.      const aspect = 50; {50 for 640x200,  25 for 320x200}
  7.      var  ax,px,py,nx,ny: integer;
  8.      begin
  9.       ax := (aspect*abs(x)+11) div 22;
  10.       px := ox + ax;   py := oy + y;
  11.       nx := ox - ax;   ny := oy - y;
  12.       plot(px,py,c);
  13.       plot(px,ny,c);
  14.       plot(nx,py,c);
  15.       plot(nx,ny,c);
  16.       ax := (aspect*abs(y)+11) div 22;
  17.       px := ox + ax;   py := oy + x;
  18.       nx := ox - ax;   ny := oy - x;
  19.       plot(px,py,c);
  20.       plot(px,ny,c);
  21.       plot(nx,py,c);
  22.       plot(nx,ny,c);
  23.     end;
  24.  
  25. begin {MichCircle}
  26.    x:=0;
  27.    y := radius;
  28.    d := 3 - 2*radius;
  29.    while x<y do begin
  30.       EightPoints(x,y,cx,cy,color);
  31.       if d<0 then
  32.          d := d + 4*x + 6
  33.       else begin
  34.          d := d + 4*(x-y) + 10;
  35.          y := y - 1
  36.       end;
  37.       x := x + 1
  38.    end; { while }
  39.    if x = y then
  40.       EightPoints(x,y,cx,cy,color);
  41. end; {MichCircle}
  42.