Delphi 10.4.2 无需外部库实现高质量图片缩放的问题求解

问题原因 #

两次测试的异常原因分别为：

1. 第一组测试缩放质量差是因为TCanvas.StretchDraw默认使用低质量插值模式，未开启高质量重采样
2. 第二组测试输出空图是调用逻辑错误：
   • 预先调用LResized.Assign(LBitmap)给缩放目标对象赋值原图、后续修改尺寸的操作会清空内容，ScaleImage调用前不需要给目标对象预赋值
   • ScaleImage调用后多余执行的LResized.SetSize再次清空了已经绘制完成的缩放内容

正确实现方案（无外部依赖，高质量缩放） #

以下两种方案均为Delphi原生实现，不需要引入任何第三方库：

方案1：使用GraphUtil.ScaleImage（推荐，内置高质量插值） #

替换原有测试块的代码即可：

{$REGION '修正后的ScaleImage实现'}
LResized := TBitmap.Create;
try
  // 仅设置目标位图参数，不要预赋值原图
  LResized.PixelFormat := LBitmap.PixelFormat; // 像素格式与源图保持一致
  LResized.Width := LNewWidth;
  LResized.Height := LNewHeight;
  // 传入源图、目标图、缩放比例即可
  GraphUtil.ScaleImage(LBitmap, LResized, LNewWidth / LOldWidth);
  // 不需要额外调用SetSize，直接赋值输出
  LImageOut.Assign(LResized);
finally
  LResized.Free;
end;
{$ENDREGION}

方案2：修改StretchDraw插值模式（兼容性更好） #

如果不想依赖GraphUtil单元，可以通过修改GDI拉伸模式实现高质量缩放：

{$REGION '修正后的高质量StretchDraw实现'}
LBitmap.PixelFormat := pf24bit; // 带透明的图片改为pf32bit
LBitmap.Width := LNewWidth;
LBitmap.Height := LNewHeight;
// 开启高质量半色调插值
SetStretchBltMode(LBitmap.Canvas.Handle, HALFTONE);
SetBrushOrgEx(LBitmap.Canvas.Handle, 0, 0, nil);
// 执行缩放绘制
StretchDraw(LBitmap.Canvas, Rect(0, 0, LNewWidth, LNewHeight), LImageIn);
LImageOut.Assign(LBitmap);
{$ENDREGION}

该方案需要在uses中引入Winapi.Windows单元，属于系统原生接口，兼容性更强。

注意：如果处理带透明通道的PNG/GIF图片，需要将源位图和目标位图的PixelFormat设置为pf32bit，同时指定AlphaFormat := afPremultiplied，避免透明背景显示异常。

内容的提问来源于stack exchange，提问作者Marina