//Code from Delphi 7

{ This procedure smooths an array of x,y pairs of points. The
  Smoothness parameter controls the iterations thru the routine.
  3 times will usually do. The number of points required in the
  array is the number of original points (Count) doubled for each
  Smoothness time thru the loop. The array starts out filled with
  Count points and the routine doubles the count each time through
  the loop filling the array. First and last points are preserved.
  Returns the new count. }

Type  pPntArray=^PntArray;                    { Use with Smooth() }
      PntArray=Array [0..0] of TPoint;

Function Smooth(pa:pPntArray; Count,Smoothness:Integer):Integer;
Var   I,J,K,L,M:Integer;
      r,r1:Real;
Begin
   K:=0; L:=Count;
   While K<Smoothness do Begin
      M:=(L*2);
      J:=M-1;
      I:=L-1;
      While J>0 do Begin
         pa^[J]:=pa^[I];
         If I>0 then Begin
            r:=pa^[I-1].X+pa^[I].X;
            r1:=pa^[I-1].Y+pa^[I].y;
            pa^[J-1].X:=Round(r/2);
            pa^[J-1].Y:=Round(r1/2);
            end; {create a point}
         If (M-J)>1 then Begin
            r:=pa^[J+2].X+pa^[J+1].X;
            r1:=pa^[J+2].Y+pa^[J+1].y;
            pa^[J+1].X:=Round(r/2);
            pa^[J+1].Y:=Round(r1/2);
            r:=pa^[J].X+pa^[J+1].X;
            r1:=pa^[J].Y+pa^[J+1].y;
            pa^[J].X:=Round(r/2);
            pa^[J].Y:=Round(r1/2);
            end; {blend it in}
         Dec(J,2); Dec(I);
         end; {create points between}
      L:=M;
      Inc(K);
      end; {smoothness}
   Result:=L;
end; {smooth}

procedure TForm1.DoOnPaint(Sender: TObject);
Var   ap:Array [0..25] of TPoint;
      x,y,I,J,x1,y1,x2,y2,x3,y3,x4,y4,x5,y5,x6,y6:Integer;
      final:Array [0..200] of TPoint;
      scalex,scaley,r,r1,r2,m,b:Real;
      count:Integer;
      circs:Boolean;

      Function Getx(xx:Integer):Integer;
      Begin
            r:=xx; r:=r*scalex;
            Result:=Round(r);
      end;

      Function Gety(yy:Integer):Integer;
      Begin
            r:=yy; r:=r*scaley;
            Result:=Round(r)-150;
      end;

begin
      scalex:=0.1; scaley:=0.1;
      ap[0].x:=7000; ap[0].Y:=2000;
      ap[1].x:=6500; ap[1].Y:=2000;
      ap[2].x:=5959; ap[2].Y:=2250;
      ap[3].x:=4915; ap[3].Y:=2500;
      ap[4].x:=4134; ap[4].Y:=3500;
      ap[5].x:=3562; ap[5].Y:=4250;
      ap[6].x:=2616; ap[6].Y:=6000;
      ap[7].x:=2242; ap[7].Y:=6600;
      ap[8].x:=2000; ap[8].Y:=7000;
      ap[9].x:=2000; ap[9].Y:=7000;
      count:=10;

      J:=1;
      canvas.Pen.Color:=clred;
      x:=Getx(ap[0].X);
      y:=Gety(ap[0].Y);
      canvas.MoveTo(x,y);
      canvas.Ellipse(x-5,y-5,x+5,y+5);
      While J<count do Begin
         x:=Getx(ap[J].X);
         y:=Gety(ap[J].Y);
         canvas.LineTo(x,y);
         canvas.Ellipse(x-5,y-5,x+5,y+5);
         Inc(J);
         end;
      canvas.Pen.Color:=clblack;

      J:=0;
      While J<count do Begin
         final[J].X:=ap[J].X;
         final[J].Y:=ap[J].Y;
         Inc(J);
         end; {original points}

      count:=Smooth(@final,10,3);

      canvas.Pen.Color:=clblue;
      J:=0;
      x:=Getx(final[J].X);
      y:=Gety(final[J].Y);
      canvas.MoveTo(x,y);
      canvas.Ellipse(x-5,y-5,x+5,y+5);

      J:=1;
      While J<count do Begin
         x:=Getx(final[J].X);
         y:=Gety(final[J].Y);
         canvas.LineTo(x,y);
         canvas.Ellipse(x-5,y-5,x+5,y+5);
         Inc(J);
         end;
      canvas.Pen.Color:=clblack;

end;