[我正在尝试编写自己的快速重采样器，它可以将图像按比例缩小2、3、4等。我将其与StretchBlt进行了比较，而我的重采样器的速度慢了大约2倍。
我的代码：
type TRGBA = record
B,G,R: Byte;
A: Byte;
end;
PRGBAArray = ^TRGBAArray;
TRGBAArray = array[0..32767] of TRGBA;
procedure DownsampleSys(Src, Dst: TBitmap; Times: Integer);
var ARect: TRect;
dc:HDC;
p:TPoint;
begin
Dst.Width := Src.Width div Times;
Dst.Height := Src.Height div Times;
ARect := Rect(0,0, Dst.Width, Dst.Height);
dc := Dst.Canvas.Handle;
GetBrushOrgEx(dc,p);
SetStretchBltMode(dc,HALFTONE);
SetBrushOrgEx(dc,p.x,p.y,@p);
StretchBlt(dc,
ARect.Left, ARect.Top,
ARect.Right- ARect.Left, ARect.Bottom- ARect.Top,
Src.Canvas.Handle,0,0,Src.Width,Src.Height,Dst.Canvas.CopyMode);
end;
procedure Downsample2(Src, Dst: TBitmap; Times: Integer);
var x,y: Integer;
xx,yy: Integer;
FromP, ToP: PRGBAArray;
SumR, SumG, SumB: Cardinal;
Times2: Integer;
xTimes, yTimes: Integer;
xxxTimes: Integer;
MarginL, MarginT: Integer;
begin
Dst.Width := floor(Src.Width/ Times);
Dst.Height := floor(Src.Height / Times);
Times2 := Times * Times;
MarginL := (Src.Width - (Dst.Width * Times)) div 2;
MarginT := (Src.Height - (Dst.Height * Times)) div 2;
for y:=0 to Dst.Height-1 do begin
ToP := Dst.Scanline[y];
yTimes := MarginT + y*Times;
for x:=0 to Dst.Width-1 do begin
SumR := 0;
SumG := 0;
SumB := 0;
xTimes := MarginL + x*Times;
for yy:=0 to Times-1 do begin
FromP := Src.Scanline[yy + yTimes];
for xx:=0 to Times-1 do begin
xxxTimes := xx + xTimes;
SumR := SumR + FromP[xxxTimes].R;
SumG := SumG + FromP[xxxTimes].G;
SumB := SumB + FromP[xxxTimes].B;
end;
end;
ToP[x].R := SumR div Times2;
ToP[x].G := SumG div Times2;
ToP[x].B := SumB div Times2;
end;
end;
end;
用法：
InB := TBitmap.Create;
OutB := TBitmap.Create;
InB.LoadFromFile('2.bmp');
InB.PixelFormat := pf32bit;
OutB.PixelFormat := pf32bit;
Downsample2(InB, OutB, 4);
如何使它更快？
如果您仍然对答案感兴趣，可以尝试一下此缩略图例程。这是在Borland新闻组上进行讨论的结果。在我的系统上，它的运行速度比Stretch_Halftone快一些，但是按我的口味，盒子的重新缩放有些模糊。我自己放弃了所有的框缩放操作，因为至少在我的图形上，系统缩放操作看起来更好；几乎就像是在后台使用双三次缩放一样。
通过使用查找表，指针和整数运算来提高速度。
// procedure MakeThumbnailMod
// Original source: Roy Magne Klever
// Altered to avoid division by 0
// and tried to make it a bit faster (RS)
//Integer math courtesy of Hagen Redmann
type
PRGB32 = ^TRGB32;
TRGB32 = packed record
b: byte;
g: byte;
r: byte;
a: byte;
end;
TLine32 = array [0 .. maxint div SizeOf(TRGB32) - 1] of TRGB32;
PLine32 = ^TLine32;
TIntArray = array of integer;
TDeltaArray = array of array of integer;
procedure MakeStepsAndWeights(xscale, yscale: Single; xw, yh: integer;
var dxmin, dymin: integer; var Weights: TDeltaArray;
var xsteps, ysteps: TIntArray);
var
i, j: integer;
x1, x2: integer;
dxmax, dymax, intscale: integer;
fact: Single;
begin
SetLength(xsteps, xw);
SetLength(ysteps, yh);
intscale := round(xscale * $10000);
// won't work if xcale > $10000/2, because then intscale
// exceeds 32bit integer. I don't see that happening.
x1 := 0;
x2 := intscale shr 16;
for i := 0 to xw - 1 do
begin
xsteps[i] := x2 - x1;
x1 := x2;
x2 := (i + 2) * intscale shr 16;
end;
dxmin := Ceil(xscale - 1);
dxmax := trunc(xscale + 1);
intscale := round(yscale * $10000);
x1 := 0;
x2 := intscale shr 16;
for i := 0 to yh - 1 do
begin
ysteps[i] := x2 - x1;
x1 := x2;
x2 := (i + 2) * intscale shr 16;
end;
dymin := Ceil(yscale - 1);
dymax := trunc(yscale + 1);
SetLength(weights, dxmax - dxmin + 1, dymax - dymin + 1);
for i := 0 to dxmax - dxmin do
begin
fact := 1 / (dxmin + i);
for j := 0 to dymax - dymin do
weights[i, j] := round(fact / (dymin + j) * $10000);
end;
end;
procedure MakeThumbNailMod(const Src, Dest: TBitmap;
NewWidth, NewHeight: integer);
var
xscale, yscale: Single;
x1: integer;
ix, iy: integer;
totalRed, totalGreen, totalBlue: integer;
ratio: integer;
p: PRGB32;
pt1: PRGB32;
ptrD, ptrS: integer;
x, y: integer;
r1, r2: TRect;
x3: integer;
RowDest, RowSource, RowSourceStart: integer;
weights: TDeltaArray;
xsteps, ysteps: TIntArray;
w, h, dxmin, dymin: integer;
dx, dy: integer;
begin
Dest.PixelFormat := pf32bit;
Src.PixelFormat:=pf32bit; //to be on the safe side
Dest.Width := NewWidth;
Dest.Height := NewHeight;
if (Dest.Width >= Src.Width) or (Dest.Height >= Src.Height) then
begin //we don't do upsampling
r1 := rect(0, 0, Src.Width, Src.Height);
r2 := r1;
OffsetRect(r2, (Dest.Width - Src.Width) div 2,
(Dest.Height - Src.Height) div 2);
Dest.Canvas.CopyRect(r2, Src.Canvas, r1);
exit;
end;
w := Dest.Width;
h := Dest.Height;
ptrD := (w * 32 + 31) and not 31;
ptrD := ptrD div 8; // BytesPerScanline
ptrS := (Src.Width * 32 + 31) and not 31;
ptrS := ptrS div 8;
xscale := Src.Width / w;
yscale := Src.Height / h; // turns div into mults
MakeStepsAndWeights(xscale, yscale, w, h, dxmin, dymin, weights, xsteps, ysteps);
// Make 3 lookup tables for the steps and the ratios
w := w - 1;
h := h - 1;
RowDest := integer(Dest.Scanline[0]);
RowSourceStart := integer(Src.Scanline[0]);
RowSource := RowSourceStart;
for y := 0 to h do
begin
dy := ysteps[y];
x1 := 0;
x3 := 0;
for x := 0 to w do
begin
dx := xsteps[x];
totalRed := 0;
totalGreen := 0;
totalBlue := 0;
RowSource := RowSourceStart;
for iy := 1 to dy do
begin
p := PRGB32(RowSource + x1);
for ix := 1 to dx do
begin
totalRed := totalRed + p^.r;
totalGreen := totalGreen + p^.g;
totalBlue := totalBlue + p^.b; //maybe add the alpha-channel optionally
inc(p);
end;
RowSource := RowSource - ptrS;
end;
pt1 := PRGB32(RowDest + x3);
ratio := weights[dx - dxmin, dy - dymin];
pt1^.r := (totalRed * ratio) shr 16; //"rounding"
pt1^.g := (totalGreen * ratio) shr 16;
pt1^.b := (totalBlue * ratio) shr 16;
x1 := x1 + 4 * dx;
x3 := x3 + 4;
end;
RowDest := RowDest - ptrD;
RowSourceStart := RowSource;
end;
//SharpenMod(Work, Dest, min(1 + 0.4 * (xscale - 1), 2.5));
//The sharpening makes the thumb look nicer, but is omitted here
end;