Delphi 中可以很好地缩放图像吗?

发布于 2024-08-16 10:58:17 字数 706 浏览 6 评论 0原文

我正在使用 Delphi 2009,我想缩放图像以适应可用空间。显示的图像始终小于原始图像。问题是 TImage Stretch 属性效果不佳,并且损害了图片的可读性。

丑陋的方式
(来源:xrw.bc.ca

我希望看到它像这样缩放:

更好的方式
(来源:xrw.bc.ca

有什么建议如何最好地做到这一点?尝试过JVCL,但好像没有这个能力。一个免费的图书馆会很好,但也许有一个低成本的图书馆“只”做这件事也会很好。

I'm using Delphi 2009 and I'd like to scale an image to fit the available space. the image is always displayed smaller than the original. the problem is TImage Stretch property doesn't do a nice job and harms the picture's readability.

ugly way
(source: xrw.bc.ca)

I'd like to see it scaled like this instead:

nicer way
(source: xrw.bc.ca)

Any suggestions how best to do this? Tried JVCL, but it doesn't seem to have this ability. A free library would be nice but maybe there's a low cost library that does "only" this would be good as well.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(4

淡莣 2024-08-23 10:58:17

真的非常想使用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 过滤器作为重建内核。上面的例子应该适合你。

You really, really want to use 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;

You have several methods and filters to choose when resampling an image. The example above uses a kernel resampler (kinda slow, but with great results) and a Lanczos filter as reconstruction kernel. The above example should work for you.

烟织青萝梦 2024-08-23 10:58:17

如果您恢复使用 Win32 API 调用,则可以使用 SetStretchBltMode< /a> 到 HALFTONE 并使用 StretchBlt。我不确定这是否是使用默认的 Delphi 调用提供的,但这就是我通常解决此问题的方式。

更新(2014-09) 刚才我(再次)遇到了类似的情况,并且在 TScrollBox 中有一个 TImage,表单上还有更多内容,并且真的想要 Image1.Stretch: =true; 进行半色调。正如 Rob 指出的,TBitmap.Draw 仅当目标画布为每像素 8 位或更低且源画布具有更多位时使用 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;

If you revert to using Win32 API calls, you can use SetStretchBltMode to HALFTONE and use StretchBlt. I'm not sure if this is provided using default Delphi calls, but that's the way I generally solve this issue.

Update (2014-09) Just now I was in a similar situation (again) and had a TImage in a TScrollBox with lots more going on on the form, and really wanted Image1.Stretch:=true; to do halftone. As Rob points out, TBitmap.Draw uses HALFTONE only when the destination canvas is 8 bits-per-pixel or lower and the source canvas has more... So I 'fixed' it with assigning Image1.Picture.Bitmap to one of these instead:

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;
傻比既视感 2024-08-23 10:58:17

您可以尝试 GraphUtil 中的内置 Delphi ScaleImage

You could try the built-in Delphi ScaleImage from GraphUtil

葬﹪忆之殇 2024-08-23 10:58:17

我使用 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;

和平滑模式来选择质量 VS 速度因子:

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

注意:这需要 XP 或更高版本或捆绑 gdiplus安装程序中的 .dll。

I use GDIPOB.pas's TGPGraphics class

if Canvas is TGPGraphics, Bounds is TGPRectF and NewImage is TGPImage instance:

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

You can choose the quality VS speed factor by changing the interpolation mode

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

and smooting mode:

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

NOTE: This would require XP or later or bundeling the gdiplus.dll in your installer.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文