Two simple functions to scale or rotate images

[AngusJohnson]

I couldn't find an easy way to scale or rotate images, so resorted to making my own.
And since I suspect others may find these functions useful too, I'm posting these functions here.
And of course there may be a better/simpler way to do this.

uses GR32, GR32_Resamplers, GR32_Transforms;

const 
  defaultKernelClassNameString = 'TCubicKernel';

procedure ScaleImage(img: TBitmap32; dx, dy: double;
  const kernelClassNameString: string = defaultKernelClassNameString);
var
  B: TBitmap32;
  T: TAffineTransformation;
  rec: TFloatRect;
begin
  T := TAffineTransformation.Create;
  B := TBitmap32.Create;
  try
    B.Assign(img);
    T.BeginUpdate;
    T.SrcRect := FloatRect(0, 0, B.Width, B.Height);
    T.Scale(dx, dy);
    T.EndUpdate;

    rec := T.GetTransformedBounds;
    img.SetSize(Ceil(rec.Width), Ceil(rec.Height));
    B.ResamplerClassName := 'TKernelResampler';
    TKernelResampler(B.Resampler).KernelClassName := kernelClassNameString;
    Transform(img, B, T);
  finally
    B.Free;
    T.Free;
  end;
end;

procedure ScaleImage(img: TBitmap32; sx, sy: double;
  const kernelClassNameString: string = defaultKernelClassNameString);
var
  B: TBitmap32;
  rec: TRect;
begin
  B := TBitmap32.Create;
  try
    B.Assign(img);
    rec := Rect(0,0, Max(1,Round(img.Width * sx)), Max(1,Round(img.Height * sy)));
    img.SetSize(rec.Width, rec.Height);
    B.ResamplerClassName := 'TKernelResampler';
    TKernelResampler(B.Resampler).KernelClassName := kernelClassNameString;
    TKernelResampler(B.Resampler).Resample(img, rec, rec, B, B.BoundsRect, dmOpaque, nil);
  finally
    B.Free;
  end;
end;

procedure RotateImage(img: TBitmap32; degrees: double;
  const kernelClassNameString: string = defaultKernelClassNameString);
var
  B: TBitmap32;
  T: TAffineTransformation;
  rec: TFloatRect;
begin
  T := TAffineTransformation.Create;
  B := TBitmap32.Create;
  try
    B.Assign(img);
    T.BeginUpdate;
    T.SrcRect := FloatRect(0, 0, B.Width, B.Height);
    T.Translate(-0.5 * B.Width, -0.5 * B.Height);
    T.Rotate(0, 0, degrees);
    rec := T.GetTransformedBounds;
    T.Translate(0.5 * rec.Width, 0.5 * rec.Height);
    T.EndUpdate;

    img.SetSize(Ceil(rec.Width), Ceil(rec.Height));
    B.ResamplerClassName := 'TKernelResampler';
    TKernelResampler(B.Resampler).KernelClassName := kernelClassNameString;
    Transform(img, B, T);
  finally
    B.Free;
    T.Free;
  end;
end;

And here's a very simple VCL application that tests/uses these functions ....

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  public
    img: TImage32;
  end;

procedure TForm1.FormCreate(Sender: TObject);
const
  // TBoxKernel, TLinearKernel, TCubicKernel, TCosineKernel, THermiteKernel
  kernelClassNameStr = 'TCubicKernel';
begin
  img := TImage32.Create(self);
  img.Parent := self;
  img.Align := alClient;
  img.BitmapAlign := baCenter;

  img.Bitmap.SetSize(3,3);
  img.Bitmap.Clear(clBlue32);
  img.Bitmap.img.Bitmap.Pixel[1,1] := clRed32;
  ScaleImage(img.Bitmap, 50, 50, kernelClassNameStr);
  RotateImage(img.Bitmap, 15, kernelClassNameStr);

  img.Bitmap.DrawMode := dmBlend;
  img.ScaleMode := smOptimalScaled;
  img.Scale := 20;
end;

Note: It's unfortunate that a small amount of transparency creeps into images when they are scaled.

Edit: I've amended and simplified the ScaleImage function so it no longer uses TAffineTransformation, and this has removed the transparency bleed problem.

[andersmelander]

Very nice.

Yes, rotate and resize are so common that it would make sense to have them as standard utility functions. I guess the reason why it was never done is that there are so many options that can be tweaked in both operations that we would end up with a function with 10-15 parameters.
Still, I think two functions with "good enough for most" defaults would be a very good idea. I know many people simply give up when they discover that they need to learn about resampling and kernels before they can resize a bitmap.

I have a resize and rotate demo in a branch that I completely forgot about. I'll get that cleaned up and pushed.

The two functions can be extracted from the demo. I'll do that later. The rotate is very similar to yours but the resize is a bit different as I don't use a transformation there.

Note: It's unfortunate that a small amount of transparency creeps into images when they are scaled.

I'm not sure what is causing that. I'm not seeing it in my code but I will try to reproduce.

[AngusJohnson]

I've just noticed a couple of unnecessary T.Translate calls in the ScaleImage function that need cleaning up.

Also. I think the transparency bleed is really only apparent when there is very significant scaling

[andersmelander]

Here's what I'm getting:

I think it has something to do with the "outer color"; When sampling past the edge of the bitmap the resamplers need to sample "something". In my code I use Resampler.PixelAccessMode=pamTransparentEdge.

[andersmelander]

In case I don't have time to push today, here's the rotate code:

procedure TFormMain.PerformRotate(BitmapSource, BitmapDest: TBitmap32; Angle: Single; ResamplerClass: TCustomResamplerClass);
var
  Transformation: TAffineTransformation;
  Resampler: TCustomResampler;
  Rasterizer: TRasterizer;
  CombineInfo: TCombineInfo;
  Transformer: TTransformer;
  TransformedBounds: TFloatRect;
  TransformedFloatWidth, TransformedFloatHeight: Single;
  TransformedWidth, TransformedHeight: integer;
  SourceGhost: TBitmap32;
begin
  if (Abs(Frac(Angle / 360)) < 0.1/360) then
  begin
    BitmapDest.Assign(BitmapSource);
    exit;
  end;

  SourceGhost := TBitmap32.Create(TGhostingBackend);
  try
    TGhostingBackend(SourceGhost.Backend).GhostBitmap(BitmapSource);

    Transformation := TAffineTransformation.Create;
    try
      Transformation.Clear;
      Transformation.SrcRect := FloatRect(0, 0, SourceGhost.Width, SourceGhost.Height);

      // Move origin so we will be rotating around center of bitmap
      Transformation.Translate(-SourceGhost.Width * 0.5, -SourceGhost.Height * 0.5);

      // Rotate
      Transformation.Rotate(0, 0, Angle);

      TransformedBounds := Transformation.GetTransformedBounds;

      // Size destination to fit transformed bitmap
      TransformedFloatWidth := TransformedBounds.Right-TransformedBounds.Left;
      TransformedWidth := Ceil(TransformedFloatWidth-0.00001);
      TransformedFloatHeight := TransformedBounds.Bottom-TransformedBounds.Top;
      TransformedHeight := Ceil(TransformedFloatHeight-0.00001);

      // Center in destination bitmap
      Transformation.Translate(-TransformedBounds.Left + (TransformedWidth-TransformedFloatWidth) * 0.5, -TransformedBounds.Top + (TransformedHeight-TransformedFloatHeight) * 0.5);

      if (ResamplerClass = nil) then
        ResamplerClass := TCustomResamplerClass(SourceGhost.Resampler.ClassType);

      Resampler := ResamplerClass.Create(SourceGhost);

      if (Resampler is TKernelResampler) then
      begin
        TKernelResampler(Resampler).KernelMode := kmTableLinear;
        TKernelResampler(Resampler).TableSize := 256;
        TKernelResampler(Resampler).Kernel := TCubicKernel.Create;//TLanczosKernel.Create;
        // TWindowedSincKernel(TKernelResampler(Resampler).Kernel).Width := FKernelSize;
      end;

      Resampler.PixelAccessMode := pamTransparentEdge;
      // Note: pamSafe relies on BackgroundColor
      // Resampler.PixelAccessMode := pamSafe;

      Transformer := TTransformer.Create(Resampler, Transformation);
      try

        // Rasterizer := DefaultRasterizerClass.Create;
        Rasterizer := TMultithreadedRegularRasterizer.Create;
        try
          Rasterizer.Sampler := Transformer;

          // Must use CombineInfo so BufferSource's MasterAlpha isn't used in the rasterization.
          CombineInfo.SrcAlpha := 255;
          CombineInfo.DrawMode := dmOpaque;
          // cmMerge minimizes blend artifacts: rotate pure color rectangle on transparent background. Rotated edges does not retain original color.
          CombineInfo.CombineMode := cmMerge;
          CombineInfo.CombineCallBack := nil;
          CombineInfo.TransparentColor := 0;

          BitmapDest.SetSize(TransformedWidth, TransformedHeight);
          BitmapDest.Clear(0);
          Rasterizer.Rasterize(BitmapDest, BitmapDest.BoundsRect, CombineInfo);

        finally
          Rasterizer.Free;
        end;
      finally
        Transformer.Free;
      end;
    finally
      Transformation.Free;
    end;
  finally
    SourceGhost.Free;
  end;
end;

[andersmelander]

...and the resize:

procedure TFormMain.PerformResize(BitmapSource, BitmapDest: TBitmap32; NewWidth, NewHeight: integer; ResamplerClass: TCustomResamplerClass);
var
  Resampler: TCustomResampler;
  SourceGhost: TBitmap32;
begin
  BitmapDest.SetSize(NewWidth, NewHeight);

  if (ResamplerClass = nil) then
    ResamplerClass := TCustomResamplerClass(BitmapSource.Resampler.ClassType);

  SourceGhost := TBitmap32.Create(TGhostingBackend);
  try
    TGhostingBackend(SourceGhost.Backend).GhostBitmap(BitmapSource);

    Resampler := ResamplerClass.Create(SourceGhost);

    if (Resampler is TKernelResampler) then
    begin
      TKernelResampler(Resampler).KernelMode := kmTableLinear;
      TKernelResampler(Resampler).TableSize := 256;
      TKernelResampler(Resampler).Kernel := TCubicKernel.Create;//TLanczosKernel.Create;
      // TWindowedSincKernel(TKernelResampler(Resampler).Kernel).Width := FKernelSize;
    end;

    Resampler.PixelAccessMode := pamTransparentEdge;
    // Note: pamSafe relies on BackgroundColor
    // Resampler.PixelAccessMode := pamSafe;

    TResamplerCracker(Resampler).Resample(BitmapDest, BitmapDest.BoundsRect, BitmapDest.BoundsRect, SourceGhost, SourceGhost.BoundsRect, dmOpaque, nil);

  finally
    SourceGhost.Free;
  end;
end;

[andersmelander]

...and some support stuff

type
  TBitmap32Cracker = class(TBitmap32);
  TResamplerCracker = class(TCustomResampler);

type
  // A backend that allows us to create a bitmap that has its own properties but
  // uses the memory storage from a host bitmap.
  TGhostingBackend = class(TCustomBackend)
  public
    procedure GhostBitmap(ABitmap: TBitmap32);
  end;

procedure TGhostingBackend.GhostBitmap(ABitmap: TBitmap32);
begin
  FOwner.SetSizeFrom(ABitmap);
  TBitmap32Cracker(ABitmap).CopyPropertiesTo(FOwner);
  FBits := ABitmap.Bits;
  Changed;
end;

[andersmelander]

Btw, I can see that you're working on your own resampler. Have you looked at the resampler work done by @rmesch ? There's some interesting stuff there. I had hoped to get more of his ideas integrated in Graphics32 but there's just too much other stuff to do.
Also, in case you missed it: https://en.delphipraxis.net/topic/6597-parallel-resampling-of-vcl-bitmaps/

[AngusJohnson]

When sampling past the edge of the bitmap the resamplers need to sample "something"

The problem is when sampling very close to edges (not just past them) that the 'outer' (ie fully transparent) color bleeds in.

Have you looked at the resampler work done by @rmesch ?

No, I haven't. Apart from just tidying up existing code, I'm fully occupied with other projects (including very slowly working towards adding triangulation to my Clipper library).

[andersmelander]

Apart from just tidying up existing code, I'm fully occupied with other projects

Too bad you don't have time to work on resampling... ;-)

[AngusJohnson]

Too bad you don't have time to work on resampling... ;-)

🤣.
I did indicate that my first priority was to tidy up existing code, and resampling really did need a lot of tidying.

[andersmelander]

The example I mentioned above has now been merged: 2b4857d

[luebbe]

I had hoped to get more of his ideas

according to the first name "Renate", it should be "her" ideas :)

[andersmelander]

You're probably right. I never thought about that.

[AngusJohnson]

I've just edited my original post with an improved (and simplified) ScaleImage function.
It now seems that TAffineTransformation is the likely source of the transparency bleed issue I mentioned in that post.