Quadratische Thumbnails erstellen

[Bummi]

Hast Du es mal mit GDI+ und
graphics.SetInterpolationMode(InterpolationModeHig hQualityBicubic);

Positing #3

versucht, IMHO das Optimum

[Satty67]

Schnell versucht (evtl. falsch)
SetStretchBltMode(ThumbBitmap.Canvas.Handle, HALFTONE); .
bringt keine Besserung. Weder mit Canvas.StrechDraw, noch direkt mit StretchBlt().

In C# gibt es eine Thumbnail-Methode im Image-Objekt, das sehr gute Ergebnisse liefert. Basiert auch auf GDI+. Würde also auch Bummis Rat empfehlen.

[Bummi]

Falls noch Interesse besteht, ich habe es mal maximal eingedampft

Delphi-Quellcode:

//2010 Thomas Wassermann www.explido-software.de
interface
uses  Windows,  Classes, Graphics,GDIPAPI,GDIPOBJ, StdCtrls, jpeg, ActiveX;

Procedure ScaleImage(source:TGraphic;dest:TCanvas;DestRect:Trect;Center:Boolean=true);overload;
implementation


Procedure ScaleImage(source:TGraphic;dest:TCanvas;DestRect:Trect;Center:Boolean=true);overload;
var
  graphics : TGPGraphics;
  image: TGPImage;
  width, height: Integer;
  faktor:Double;
  STR : TMemoryStream;
  X, Y:Double;
begin
  STR := TMemoryStream.Create;
  source.SaveToStream(STR);
  STR.Position := 0;
  image:= TGPImage.Create(TStreamAdapter.Create(Str));
  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
  STR.Free;
  image.Free;
  end;
end;
end;

[Bummi]

Zur besseren Wiederverwendbarkeit der TGPImages aus TGraphics habe ich eine kleine Wrapperklasse geschrieben, wer's brauchen kann...

Delphi-Quellcode:

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

________
{ TGPImageWrapper }

constructor TGPImageWrapper.Create(AGraphic: TGraphic);
begin
  FStream := TMemoryStream.Create;
  AGraphic.SaveToStream(FStream);
  Fimage:= TGPImage.Create(TStreamAdapter.Create(FStream));
end;

destructor TGPImageWrapper.Destroy;
begin
  FImage.Free;
  FStream.Free;
  inherited;
end;