BMP Resize suche guten Algorithmus

[Bummi]

Die besten Ergebnisse bei wenig Aufwand bekomme mit GDI+

benötigt drei units aus GDI+ http://www.progdigy.com/

Delphi-Quellcode:

unit ExGraphicUtils;
//2010 Thomas Wassermann www.explido-software.de

interface
uses  Windows,  Classes, Sysutils, Graphics,GDIPAPI,GDIPOBJ,PNGImage, StdCtrls, jpeg, ActiveX;

Type TGPImageWrapper=Class(TObject)
       private
       FImage: TGPImage;
       FStream: TMemoryStream;
       public
       Constructor Create(AGraphic:TGraphic);
       Destructor Destroy;override;
       Public
       Property Image:TGPImage read FImage;
End;

procedure SetCanvasZoomFactor(Canvas: TCanvas; AZoomFactor: Integer);
Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
Procedure ScaleImage(source:String;dest:TCanvas;DestRect:Trect;Center:Boolean=true);overload;
Procedure ScaleImage(source:TGraphic;dest:TCanvas;DestRect:Trect;Center:Boolean=true);overload;
function CreateGraphicFromFile(const Filename: string): TGraphic;
procedure MirrorBitmap(Bmp, MBmp: TBitmap;Horizonal:Boolean=true);
Function FileNameIsImage(Const fn:String):Boolean;
implementation

/// SNIPP


Procedure ScaleImage(source:String;dest:TCanvas;DestRect:Trect;Center:Boolean=true);overload;
var
  graphics : TGPGraphics;
  image: TGPImage;
  width, height: Integer;
  faktor:Double;
  X, Y:Double;
begin
  image:= TGPImage.Create(source);
  try
  width := image.GetWidth;
  height := image.GetHeight;
  if ((DestRect.Right - DestRect.Left) / width) < ((DestRect.Bottom -DestRect.Top)/Height) then faktor := (DestRect.Right - DestRect.Left) / width else faktor:= ((DestRect.Bottom -DestRect.Top)/Height);
  Faktor := ABS(Faktor);
  if Center then
      begin
        X := ((Destrect.Right - Destrect.Left) - faktor * width ) / 2;
        Y := ((Destrect.Bottom - Destrect.Top) - faktor * Height ) / 2;
      end
  else
      begin
        X := Destrect.Left;
        Y := Destrect.Top;

      end;
  graphics := TGPGraphics.Create(dest.Handle);
  try
    graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    graphics.DrawImage( image, MakeRect(X, Y , faktor * width, faktor * height),  0, 0, width,  height, UnitPixel);
  finally
    graphics.Free;
  end;
  finally
  image.Free;
  end;
end;

Procedure ScaleImage(source:TGraphic;dest:TCanvas;DestRect:Trect;Center:Boolean=true);overload;
// Das Bild graphics : TGPGraphics "lebt" nur so lange wie der Stream STR lebt
var
  graphics : TGPGraphics;
  imagewrapper: TGPImageWrapper;
  width, height: Integer;
  faktor:Double;

  X, Y:Double;
begin
  imagewrapper := TGPImageWrapper.Create(source);
  try
  width := imagewrapper.image.GetWidth;
  height := imagewrapper.image.GetHeight;
  if ((DestRect.Right - DestRect.Left) / width) < ((DestRect.Bottom -DestRect.Top)/Height) then faktor := (DestRect.Right - DestRect.Left) / width else faktor:= ((DestRect.Bottom -DestRect.Top)/Height);
  Faktor := ABS(Faktor);
  if Center then
      begin
        X := Destrect.Left + ((Destrect.Right - Destrect.Left) - faktor * width ) / 2;
        Y := Destrect.Top  + ((Destrect.Bottom - Destrect.Top) - faktor * Height ) / 2;
      end
  else
      begin
        X := Destrect.Left;
        Y := Destrect.Top;

      end;
  graphics := TGPGraphics.Create(dest.Handle);
  try
    graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    graphics.DrawImage( imagewrapper.image, MakeRect(X, Y , faktor * width, faktor * height),  0, 0, width,  height, UnitPixel);
  finally
    graphics.Free;
  end;
  finally
  imagewrapper.Free;
  end;
end;