Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#6

AW: Kann man die Qualität von TImage verbessern?

  Alt 11. Sep 2012, 19:56
Ich habe hier noch einen alten Fetzen Code rumliegen, müsste umgebaut (TBitmap statt TImage und nicht aus/in Datei etc.) und resourcensicher gemacht werden, skaliert aber sehr sauber ... benötigt GDI+
Delphi-Quellcode:
{-----------------------------------------------------------------------------
  Procedure: ScaleOneImage
  Author:    Thomas Wassermann
  Date:      21-Nov-2006
  Arguments: Const source,dest:String;DestWidth,DestHeight:Integer
  Result:    None
  Remarks:  None
-----------------------------------------------------------------------------}

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

  Ext := UpperCase(StringReplace(ExtractFileExt(dest),'.','',[]));
  image:= TGPImage.Create(source);
  width := image.GetWidth;
  height := image.GetHeight;


  if ((width=DestWidth) and (height=DestHeight)) or (DoNotUpScale and ((width<=DestWidth) and (height<=DestHeight))) then
    begin
       image.Free;
       CopyFile(Pchar(Source),PChar(Dest),false);
    end
else
    begin
        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);
        {
        rct.x :=  destx ;
        rct.Y :=  desty * 1.0;
        rct.Width := faktor * width;
        rct.Height  := faktor * height;
        graphics.SetClip(rct);
        }

        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;
        if ext = 'BMPthen HDCImage.Picture.Bitmap.SaveToFile(dest)
        else SaveBMPasJPG(dest,HDCImage.Picture.Bitmap,qual);
        graphics.Free;
        HDCImage.Free;
    end;

end;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat