Как сделать Thumbnails?

Previous  Top  Next

    
 

 

 

Code:

{

Here is the routine I use in my thumbnail component and I belive it is quite

fast.

A tip to gain faster loading of jpegs is to use the TJpegScale.Scale

property. You can gain a lot by using this correct.

 

This routine can only downscale images no upscaling is supported and you

must correctly set the dest image size. The src.image will be scaled to fit

in dest bitmap.

}

 

 

const

FThumbSize = 150;

 

//Speed up by Renate Schaaf, Armido, Gary Williams...

procedure MakeThumbNail(src, dest: tBitmap);

type

PRGB24 = ^TRGB24;

TRGB24 = packed record

   B: Byte;

   G: Byte;

   R: Byte;

end;

var

x, y, ix, iy: integer;

x1, x2, x3: integer;

 

xscale, yscale: single;

iRed, iGrn, iBlu, iRatio: Longword;

p, c1, c2, c3, c4, c5: tRGB24;

pt, pt1: pRGB24;

iSrc, iDst, s1: integer;

i, j, r, g, b, tmpY: integer;

 

RowDest, RowSource, RowSourceStart: integer;

w, h: integer;

dxmin, dymin: integer;

ny1, ny2, ny3: integer;

dx, dy: integer;

lutX, lutY: array of integer;

 

begin

if src.PixelFormat <> pf24bit then src.PixelFormat := pf24bit;

if dest.PixelFormat <> pf24bit then dest.PixelFormat := pf24bit;

w := Dest.Width;

h := Dest.Height;

 

if (src.Width <= FThumbSize) and (src.Height <= FThumbSize) then

begin

   dest.Assign(src);

   exit;

end;

 

iDst := (w * 24 + 31) and not 31;

iDst := iDst div 8; //BytesPerScanline

iSrc := (Src.Width * 24 + 31) and not 31;

iSrc := iSrc div 8;

 

xscale := 1 / (w / src.Width);

yscale := 1 / (h / src.Height);

 

// X lookup table

SetLength(lutX, w);

x1 := 0;

x2 := trunc(xscale);

for x := 0 to w - 1 do

begin

   lutX[x] := x2 - x1;

   x1 := x2;

   x2 := trunc((x + 2) * xscale);

end;

 

// Y lookup table

SetLength(lutY, h);

x1 := 0;

x2 := trunc(yscale);

for x := 0 to h - 1 do

begin

   lutY[x] := x2 - x1;

   x1 := x2;

   x2 := trunc((x + 2) * yscale);

end;

 

dec(w);

dec(h);

RowDest := integer(Dest.Scanline[0]);

RowSourceStart := integer(Src.Scanline[0]);

RowSource := RowSourceStart;

for y := 0 to h do

begin

   dy := lutY[y];

   x1 := 0;

   x3 := 0;

   for x := 0 to w do

   begin

     dx:= lutX[x];

     iRed:= 0;

     iGrn:= 0;

     iBlu:= 0;

     RowSource := RowSourceStart;

     for iy := 1 to dy do

     begin

       pt := PRGB24(RowSource + x1);

       for ix := 1 to dx do

       begin

         iRed := iRed + pt.R;

         iGrn := iGrn + pt.G;

         iBlu := iBlu + pt.B;

         inc(pt);

       end;

       RowSource := RowSource - iSrc;

     end;

     iRatio := 65535 div (dx * dy);

     pt1 := PRGB24(RowDest + x3);

     pt1.R := (iRed * iRatio) shr 16;

     pt1.G := (iGrn * iRatio) shr 16;

     pt1.B := (iBlu * iRatio) shr 16;

     x1 := x1 + 3 * dx;

     inc(x3,3);

   end;

   RowDest := RowDest - iDst;

   RowSourceStart := RowSource;

end;

 

if dest.Height < 3 then exit;

 

// Sharpening...

s1 := integer(dest.ScanLine[0]);

iDst := integer(dest.ScanLine[1]) - s1;

ny1 := Integer(s1);

ny2 := ny1 + iDst;

ny3 := ny2 + iDst;

for y := 1 to dest.Height - 2 do

begin

   for x := 0 to dest.Width - 3 do

   begin

     x1 := x * 3;

     x2 := x1 + 3;

     x3 := x1 + 6;

 

     c1 := pRGB24(ny1 + x1)^;

     c2 := pRGB24(ny1 + x3)^;

     c3 := pRGB24(ny2 + x2)^;

     c4 := pRGB24(ny3 + x1)^;

     c5 := pRGB24(ny3 + x3)^;

 

     r := (c1.R + c2.R + (c3.R * -12) + c4.R + c5.R) div -8;

     g := (c1.G + c2.G + (c3.G * -12) + c4.G + c5.G) div -8;

     b := (c1.B + c2.B + (c3.B * -12) + c4.B + c5.B) div -8;

 

     if r < 0 then r := 0 else if r > 255 then r := 255;

     if g < 0 then g := 0 else if g > 255 then g := 255;

     if b < 0 then b := 0 else if b > 255 then b := 255;

 

     pt1 := pRGB24(ny2 + x2);

     pt1.R := r;

     pt1.G := g;

     pt1.B := b;

   end;

   inc(ny1, iDst);

   inc(ny2, iDst);

   inc(ny3, iDst);

end;

end;

 

 

©Drkb::03832

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php