Thumbnails erstellen - Seitenverhältnisse beibehalten

[DelphiMuffin]

Hi, wie kann ich mit folgender Prozedur aus der CodeLibrary ein jpeg so verkleinern, dass das Verhältnis zwischen width und height beibehalten wird? (Ich habe indir, outdir und ein e am Ende des Prozedurnamens hinzugefügt.)

Code:

procedure resizePicture(indir: string; outdir: string; width, height: integer);
var i:integer;
    bmp:TBitmap;
    jpeg:TJpegImage;
begin
     Jpeg:=TJpegImage.Create;
     try
        jpeg.LoadFromFile(indir);
        bmp:=TBitmap.Create;
        try
           If jpeg.width>jpeg.Height then
              begin
              bmp.width:=width;
              bmp.height:=height;
              end else
              begin
              bmp.width:=height;
              bmp.Height:=width;
              end;
           bmp.canvas.StretchDraw(Rect(0,0,bmp.width,bmp.height),jpeg);
           jpeg.assign(bmp);
        finally
        bmp.free;
        end;
     jpeg.SavetoFile(outdir);
     finally
     jpeg.free;
     end;
end;

[DelphiMuffin]

Delphi-Quellcode:

procedure resizePicture(indir: string; outdir: string; width, height: integer;
                        aspectratio: boolean);
var bmp:TBitmap;
    jpeg:TJpegImage;
begin
     Jpeg:=TJpegImage.Create;
     try
        jpeg.LoadFromFile(indir);
        bmp:=TBitmap.Create;
        if aspectratio=true then height:=width * jpeg.Height div jpeg.Width;
        try
           If jpeg.width>jpeg.Height then
              begin
              bmp.width:=width;
              bmp.height:=height;
              end else
              begin
              bmp.width:=height;
              bmp.Height:=width;
              end;
           bmp.canvas.StretchDraw(Rect(0,0,bmp.width,bmp.height),jpeg);
           jpeg.assign(bmp);
        finally
        bmp.free;
        end;
     jpeg.SavetoFile(outdir);
     finally
     jpeg.free;
     end;
end;

Hab es selber hinbekommen...

[Christian Seehase]

Moin DelphiMuffin,

erst einmal herzlich willkommen hier in der Delphi-PRAXiS.

Schön, dass Du es selber hinbekommen hast, und klasse, dass Du die Lösung auch noch hier gepostet hast

[DelphiMuffin]

Mich hat die schlechte Qualität gestört und daher hab ich die Routine nocheinmal komplett neu mit der Graphics32 Library geschrieben. Der StretchFilter:=sfLanczos zeichnet das ganze jetzt schön weich Das ganze funktioniert jetzt nicht nur mit jpegs, daher die SaveImage Prozedur, die den Bitmap32 nochmal in ein Jpeg umwandelt. Ich hab ziemlich lange für gebraucht, daher tut euch das nicht an und benutzt meinen Schnipsel Ein Erwähnung wäre natürlich ganz nett

Delphi-Quellcode:

[..] uses Classes, Types, Graphics, Jpeg, GR32, GR32_Image; [..]

procedure SaveImage(inBmp: TBitmap32; filename: string);
var jpeg: TJPEGImage;
    bmp: TBitmap;
begin
     jpeg := TJPEGImage.Create;
     bmp := TBitmap.Create;
     try
        bmp.Assign(inBmp);
        jpeg.CompressionQuality := 100;
        jpeg.Assign(bmp);
        jpeg.SaveToFile(filename);
     finally
            jpeg.Free;
            bmp.Free;
     end;
end;


procedure resizePicture(infile: string; outfile: string; width, height: integer;
                        aspectratio: boolean);
var srcpic, destpic:TBitmap32;
    destrect, srcrect:TRect;
begin
     srcpic:=TBitmap32.Create;
     try
        srcpic.LoadFromFile(infile);
        destpic:=TBitmap32.Create;
        if aspectratio=true then height:=width * srcpic.Height div srcpic.Width;
        try
           destpic.width:=width;
           destpic.height:=height;
           destrect:=Rect(0,0,destpic.width,destpic.height);
           srcrect:=Rect(0,0,srcpic.width,srcpic.height);
           srcpic.StretchFilter:=sfLanczos;
           destpic.Draw(destrect,srcrect,srcpic);
         finally
         srcpic.free;
        end;
     //destpic.SaveToFile(outfile);
     SaveImage(destpic, outfile);
     finally
     destpic.free;
     end;
end;

[Codehunter]

Da ich diese Funktion hier recht nützlich fand und noch etwas verbessert habe, möchte ich sie euch wieder zur Vefügung stellen. Ich habe das destpic-Create aus dem Try genommen weils da nicht hingehörte. Zweitens habe ich die Sache mit der AspectRatio verbessert sodaß die Parameter height und width jetzt Maximalwerte sind, egal ob das Bild nun hoch- oder breitformatig ist.

Delphi-Quellcode:

procedure resizePicture(infile: string; outfile: string; width, height: integer;
                        aspectratio: boolean);
var srcpic, destpic:TBitmap32;
    destrect, srcrect:TRect;
begin 
     srcpic:=TBitmap32.Create; 
     destpic:=TBitmap32.Create;
     try
        srcpic.LoadFromFile(infile);
        if aspectratio=true then begin
           if srcpic.Height > srcpic.Width then begin
            width:=height * srcpic.width div srcpic.height;
           end else begin
            height:=width * srcpic.Height div srcpic.Width;
           end;
        end;
        try
           destpic.width:=width; 
           destpic.height:=height; 
           destrect:=Rect(0,0,destpic.width,destpic.height); 
           srcrect:=Rect(0,0,srcpic.width,srcpic.height); 
           srcpic.StretchFilter:=sfLanczos; 
           destpic.Draw(destrect,srcrect,srcpic); 
         finally
         srcpic.free;
        end; 
     //destpic.SaveToFile(outfile); 
     SaveImage(destpic, outfile); 
     finally 
     destpic.free;
     end; 
end;