...use anti-aliasing?

http://www.swissdelphicenter.ch/torry/showcode.php?id=1484

Author: Horst Kniebusch

{

Originally written by Horst Kniebusch, modified by alioth to make it(alot) faster.

}

procedure Antialiasing ( Image : TImage ; Percent : Integer );

type

 TRGBTripleArray = array [ 0 .. 32767 ] of TRGBTriple ;

 PRGBTripleArray = ^ TRGBTripleArray ;

var

 SL , SL2 : PRGBTripleArray ;

 l , m , p : Integer ;

 R , G , B : TColor ;

 R1 , R2 , G1 , G2 , B1 , B2 : Byte ;

begin

  with Image . Canvas do

  begin

   Brush . Style := bsClear ;

   Pixels [ 1 , 1 ] := Pixels [ 1 , 1 ];

    for l := 0 to Image . Height - 1 do

    begin

     SL := Image . Picture . Bitmap . ScanLine [ l ];

      for p := 1 to Image . Width - 1 do

      begin

       R1 := SL [ p ]. rgbtRed ;

       G1 := SL [ p ]. rgbtGreen ;

       B1 := SL [ p ]. rgbtBlue ;

        // Left

        if ( p < 1 ) then

         m := Image . Width

        else

         m := p - 1 ;

       R2 := SL [ m ]. rgbtRed ;

       G2 := SL [ m ]. rgbtGreen ;

       B2 := SL [ m ]. rgbtBlue ;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then

        begin

         R := Round ( R1 + ( R2 - R1 ) * 50 / ( Percent + 50 ));

         G := Round ( G1 + ( G2 - G1 ) * 50 / ( Percent + 50 ));

         B := Round ( B1 + ( B2 - B1 ) * 50 / ( Percent + 50 ));

         SL [ m ]. rgbtRed := R ;

         SL [ m ]. rgbtGreen := G ;

         SL [ m ]. rgbtBlue := B ;

        end ;

        //Right

        if ( p > Image . Width - 2 ) then

         m := 0

        else

         m := p + 1 ;

       R2 := SL [ m ]. rgbtRed ;

       G2 := SL [ m ]. rgbtGreen ;

       B2 := SL [ m ]. rgbtBlue ;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then

        begin

         R := Round ( R1 + ( R2 - R1 ) * 50 / ( Percent + 50 ));

         G := Round ( G1 + ( G2 - G1 ) * 50 / ( Percent + 50 ));

         B := Round ( B1 + ( B2 - B1 ) * 50 / ( Percent + 50 ));

         SL [ m ]. rgbtRed := R ;

         SL [ m ]. rgbtGreen := G ;

         SL [ m ]. rgbtBlue := B ;

        end ;

        if ( l < 1 ) then

         m := Image . Height - 1

        else

         m := l - 1 ;

        //Over

       SL2 := Image . Picture . Bitmap . ScanLine [ m ];

       R2 := SL2 [ p ]. rgbtRed ;

       G2 := SL2 [ p ]. rgbtGreen ;

       B2 := SL2 [ p ]. rgbtBlue ;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then

        begin

         R := Round ( R1 + ( R2 - R1 ) * 50 / ( Percent + 50 ));

         G := Round ( G1 + ( G2 - G1 ) * 50 / ( Percent + 50 ));

         B := Round ( B1 + ( B2 - B1 ) * 50 / ( Percent + 50 ));

         SL2 [ p ]. rgbtRed := R ;

         SL2 [ p ]. rgbtGreen := G ;

         SL2 [ p ]. rgbtBlue := B ;

        end ;

        if ( l > Image . Height - 2 ) then

         m := 0

        else

         m := l + 1 ;

        //Under

       SL2 := Image . Picture . Bitmap . ScanLine [ m ];

       R2 := SL2 [ p ]. rgbtRed ;

       G2 := SL2 [ p ]. rgbtGreen ;

       B2 := SL2 [ p ]. rgbtBlue ;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then

        begin

         R := Round ( R1 + ( R2 - R1 ) * 50 / ( Percent + 50 ));

         G := Round ( G1 + ( G2 - G1 ) * 50 / ( Percent + 50 ));

         B := Round ( B1 + ( B2 - B1 ) * 50 / ( Percent + 50 ));

         SL2 [ p ]. rgbtRed := R ;

         SL2 [ p ]. rgbtGreen := G ;

         SL2 [ p ]. rgbtBlue := B ;

        end ;

      end ;

    end ;

  end ;

end ;

//Example:

procedure TForm1 . Button1Click ( Sender : TObject );

begin

 Antialiasing ( Image1 , 80 );

end ;