Show posts
Really not sure where your classes end and the LCL stuff begins. Just know that I read that I needed your classes to load image with automatic detection of image type and also using your functions for basic image rotate and scale operations at the moment.
Here is a copy of the subroutine.
Here is a copy of the subroutine.
Code (pascal) Select
function processImage(Filename: UTf8String): imgInfo;
const
{$J+}
image: TSingleImage = nil;
png: TImagingPNG = nil;
jpg: TImagingJpeg = nil;
{$J-}
var
info: imgInfo;
tmpFile: UTF8String;
tmpJPG: UTF8String;
tmpPNG: UTF8String;
scaleByH: double;
scaleByW: double;
scaleBy: double;
newWidth: longint;
newHeight: longint;
jpgQuality: longint;
begin
//info=imgInfo;
if UI.cbShowDebug.Checked then frmDebug.ShowOnTop;
if image = nil then begin
image := TSingleImage.Create;
png := TImagingPNG.Create;
jpg := TImagingJpeg.Create;
end;
{load image}
image.Clear;
frmDebug.memoDebug.Append(Filename);
image.LoadFromFile(Filename);
{basic transforms to ensure internal consistancy}
ConvertImage(image.ImageDataPointer^, ifA32R32G32B32F);
frmDebug.memoDebug.Append('Size: ' + IntToStr(image.Width) + 'x' +
IntToStr(image.Height));
{rotate check?}
if UI.cbRotate.Checked then if portrait then begin
if (image.Width > image.Height) then begin
UI.ProcessMessages;
RotateImage(image.ImageDataPointer^, 90);
frmDebug.memoDebug.Append('Rotated Size: ' + IntToStr(image.Width) +
'x' + IntToStr(image.Height));
end;
end else {landscape} if (image.Height > image.Width) then begin
UI.ProcessMessages;
RotateImage(image.ImageDataPointer^, -90);
frmDebug.memoDebug.Append('Rotated Size: ' + IntToStr(image.Width) +
'x' + IntToStr(image.Height));
end;
{rescale check?}
if UI.cbRescale.Checked then begin
{rescale down maxpect}
frmDebug.memoDebug.Append('Maxpect Size: ' + IntToStr(imageMaxpectWidth) +
'x' + IntToStr(imageMaxpectHeight));
UI.ProcessMessages;
scaleByW := imageMaxpectWidth / (image.Width * 1.0);
scaleByH := imageMaxpectHeight / (image.Height * 1.0);
if ((scaleByW < 1) or (scaleByH < 1)) then begin
if scaleByW < scaleByH then scaleBy := scaleByW
else
scaleBy := scaleByH;
newWidth := Round(scaleBy * image.Width);
newHeight := Round(scaleBy * image.Height);
ResizeImage(image.ImageDataPointer^, newWidth, newHeight, rfBicubic);
frmDebug.memoDebug.Append('New Size: ' + IntToStr(image.Width) +
'x' + IntToStr(image.Height));
end;
{rescale up maxpect}
if (scaleByW > 1) and (scaleByH > 1) then begin
if scaleByW < scaleByH then scaleBy := scaleByW
else
scaleBy := scaleByH;
newWidth := Round(scaleBy * image.Width);
newHeight := Round(scaleBy * image.Height);
ResizeImage(image.ImageDataPointer^, newWidth, newHeight, rfBicubic);
frmDebug.memoDebug.Append('New Size: ' + IntToStr(image.Width) +
'x' + IntToStr(image.Height));
end;
end;
{work around Red/Blue swap on Assign issue, all further
assigns will swap the Red/Blue back to correctness, if the
bug does not exist (WIN32 for example), it is just extra
data being moved around with only a minor cpu impact}
png.AssignFromImage(image);
png.AssignToImageData(image.ImageDataPointer^);
{save as temporary png file}
tmpPNG := mkstemp;
png.AssignFromImage(image);
png.CompressLevel := 9;
png.PreFilter := 6;
png.SaveToFile(tmpPNG);
{save as temporary jpg file}
tmpJPG := mkstemp;
jpg.AssignFromImage(image);
jpgQuality:=UI.seJpgQ.Value;
jpg.Quality := jpgQuality;
jpg.SaveToFile(tmpJPG);
if (FileSize(tmpPNG)>(UI.seJpgSize.Value*1024)) then begin
while (FileSize(tmpJPG) > UI.seJpgSize.Value*1024)
and (jpgQuality>=0) do begin
jpgQuality -= 1;
jpg.Quality := jpgQuality;
jpg.SaveToFile(tmpJPG);
end;
end;
{which is smaller?}
if (FileSize(tmpJPG) < FileSize(tmpPNG)) then tmpFile := tmpJPG
else
tmpFile := tmpPNG;
Result[0] := tmpFile;
Result[1] := DetermineFileFormat(tmpFile);
Result[2] := IntToStr(image.Width);
Result[3] := IntToStr(image.Height);
Result[4] := '';
end;