调整TGifimage的大小

时间:2016-12-18 23:37:41

标签: delphi delphi-xe8 tgifimage

我正在尝试使用以下过程调整TGifimage动画的大小。 我可以毫无问题地调整大小,但GIF动画的质量非常差。

知道如何提高质量吗?

目前,GIF动画显示黑色,看起来已损坏。

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;

1 个答案:

答案 0 :(得分:0)

据我所知,你不能用标准库做到这一点,你必须使用例如Graphics32。然后你可以编写一个像下面这样的简单函数,也可以选择采样器,具体取决于你需要什么,见Resampling

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

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;