Tja, nun habe ich PNG (auch teiltransparente) in die Routine eingebaut, BMP konvertiere ich nach JPEG damit es im Browser keine Probleme gibt und da bleibe ich bei GIF hängen!
Für GIF gibt es nur TFPReaderGIF, aber leider keinen TFPWriterGIF, gibt es da was, wenn auch nur Ansätze, oder muss ich für GIFs einen anderen Weg nehmen?
Anbei die erweiterte Testroutine:
Code: Alles auswählen
program resize;
{$APPTYPE CONSOLE}
{$MODE objfpc}{$H+}
uses
Classes, SysUtils, FPImage, FPCanvas, FPImgCanv, FPReadJPEG, FPWriteJPEG,
FPReadPNG, FPWritePNG, FPReadGIF, FPReadBMP;
function resize(const InFile, OutFile: string; const maxWidth, maxHeight: word): boolean;
type TImgType = (itJPEG, itGIF, itPNG, itBMP);
var
ext: string;
it: TImgType;
AWidth, AHeight: word;
Image, DestImage: TFPMemoryImage;
Canvas: TFPImageCanvas;
Reader: TFPCustomImageReader;
Writer: TFPCustomImageWriter;
StartTime: DWord;
begin
result := false;
StartTime := GetTickCount();
ext := LowerCase(ExtractFileExt(InFile));
if (ext = '.jpg') or (ext = '.jpeg') then it := itJPEG
else if (ext = '.png') then it := itPNG
else if (ext = '.gif') then it := itGIF
else if (ext = '.bmp') then it := itBMP
else Exit;
AWidth := maxWidth;
AHeight := maxHeight;
Image := TFPMemoryImage.Create(0, 0);
try
case it of
itJPEG: Reader := TFPReaderJPEG.Create;
itPNG: Reader := TFPReaderPNG.Create;
itGIF: Reader := TFPReaderGIF.Create;
itBMP: Reader := TFPReaderBMP.Create;
end;
try
case it of
itJPEG: begin
TFPReaderJPEG(Reader).Performance := jpBestQuality;//jpBestSpeed;
TFPReaderJPEG(Reader).MinHeight := AHeight;
TFPReaderJPEG(Reader).MinWidth := AWidth;
end;
end;
Image.LoadFromFile(InFile, Reader);
finally
Reader.Free;
end;
WriteLn('Zeit nach (LoadImageFromFile): ' + IntToStr(GetTickCount() - StartTime));
if AWidth = 0 then AWidth := Image.Width;
if AHeight = 0 then AHeight := Image.Height;
// Scale image whilst preserving aspect ratio
if (Image.Width / Image.Height) > (AWidth / AHeight) then
AHeight := Round(AWidth / (Image.Width / Image.Height))
else if (Image.Width / Image.Height) < (AWidth / AHeight) then
AWidth := Round(AHeight * (Image.Width / Image.Height));
WriteLn('Resizing images to: ' + IntToStr(AWidth) + 'x' + IntToStr(AHeight));
DestImage := TFPMemoryImage.Create(AWidth, AHeight);
try
Canvas := TFPImageCanvas.Create(DestImage);
try
Canvas.StretchDraw(0, 0, AWidth, AHeight, Image);
finally
Canvas.Free;
end;
WriteLn('Zeit nach (ResizeImage): ' + IntToStr(GetTickCount() - StartTime));
case it of
itJPEG: Writer := TFPWriterJPEG.Create;
itPNG: Writer := TFPWriterPNG.Create;
itGIF: Writer := TFPWriterPNG.Create; //<----mein Problem
itBMP: Writer := TFPWriterJPEG.Create;
end;
try
case it of
itJPEG, itBMP: begin
TFPWriterJPEG(Writer).CompressionQuality := 95;
TFPWriterJPEG(Writer).ProgressiveEncoding := true;
end;
itPNG, itGIF : begin
TFPWriterPNG(Writer).UseAlpha := true;
end;
end;
DestImage.SaveToFile(OutFile, Writer);
result := true;
finally
Writer.Free;
end;
WriteLn('Zeit nach (SaveImageToFile): ' + IntToStr(GetTickCount() - StartTime))
finally
DestImage.Free;
end;
finally
Image.free;
end;
end;
var sPath: string;
begin
sPath := ExtractFilePath(ParamStr(0));
resize(sPath + 'Tiger.bmp', sPath + 'Tiger~.jpg', 350, 200);
end.
Qualität des Resultates allerdings schlechter 
, immer weiter so mit den Ideen.
Verein
Links
Suche