Resizing a JPEG Image with Thundax Image Resizer

These days I've been focused on a new web gallery for my pictures and I've come up with the idea of developing a simple application using Delphi 2010 to help me with the tedious task of resizing all my pictures in different sizes and creating thumbnails as well. I used and modified the code from Andrew Jameson to smoothly resize a JPEG image. With my last application you can resize an image in 3 different sizes in one shoot, defining them into the program. The application is called Thundax Image Resizer and you can download it for free. It can resize JPEG images and it can do it in batch.

Here you can see an image of the program:

Once the picture is selected and we resize de image, we'll get the new resized images into the output directory with the name concatenated with its resolution.

Afterwards, we can check our pictures resized and keeping a high quality:

Here you can get the code of the unit LibResize.pas:

unit LibResize;

interface

uses
    jpeg, windows, Graphics, SysUtils, Classes, StrUtils;

type
    TRGBArray = array [Word] of TRGBTriple;
    pRGBArray = ^TRGBArray;

procedure ResizeImage(path : string; FileName: string; MaxWidth: Integer; quality : integer);

implementation

procedure SmoothResize(Src, Dst: TBitmap);
var
    x, y: Integer;
    xP, yP: Integer;
    xP2, yP2: Integer;
    SrcLine1, SrcLine2: pRGBArray;
    t3: Integer;
    z, z2, iz2: Integer;
    DstLine: pRGBArray;
    DstGap: Integer;
    w1, w2, w3, w4: Integer;
begin
    Src.PixelFormat := pf24Bit;
    Dst.PixelFormat := pf24Bit;

    if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
        Dst.Assign(Src)
    else
    begin
        DstLine := Dst.ScanLine[0];
        DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);
        xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
        yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
        yP := 0;

        for y := 0 to pred(Dst.Height) do
        begin
            xP := 0;
            SrcLine1 := Src.ScanLine[yP shr 16];

            if (yP shr 16 < pred(Src.Height)) then
                SrcLine2 := Src.ScanLine[succ(yP shr 16)]
            else
                SrcLine2 := Src.ScanLine[yP shr 16];

            z2 := succ(yP and $FFFF);
            iz2 := succ((not yP) and $FFFF);
            for x := 0 to pred(Dst.Width) do
            begin
                t3 := xP shr 16;
                z := xP and $FFFF;
                w2 := MulDiv(z, iz2, $10000);
                w1 := iz2 - w2;
                w4 := MulDiv(z, z2, $10000);
                w3 := z2 - w4;
                DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 + SrcLine1[t3 + 1].rgbtRed * w2 + SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1]
                        .rgbtRed * w4) shr 16;
                DstLine[x].rgbtGreen := (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
                        SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
                DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 + SrcLine1[t3 + 1].rgbtBlue * w2 + SrcLine2[t3].rgbtBlue * w3 + SrcLine2[t3 + 1]
                        .rgbtBlue * w4) shr 16;
                Inc(xP, xP2);
            end;
            Inc(yP, yP2);
            DstLine := pRGBArray(Integer(DstLine) + DstGap);
        end;
    end;
end;

function LoadJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string): Boolean;
var
    JPEGImage: TJPEGImage;
begin
    if (FileName = '') then
        Result := False
    else
    begin
        try
            JPEGImage := TJPEGImage.Create;
            try
                JPEGImage.LoadFromFile(FilePath + FileName);
                Bitmap.Assign(JPEGImage);
                Result := true;
            finally
                JPEGImage.Free;
            end;
        except
            Result := False;
        end;
    end;
end;

function SaveJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string; Quality: Integer): Boolean;
var
    size: string;
    extension: string;
    newName: string;
begin
    Result := true;
    try
        if ForceDirectories(FilePath) then
        begin
            with TJPEGImage.Create do
            begin
                try
                    Assign(Bitmap);
                    CompressionQuality := Quality;
                    size := '_' + IntToStr(Bitmap.Width) + 'x' + IntToStr(Bitmap.Height);
                    extension := ExtractFileExt(FileName);
                    newName := AnsiLeftStr(FileName, Length(FileName) - Length(extension)) + size + extension;
                    SaveToFile(FilePath + newName);
                finally
                    Free;
                end;
            end;
        end;
    except
        raise ;
        Result := False;
    end;
end;

function JPEGDimensions(FileName: string; var x, y: Word): Boolean;
var
    SegmentPos: Integer;
    SOIcount: Integer;
    b: byte;
begin
    Result := False;
    with TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone) do
    begin
        try
            Position := 0;
            Read(x, 2);
            if (x <> $D8FF) then
                exit;
            SOIcount := 0;
            Position := 0;
            while (Position + 7 < size) do
            begin
                Read(b, 1);
                if (b = $FF) then
                begin
                    Read(b, 1);
                    if (b = $D8) then
                        Inc(SOIcount);
                    if (b = $DA) then
                        break;
                end;
            end;
            if (b <> $DA) then
                exit;
            SegmentPos := -1;
            Position := 0;
            while (Position + 7 < size) do
            begin
                Read(b, 1);
                if (b = $FF) then
                begin
                    Read(b, 1);
                    if (b in [$C0, $C1, $C2]) then
                    begin
                        SegmentPos := Position;
                        dec(SOIcount);
                        if (SOIcount = 0) then
                            break;
                    end;
                end;
            end;
            if (SegmentPos = -1) then
                exit;
            if (Position + 7 > size) then
                exit;
            Position := SegmentPos + 3;
            Read(y, 2);
            Read(x, 2);
            x := Swap(x);
            y := Swap(y);
            Result := true;
        finally
            Free;
        end;
    end;
end;

procedure ResizeImage(path : string; FileName: string; MaxWidth: Integer; quality : integer);
var
    OldBitmap: TBitmap;
    NewBitmap: TBitmap;
begin
    OldBitmap := TBitmap.Create;
    try
        if LoadJPEGPictureFile(OldBitmap, ExtractFilePath(FileName), ExtractFileName(FileName)) then
        begin
            if (OldBitmap.Width > MaxWidth) then
            begin
                NewBitmap := TBitmap.Create;
                try
                    NewBitmap.Width := MaxWidth;
                    NewBitmap.Height := MulDiv(MaxWidth, OldBitmap.Height, OldBitmap.Width);
                    SmoothResize(OldBitmap, NewBitmap);
                    SaveJPEGPictureFile(NewBitmap, path, ExtractFileName(FileName), quality)
                finally
                    NewBitmap.Free;
                end;
            end;
        end;
    finally
        OldBitmap.Free;
    end;
end;

end.