在Delphi中很好地缩放图像？

Question

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

丑陋的方式http://xrw.bc.ca/download/so/TImageStretch.gif

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

更好的方式http://xrw.bc.ca/download/so/NicerTImageStretch.png

有什么建议如何最好地做到这一点？试过JVCL,但它似乎没有这种能力.一个免费的图书馆会很好,但也许有一个低成本的图书馆,"只"这也很好.

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过滤器作为重建内核.以上示例应该适合您.

Answer 2

如果您还原为使用Win32 API调用,则可以将SetStretchBltMode用于HALFTONE并使用StretchBlt.我不确定这是否是使用默认的Delphi调用提供的,但这是我通常解决这个问题的方式.

更新(2014-09)刚才我处于类似情况(再次)并在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;

Answer 3

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