在Delphi中如何优雅地缩放图像？

Question

我正在使用Delphi 2009，希望将图像缩放以适应可用空间。 图像始终比原始尺寸小显示。问题在于TImage Stretch属性不能很好地处理并损害图片的可读性。您有什么建议吗？已尝试JVCL，但似乎没有这种功能。免费库不错，但低成本库也可以。 _{(来源: xrw.bc.ca)} 我希望看到它像这样缩放： _{(来源: xrw.bc.ca)}

- X-Ray

---

我建议使用JanFX库（现已并入fat Jedi发行版，但幸运的是你可以从Jedi中提取此文件）。在JanFX中查看Stretch（我认为）函数。它提供了非常好的平滑效果（不如Graphics32好，但足够好），而且速度快得多。 - Gabriel

Answer 1

你非常非常想要使用Graphics32。

procedure DrawSrcToDst(Src, Dst: TBitmap32);
var
  R: TKernelResampler;  
begin
  R := TKernelResampler.Create(Src);
  R.Kernel := TLanczosKernel.Create;
  Dst.Draw(Dst.BoundsRect, Src.BoundsRect, Src);
end;

在对图像进行重采样时，有多种方法和滤波器可供选择。上面的示例使用了一种基于卷积核的重采样方法（有点慢，但效果很好），以及Lanczos滤波器作为重构核心。上面的示例应该适用于您的需求。

- Leonardo Herrera

---

这是一个很酷的工具，但我发现它对于我需要的东西来说太慢了。现在我有了它，我肯定会用它做其他事情。谢谢！ - X-Ray

也许他的速度慢是因为他每秒在进行快速更新？我曾经遇到过同样的性能问题，而且我的电脑是Intel Quad Core I5并且内存充足。我从内核重采样器切换到草稿重采样器（TDraftResampler），这个性能问题就解决了。在我的应用程序中，我每秒更新1100w x 1100h图像20次，然后进行下采样，而Lanczos内核速度太慢了跟不上更新。虽然感谢Graphics32库的提示，它真的是一件好事，并且它确实有助于改善我的下采样图片的外观。 - Robert Oschler

点击链接时出现“服务暂时不可用”。 - Codebeat

你真的非常想避免使用Graphics32。Graphics32很不错，但是过于复杂。仅因为需要一个函数而使用这样一个庞大的库是完全过度的。我建议使用JanFX（现在可以在Jedi中找到）。你可以从那里复制/粘贴你所需的一个函数。 - Gabriel

所以你建议安装Jedi，因为你不喜欢复杂 - 不，不，不。Janfx重新采样器只是一个函数，在一个文件中。完全独立于库。你只需提取该文件即可。您还可以在互联网上查找janfx。有些网站在将其集成到jedi之前就列出了该库。 - Gabriel

Answer 2

如果您恢复使用Win32 API调用，可以使用SetStretchBltMode函数并将其设置为HALFTONE，然后使用StretchBlt函数。我不确定默认的Delphi调用是否提供此功能，但这是我通常解决此问题的方法。

更新（2014年9月）刚才我也遇到了类似的情况，并且在TScrollBox中有一个TImage，同时窗体上还有很多其他内容，我希望Image1.Stretch:=true;可以半色调化。正如Rob指出的那样，当目标画布为每像素8位或更低并且源画布具有更高位深度时，TBitmap.Draw仅使用HALFTONE...因此，我使用其中之一“修复”它：Image1.Picture.Bitmap。

TBitmapForceHalftone=class(TBitmap)
protected
  procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
end;

{ TBitmapForceHalftone }

procedure TBitmapForceHalftone.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  p:TPoint;
  dc:HDC;
begin
  //not calling inherited; here!
  dc:=ACanvas.Handle;
  GetBrushOrgEx(dc,p);
  SetStretchBltMode(dc,HALFTONE);
  SetBrushOrgEx(dc,p.x,p.y,@p);
  StretchBlt(dc,
    Rect.Left,Rect.Top,
    Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,
    Canvas.Handle,0,0,Width,Height,ACanvas.CopyMode);
end;

- Stijn Sanders

---

谢谢您，这提供了速度和质量之间的良好平衡。 - X-Ray

如果目标画布的像素位数小于或等于8且源位图的像素位数大于目标画布的像素位数，则Delphi会自动将拉伸模式设置为Halftone。否则，它会对彩色位图使用Stretch_DeleteScans。 - Rob Kennedy

谢谢Rob。我需要它来始终使用HALFTONE。顺便说一句，感谢您在Stack Overflow上做了这么多好事。 - X-Ray

奇怪，我当时错过了Rob的帖子吗？无论如何，请注意我已经添加了一些关于TBitmapForceHalftone的内容。 - Stijn Sanders

非常、非常、非常、非常、非常、非常好！谢谢。 - Codebeat

Answer 3

您可以尝试使用GraphUtil中内置的Delphi ScaleImage功能

- David

---

最佳答案 :) - mad

Answer 4

我使用GDIPOB.pas中的TGPGraphics类。

如果Canvas是TGPGraphics，Bounds是TGPRectF和NewImage是TGPImage实例：

Canvas.SetInterpolationMode(InterpolationModeHighQualityBicubic);
Canvas.SetSmoothingMode(SmoothingModeHighQuality);
Canvas.DrawImage(NewImage, Bounds, 0, 0, NewImage.GetWidth, NewImage.GetHeight, UnitPixel);

您可以通过更改插值模式来选择质量与速度之间的平衡。

InterpolationModeDefault             = QualityModeDefault;
InterpolationModeLowQuality          = QualityModeLow;
InterpolationModeHighQuality         = QualityModeHigh;
InterpolationModeBilinear            = 3;
InterpolationModeBicubic             = 4;
InterpolationModeNearestNeighbor     = 5;
InterpolationModeHighQualityBilinear = 6;
InterpolationModeHighQualityBicubic  = 7;

平滑模式：

SmoothingModeDefault     = QualityModeDefault;
SmoothingModeHighSpeed   = QualityModeLow;
SmoothingModeHighQuality = QualityModeHigh;
SmoothingModeNone        = 3;
SmoothingModeAntiAlias   = 4;

注意：这需要XP或更高版本，或者在安装程序中打包gdiplus.dll。

- Gad D Lord