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



Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{
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;

Далее: Негатив картинки »»