Quadratische Thumbnails erstellen

[Bummi]

Delphi-Quellcode:

Procedure DrawBMPToCanvas(bmp:TBitmap;Canvas:TCanvas;Destrect:TRect);
var
    x,y,x1,y1:Double;
    Arect:TRect;
begin
      y:=bmp.Height;
      x:=bmp.Width;
      y1:=y/(Destrect.Right-Destrect.Left);
      x1:=x/(Destrect.Bottom-Destrect.Top);
      if x1<y1 then x1:=y1 ;
      x:=x/x1;
      y:=y/x1;
      Arect.left:=Destrect.Left+((Destrect.Right-Destrect.Left)-round(x)) div 2 ;
      Arect.top:=Destrect.Top+((Destrect.Bottom-Destrect.Top)-round(y)) div 2;
      Arect.right:=Arect.left+round(x);
      Arect.bottom:=Arect.top+round(y);
      Canvas.Fillrect(Destrect);
      Canvas.stretchdraw(Arect,bmp);
end;

oder mit GDIPAPI, GDIPOBJ

Delphi-Quellcode:

Procedure ScaleImage(Const source,dest:String;DestWidth,DestHeight:Integer;Qual:Integer=92;WithOutMargins:Boolean=false;BgColor:TColor=ClWhite);
var
  HDCImage:TImage;
  graphics : TGPGraphics;
  image: TGPImage;
  width, height: Integer;
  faktor:Double;
  destx,desty:Double;
  Ext:String;
begin

  Ext := UpperCase(StringReplace(ExtractFileExt(dest),'.','',[]));
  image:= TGPImage.Create(source);
  width  := image.GetWidth;
  height := image.GetHeight;
  if (DestWidth / width) < (DestHeight/Height) then faktor  := (DestWidth / width) else faktor:= (DestHeight/Height);
  HDCImage:=TImage.Create(nil);
  if WithOutMargins then
    begin
    HDCImage.Width  :=  Trunc(faktor * width);
    HDCImage.Height :=  Trunc(faktor * height);
    destx :=  0;
    desty :=  0;
    end
  else
    begin
    HDCImage.Width:=DestWidth;
    HDCImage.Height:=DestHeight;
    destx :=  (DestWidth - faktor * width) / 2;
    desty :=  (DestHeight - faktor * Height) / 2
    end;
  if BgColor<>clWhite then
    begin
      HDCImage.Canvas.Brush.Color:=BgColor;
      HDCImage.Canvas.Fillrect(Rect(0,0,HDCImage.Width,HDCImage.Height));
    end;
  graphics := TGPGraphics.Create(HDCImage.Canvas.Handle);
  graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);

  graphics.DrawImage(
    image,
    MakeRect(destx,  desty , faktor * width, faktor * height),  // destination rectangle
    0, 0,        // upper-left corner of source rectangle
    width,       // width of source rectangle
    height,      // height of source rectangle
    UnitPixel);
  image.Free;
  HDCImage.invalidate;
  ForceDirectories(ExtractFilePath(dest));
  if ext = 'BMP' then HDCImage.Picture.Bitmap.SaveToFile(dest)
  else SaveBMPasJPG(dest,HDCImage.Picture.Bitmap,qual);
  graphics.Free;
  HDCImage.Free;

end;