Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Reply
 
Thread Tools Display Modes
  #1  
Old 02-14-2011, 06:20 PM
Dman Dman is offline
Junior Member
 
Join Date: Jul 2010
Posts: 28
Default Need a function to reduce image size to make thousands of thumbnails

Thanks for reading.

I have a couple thousand pictures.

I need to make thumbnails out of them.

I need a function to reduce image size to thumbnail size - about 150 x 90

I have been using the below algorithm, but when it comes to reducing big images down to small images, the resultant images tend to come out to "grainy." (The Photoshop algorithm does so much better...)

Can anyone recommend a good 'image reduction' procedure - or a graphics delphi addon? (So I can resize images to quality similar to photoshop...?)

Thanks!

Quote:
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; {for}
Inc(yP, yP2);
DstLine := pRGBArray(Integer(DstLine) + DstGap);
end; {for}
end; {if}
end;
Reply With Quote
  #2  
Old 02-14-2011, 07:01 PM
mdixon7610 mdixon7610 is offline
Senior Member
 
Join Date: Sep 2003
Posts: 141
Default

I've used Graphics32 http://sourceforge.net/projects/graphics32/ and ImageEn http://www.hicomponents.com/main/ resample procedures.

The imageen resample procedure has several filters that can be applied for different speed vs quality.
Reply With Quote
  #3  
Old 04-28-2011, 12:00 AM
Zaaka Zaaka is offline
Senior Member
 
Join Date: Aug 2002
Location: Teesside, UK
Posts: 217
Default This is the function that I use

Code:
procedure thumbfilename(fj:string);
var
  w,c:integer;
  masterBMP :TBitmap;
  filejpg,thumbjpg   :TJpegImage;
  x,y,h:integer;
BEGIN
  filejpg:=TJpegImage.Create;
  filejpg.LoadFromFile(fj);
  masterBMP:=TBitmap.create;
  masterBMP.Canvas.Pen.Color  :=clcream;
  masterBMP.Canvas.Brush.Color:=clcream;
  masterBMP.width  :=150; // <<<<<<<<<<<< width of thumbnail
  masterBMP.height :=170; // <<<<<<<<<<<< height of thumbnail
  masterBMP.Canvas.Rectangle(0,0,150,170);
  masterBMP.Canvas.MoveTo(0,150);
  masterBMP.Canvas.LineTo(150,150);
  // determin aspect ratio and scale to fit
  if filejpg.Width > filejpg.Height then begin
  w:=148;
  h:=round(w*filejpg.Height / filejpg.Width);
  end else begin
  h:=148;
  w:=round(h*filejpg.Width / filejpg.Height);
  end;
  x:=(148 - w) div 2;
  y:=(148 - h) div 2;
  // draw the jpeg image into the bitmap
  masterBMP.Canvas.Rectangle(Rect(x+4,y+4,(x+w)-2,(y+h)-2));
  masterBMP.Canvas.StretchDraw(classes.Rect(x+5,y+5,(x+w)-3,(y+h)-3),filejpg);
  w:=masterBMP.Canvas.TextWidth(extractfilename(fj));
  c:=(150 div 2) - (w div 2);
  masterBMP.Canvas.TextOut(c,153,extractfilename(fj));
  form1.Image1.picture.bitmap.Assign(masterBMP);
  thumbjpg:=TJpegImage.Create;
  thumbjpg.Assign(masterBMP);
  thumbjpg.SaveToFile(changefileext(fj,'-t.jpg'));
END;
Reply With Quote
  #4  
Old 04-28-2011, 01:35 PM
mdixon7610 mdixon7610 is offline
Senior Member
 
Join Date: Sep 2003
Posts: 141
Default

Zaaka, you aren't freeing any of the objects that you create, resulting in memory leaks.
Reply With Quote
  #5  
Old 05-05-2011, 02:38 AM
Zaaka Zaaka is offline
Senior Member
 
Join Date: Aug 2002
Location: Teesside, UK
Posts: 217
Default

OOps sorry its old code. I am away at the moment, will post as soon as i am back at my PC.

The code is good, just add

masterBMP.free;
thumbjpg.free;

before the very last END statement.
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is On

Forum Jump


All times are GMT. The time now is 03:41 AM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2019, vBulletin Solutions, Inc.