Scale an image nicely in Delphi?

Question

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.

_{(source: xrw.bc.ca)}

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

_{(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.

Answer 1

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.

Answer 2

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;