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.
