Масштабировать изображение в Delphi?

Я использую Delphi 2009, и я хотел бы масштабировать изображение, чтобы соответствовать доступному пространству. изображение всегда отображается меньше оригинала. проблема в том, что свойство TImage Stretch не делает хорошую работу и вредит читаемости изображения.

_{(источник: xrw.bc.ca)}

Мне бы хотелось, чтобы вместо этого оно масштабировалось так:

_{(источник: xrw.bc.ca)}

Любые предложения, как лучше всего это сделать? Пробовал JVCL, но, похоже, у него нет этой способности. Бесплатная библиотека была бы хороша, но, может быть, есть недорогая библиотека, которая делает "только", это было бы хорошо.

Ответы

Ответ 1

Если вы вернетесь к использованию вызовов Win32 API, вы можете использовать SetStretchBltMode для HALFTONE и использовать StretchBlt. Я не уверен, что это обеспечивается с использованием дефолтных вызовов по умолчанию, но так, как я обычно решу эту проблему.

Обновление (2014-09). Сейчас я был в подобной ситуации (опять же) и имел TImage в TScrollBox с большим количеством продолжений в форме и действительно хотел Image1.Stretch:=true; сделать полутоновый. Как указывает Роб, TBitmap.Draw использует HALFTONE только тогда, когда холст назначения составляет 8 бит на пиксель или ниже, а у холста источника больше... Поэтому я "исправил" его с присвоением 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;

Ответ 2

Вы действительно очень хотите использовать 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;

У вас есть несколько методов и фильтров для выбора при повторной выборке изображения. В приведенном выше примере в качестве ядра реконструкции используется ресамплер ядра (довольно медленный, но с отличными результатами) и фильтр Ланцоша. Приведенный выше пример должен работать для вас.

Ответ 3

Вы можете попробовать встроенный Delphi ScaleImage из GraphUtil

Ответ 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);

Вы можете выбрать коэффициент качества VS, изменив интерполяционный режим

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 в вашем установщике.