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: Resample oder Resize mit GDI+

  Alt 25. Nov 2010, 18:23
ein Fetzen Code sagt mehr als 1000 Worte
muß nichts installiert werden

Delphi-Quellcode:
unit ExGraphicUtils;
//2010 Thomas Wassermann www.explido-software.de
interface
uses Windows, Classes, Sysutils, Graphics,GDIPAPI,GDIPOBJ, StdCtrls, jpeg, ActiveX;

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);
implementation


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;
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;
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