Масштабирование изображения

Советы » Изображения » Масштабирование изображения

{ 
  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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com