Scale an image nicely in Delphi?
Asked Answered
S

4

17

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.

Shawm answered 29/12, 2009 at 18:30 Comment(1)
I propose JanFX library (now incorporated into the fat Jedi distribution but FORTUNATELY you can extract this file from Jedi). In JanFX see the Stretch (I think) function. It gives a very nice smoothing (not as good as Graphics32 but good enough) but much much faster.Clap
L
17

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;
Loanloanda answered 29/12, 2009 at 19:33 Comment(4)
thank you; this provided a good balance btwn speed and quality.Shawm
Delphi sets the stretch mode to Halftone automatically if the destination canvas's bits-per-pixel count is less than or equal to 8 and the source bitmap's bits-per-pixel count is greater than the destination's. Otherwise, it uses Stretch_DeleteScans for color bitmaps.Pernell
thank you rob. i needed it to use HALFTONE always. btw, thank you for doing so much good stuff on stack overflow.Shawm
Strange, did I miss Rob's post back then? Anyway, please note I've added a bit about TBitmapForceHalftone.Loanloanda
P
33

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.

Psychosis answered 29/12, 2009 at 18:39 Comment(11)
it's a cool tool but i found it to be too slow for exactly what i needed. now that i have it, i'm sure i'll use it for something else. thank you!Shawm
Great -- however, if you find it slow I'm mostly inclined to think that something was wrong somewhere else. Anyways, glad you found a good solution for your problem!Psychosis
Perhaps it was slow for him because he was doing fast updates each second? I had the same performance problem and this was on an Intel Quad Core I5 with plenty of memory. I switched from a kernel resampler to a draft resampler (TDraftResampler) and the performance problem went away. In my application's case I was updating a 1100w x 1100h image 20 times a second and then downsampling and the Lanczos kernel was too slow to keep up. Thanks for the tip about the Graphics32 library though. It's a real blessing and it really helped improve the look of my downsampled image.Skydive
i was having some issues with it being too slow but the way i have now structured it, this is no longer a problem. nice results. thank you!Shawm
Service Temporarily Unavailable when clicking on the link.Sideband
You really really want to avoid Graphics32. Graphics32 is nice. But is overly complex. Total overkill to use such a big library just because you need ONE function. I recommend JanFX (now can be found in Jedi). You can just copy/paste the one function you need from there.Clap
@Rigel - so you recommend to install Jedi because you don't like complex. There is nothing wrong in installing a library because you want one function - that's why we have compilers and linkers. All the code you need is pasted above.Psychosis
@LeonardoHerrera - those 3 lines of code will compile into a BIG binary DCU. But, yes, the code for re-sampling only, as you put it there, is small = and easy to understand. (hm... maybe for except the TBitmap32 parameters)Clap
I think JanFX will give you the same functionality but with a much much much lower binary size.Clap
"so you recommend to install Jedi because you don't like complex" - nope nope nope. the janfx re-sampler is just one function, in one file. totally independent from the library. you just extract that file and that's it. you can also look up janfx on internet. there are websites that are listing that library BEFORE it was integrated in jedi.Clap
I don't doubt what you say is true, but I it's hardly relevant. You don't get a DCU embedded in your executable. If you think using JanFX is useful, you should add a new answer; that way you'll be helping future visitors to decide better.Psychosis
L
17

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;
Loanloanda answered 29/12, 2009 at 19:33 Comment(4)
thank you; this provided a good balance btwn speed and quality.Shawm
Delphi sets the stretch mode to Halftone automatically if the destination canvas's bits-per-pixel count is less than or equal to 8 and the source bitmap's bits-per-pixel count is greater than the destination's. Otherwise, it uses Stretch_DeleteScans for color bitmaps.Pernell
thank you rob. i needed it to use HALFTONE always. btw, thank you for doing so much good stuff on stack overflow.Shawm
Strange, did I miss Rob's post back then? Anyway, please note I've added a bit about TBitmapForceHalftone.Loanloanda
M
14

You could try the built-in Delphi ScaleImage from GraphUtil

Multistage answered 30/12, 2009 at 8:11 Comment(1)
The best answer :)Breakaway
O
4

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.

Orthographize answered 1/1, 2010 at 10:22 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.