Resizing TGifimage

I am trying to resize TGifimage animation using the following procedure. I can resize without no issues, but the quality of the animated gif is very bad.

Any idea how to enhance the quality?

Currently the animated gifs comes out black and looks corrupted.

procedure ResizeGif(Src, Dst: TGifImage; const newHeight, newWidth: integer);
var
  bmp, bmp2: TBitmap;
  gifren: TGIFRenderer;
  I: integer;

begin
  if (Src.Empty) or not assigned(Src.Images[0]) then
  begin
    exit;
  end;

  bmp := TBitmap.Create;
  bmp2 := TBitmap.Create;
  gifren := TGIFRenderer.Create(Src);

  try
    bmp.PixelFormat := pf24bit;
    bmp2.PixelFormat := pf24bit;
    bmp.Width := newWidth;
    bmp.Height := newHeight;

    for I := 0 to Src.Images.Count - 1 do
    begin

      bmp.SetSize(newWidth, newHeight);

      gifren.Draw(bmp.Canvas, bmp.Canvas.ClipRect);

      bmp2.SetSize(newWidth, newHeight);

      bmp2.Canvas.StretchDraw(Rect(0, 0, newWidth, newHeight), bmp);

      TGIFGraphicControlExtension.Create(Dst.add(bmp2)).Delay :=
        gifren.FrameDelay div 10;;

      gifren.NextFrame;

    end;

    TGIFAppExtNSLoop.Create(Dst.Images.Frames[0]).Loops := 0;

  finally
    bmp.free;
    bmp2.free;
    gifren.free;
  end;

end;

Solution

For what I know, you simply can't do that with standard libraries and you must use e.g. Graphics32. Then you can write a simple function like below and also pick sampler, depending on what exactly you need, see Resampling.

Class name        | Quality | Performance
------------------------------------------
TNearestResampler | low     | high
TDraftResampler   | medium  | high (downsampling only)
TLinearResampler  | medium  | medium
TKernelResampler  | high    | low (depends on kernel width)

Example of TGraphicHelper.Resize

procedure TGraphicHelper.Resize(const AWidth, AHeight: Integer);
var
  lBmpSource, lBmpResize : TBitmap32;
  lBmpTemp : TBitmap;
begin
  lBmpSource := TBitmap32.Create;
  try
    TDraftResampler.Create(lBmpSource);
    lBmpSource.DrawMode := dmOpaque;
    lBmpSource.Assign(Self);

    lBmpResize := TBitmap32.Create;
    try
      lBmpResize.Width := AWidth;
      lBmpResize.Height := AHeight;
      lBmpResize.Clear(clWhite32);
      lBmpResize.Draw(lBmpResize.BoundsRect, lBmpSource.BoundsRect, lBmpSource);

      lBmpTemp := TBitmap.Create;
      try
        lBmpTemp.Assign(lBmpResize);
        Self.Assign(lBmpTemp);
      finally
        lBmpTemp.Free;
      end;
    finally
      lBmpResize.Free;
    end;
  finally
    lBmpSource.Free;
  end;
end;