Delphi图像处理 －－ 图像缩放

核心提示： 图像缩放是最常用的图像处理，在图像拉伸和取得图像略图中都要用到，Delphi图像处理 －－ 图像缩放，图像缩放质量的好坏与图像像素插值方式有关，本文定义了常用的3种插值方式，扩展边框办法在图像放大和旋转处理中速度还是略快一些），但是简化了插值代码，即临近插值、线性插值和双立方插值方式：view plaincopy t

 图像缩放是最常用的图像处理，在图像拉伸和取得图像略图中都要用到。图像缩放质量的好坏与图像像素插值方式有关，本文定义了常用的3种插值方式，即临近插值、线性插值和双立方插值方式：

view plaincopy to clipboardPRint?
type　
　// 插值方式: 缺省(线性插值)，临近，线性，双立方　 
　TInterpolateMode = (imDefault, imNear, imBilinear, imBicubic);　
type
　// 插值方式: 缺省(线性插值)，临近，线性，双立方
　TInterpolateMode = (imDefault, imNear, imBilinear, imBicubic);

　　具体的缩放及其用到的插值过程代码如下：

view plaincopy to clipboardprint?
过程定义：　 
　
　// 设置双立方插值的斜率。缺省值为-0.75　 
　procedure SetBicubicSlope(const Value: Single);　 
　// 缩放图像，IpMode插值方式　 
　procedure ImageScale(Dest: TImageData; const Source: TImageData;　 
　　IpMode: TInterpolateMode = imDefault); overload;　 
　// Source分别按比例ScaleX和ScaleY缩放到Dest的(x,y)坐标，IpMode插值方式　 
　procedure ImageScale(Dest: TImageData; x, y: Integer; const Source: TImageData;　 
　　ScaleX, ScaleY: Single; IpMode: TInterpolateMode = imDefault); overload;　 
　// TGraphic对象缩放到Dest　 
　procedure ImageScale(Dest: TImageData; const Source: TGraphic;　 
　　IpMode: TInterpolateMode = imDefault); overload;　 
　procedure ImageScale(Dest: TImageData; x, y: Integer; const Source: TGraphic;　 
　　ScaleX, ScaleY: Single; IpMode: TInterpolateMode = imDefault); overload;　 
　// TGpBitmap对象缩放到Dest　 
　procedure ImageScale(Dest: TImageData;　 
　　const Source: TGpBitmap; IpMode: TInterpolateMode = imDefault); overload;　 
　procedure ImageScale(Dest: TImageData; x, y: Integer;　 
　　const Source: TGpBitmap; ScaleX, ScaleY: Single;　 
　　IpMode: TInterpolateMode = imDefault); overload;　 
　
实现代码：　 
　
type　
　TInterpolateProc = procedure;　 
　
var　
　BicubicTable: Pointer;　 
　BicubicSlope: Single;　 
　BilinearTable: Pointer;　 
　
(*****************************************************************************　
* typedef UINT ARGB　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*　
* ARGB GetBilinearColor(int x(*256), int y(*256), void* Scan0, UINT Stride)　*　
*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*　
* int x0 = x / 256　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* int y0 = y / 256　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* BYTE *pScan0 = Scan0 + y0 * Stride + y0 * 4　　　　　　　　　　　　　　　　*　
* BYTE c[4][4]　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* c[0] = *pScan0　　　　　　　　 // (x0, y0)　　　　　　　　　　　　　　　　 *　
* c[1] = *(pScan0 + Stride)　　　// (x0, y0+1)　　　　　　　　　　　　　　　 *　
* c[2] = *(pScan0 + 4)　　　　　 // (x0+1, y0)　　　　　　　　　　　　　　　 *　
* c[3] = *(PScan0 + Stride + 4)　// (x0+1, y0+1)　　　　　　　　　　　　　　 *　
* int u = x & 0xff　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* int v = y & 0xff　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* int m0 = (255-v) * (255-u)　　　　　　　　　　　　　　　　　　　　　　　　 *　
* int m1 = v * (255-u)　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* int m2 = (255-v) * u　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* int m3 = v * u　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* BYTE ARGB[4]　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *　
* for (int i = 0; i < 4; i ++)　　　　　　　　　　　　　　　　　　　　　　　 *　
*　 ARGB[i] = (c[0][i]*m0 + c[1][i]*m1 + c[2][i]*m2 + c[3][i]*m3) / 65536　　*　
*****************************************************************************)　
　
procedure GetBilinearColor;　 
asm　
　　and　　　 edx, 255　
　　and　　　 ecx, 255　
　　shl　　　 edx, 4　
　　shl　　　 ecx, 4　
　　mov　　　 eax, BilinearTable　 
　　movq　　　mm0, [esi]　　　 // mm0 = C2 (x0+1, y0)　C0(x0, y0)　 
　　movq　　　mm1, mm0　 
　　add　　　 esi, [ebx].TImageData.Stride　 
　　// [esi] = C3(x0+1, y0+1) C1(x0, y0+1)　 
　　punpcklbw mm0, [esi]　　　 // mm0 = A1 A0 R1 R0 G1 G0 B1 B0　 
　　punpckhbw mm1, [esi]　　　 // mm1 = A3 A2 R3 R2 G3 G2 B3 B2　 
　　movq　　　mm2, mm0　 
　　movq　　　mm3, mm1　 
　　punpcklbw mm0, mm7　　　　 // mm0 = 00 G1 00 G0 00 B1 00 B0　 
　　punpcklbw mm1, mm7　　　　 // mm1 = 00 G3 00 G2 00 B3 00 B2　 
　　punpckhbw mm2, mm7　　　　 // mm2 = 00 A1 00 A0 00 R1 00 R0　 
　　punpckhbw mm3, mm7　　　　 // mm3 = 00 A3 00 A2 00 R3 00 R2　 
　　movq　　　mm4, [eax + edx]　 
　　pmullw　　mm4, [eax + ecx + 8]　 
　　psrlw　　 mm4, 1　　　　　 // 先除以2，否则后面的Word有符号乘法会扩展符号位　 
　　movq　　　mm5, mm4　 
　　punpckldq mm4, mm4　　　　 // mm4 = 00 m1 00 m0 00 m1 00 m0　 
　　punpckhdq mm5, mm5　　　　 // mm5 = 00 m3 00 m2 00 m3 00 m2　 
　　pmaddwd　 mm0, mm4　　　　 // mm0 = G1*m1+G0*m0 B1*m1+B0*m0　 
　　pmaddwd　 mm1, mm5　　　　 // mm1 = G3*m3+G2*m2 B3*m3+B2*m2　 
　　pmaddwd　 mm2, mm4　　　　 // mm2 = A1*m1+A0*m0 R1*m1+R0*m0　 
　　pmaddwd　 mm3, mm5　　　　 // mm3 = A3*m3+A2*m2 R3*m3+R2*m2　 
　　paddd　　 mm0, mm1　　　　 // mm0 = G3n+G2n+G1n+G0n B3n+B2n+B1n+B0n　 
　　paddd　　 mm2, mm3　　　　 // mm2 = A2n+A2n+A1n+A0n R3n+R2n+R1n+R0n　 
　　psrld　　 mm0, 15　　　　　// mm0 = Gn/0x8000　　Bn/0x8000　 
　　psrld　　 mm2, 15　　　　　// mm2 = An/0x8000　　Rn/0x8000　 
　　packssdw　mm0, mm2　　　　 // mm0 = 00 An 00 Rn 00 Gn 00 Bn　 
　　packuswb　mm0, mm0　　　　 // mm0 = An Rn Gn Bn An Rn Gn Bn　 
end;　 
　
procedure GetNearColor;　 
asm　
　　movd　　　mm0, [esi]　 
end;　 
　
procedure GetBicubicColor;　 
　
　procedure SumBicubic;　 
　asm　
　　movd　　　mm1, [esi]　 
　　movd　　　mm2, [esi + 4]　 
　　movd　　　mm3, [esi + 8]　 
　　movd　　　mm4, [esi + 12]　 
　　punpcklbw mm1, mm7　 
　　punpcklbw mm2, mm7　 
　　punpcklbw mm3, mm7　 
　　punpcklbw mm4, mm7　 
　　psllw　　 mm1, 7　
　　psllw　　 mm2, 7　
　　psllw　　 mm3, 7　
　　psllw　　 mm4, 7　
　　pmulhw　　mm1, [edi + 256 * 8 + edx]　 
　　pmulhw　　mm2, [edi + edx]　 
　　pmulhw　　mm3, [edi + 256 * 8 + eax]　 
　　pmulhw　　mm4, [edi + 512 * 8 + eax]　 
　　paddsw　　mm1, mm2　 
　　paddsw　　mm3, mm4　 
　　paddsw　　mm1, mm3　 
　　pmulhw　　mm1, mm5　 
　　paddsw　　mm0, mm1　 
　　add　　　 esi, [ebx].TImageData.Stride　 
　end;　 
　
asm　
　　push　　　edi　 
　　mov　　　 edi, BicubicTable// edi = int64 uvTable　(item * 16384)　 
　　and　　　 edx, 255　　　　 // u = x & 255　 
　　shl　　　 edx, 3　　　　　 // edx = u * 8　 
　　mov　　　 eax, edx　　　　 // eax = -edx　 
　　neg　　　 eax　 
　　and　　　 ecx, 255　　　　 // v = y & 255　 
　　shl　　　 ecx, 3　　　　　 // ecx = v * 8　 
　　pxor　　　mm0, mm0　 
　　movq　　　mm5, [edi + 256 * 8 + ecx]　 
　　call　　　SumBicubic　 
　　movq　　　mm5, [edi + ecx]　 
　　call　　　SumBicubic　 
　　neg　　　 ecx　 
　　movq　　　mm5, [edi + 256 * 8 + ecx]　 
　　call　　　SumBicubic　 
　　movq　　　mm5, [edi + 512 * 8 + ecx]　 
　　call　　　SumBicubic　 
　　paddw　　 mm0, mm6　　　　 // argb += 4　 
　　psraw　　 mm0, 3　　　　　 // argb /= 8　 
　　packuswb　mm0, mm0　 
　　pop　 edi　 
end;　 
　
procedure AlphaBlendPixel;　 
asm　
//　　movd　　　mm0, eax　　　　// mm0 = 00 00 00 00 As Rs Gs Bs　 
　　movd　　　mm1, [edi]　　　// mm1 = 00 00 00 00 Ad Rd Gd Bd　 
　　punpcklbw mm0, mm7　　　　// mm0 = 00 As 00 Rs 00 Gs 00 Bs　 
　　punpcklbw mm1, mm7　　　　// mm1 = 00 Ad 00 Rd 00 Gd 00 Bd　 
　　movq　　　mm2, mm0　 
　　punpckhwd mm2, mm2　 
　　punpckhdq mm2, mm2　　　　// mm2 = Alpha Alpha Alpha Alpha　 
　　psubw　　 mm0, mm1　　　　// mm0 = As-Ad Rs-Rd Gs-Gd Bs-Bd　 
　　pmullw　　mm0, mm2　　　　// mm0 = As*Alpha Rs*Alpha Gs*Alpha Bs*Alpha　 
　　psllw　　 mm1, 8　　　　　// mm1 = Ad*256 Rd*256 Gd*256 Bd*256　 
　　paddw　　 mm0, mm1　　　　// mm0 = 00 An 00 Rn 00 Gn 00 Bn　 
　　psrlw　　 mm0, 8　　　　　// mm0 = An/256 Rn/256 Gn/256 Bn/256　 
　　packuswb　mm0, mm7　　　　// mm0 = 00 00 00 00 An Rn Gn Bn　 
　　movd　　　[edi], mm0　 
end;　 
　
function GetInterpolateProc(IpMode: TInterpolateMode; var Proc: TInterpolateProc): Integer;　 
begin　
　case IpMode of　
　　imNear:　 
　　begin　
　　　Result := 1;　 
　　　Proc := GetNearColor;　 
　　end;　 
　　imBicubic:　 
　　begin　
　　　Result := 4;　 
　　　Proc := GetBicubicColor;　 
　　end　
　else　
　　begin　
　　　Result := 2;　 
　　　Proc := GetBilinearColor;　 
　　end;　 
　end;　 
end;　 
　
procedure ImageScale(Dest: TImageData; const Source: TImageData; IpMode: TInterpolateMode);　 
var　
　x, y: Integer;　 
　Width, Height: Integer;　 
　xDelta, yDelta: Integer;　 
　Radius, dstOffset: Integer;　 
　src: TImageData;　 
　GetColor: TInterpolateProc;　 
　
　procedure DoScale(dst: TImageData);　 
　asm　
　　pxor　　　mm7, mm7　 
　　mov　　　 edx, 04040404h　 
　　movd　　　mm6, edx　 
　　punpcklbw mm6, mm7　 
　　lea　　　 edx, src　 
　　push　　　edx　 
　　call　　　SetDataCopyReg　 
　　imul　　　ecx, xDelta　 
　　imul　　　edx, yDelta　 
　　add　　　 ecx, x　 
　　add　　　 edx, y　 
　　mov　　　 Width, ecx　 
　　mov　　　 Height, edx　 
　　mov　　　 dstOffset, ebx　 
　　pop　　　 ebx　 
　　mov　　　 ecx, y　　　　　 // for (; y < Height;　y ++){　 
　　@yLoop:　　　　　　　　　　　// {　 
　　mov　　　 esi, ecx　 
　　sar　　　 esi, 8　　　　　 //　 esi = Source.Scan0 + y / 256 * Source.Stride　 
　　imul　　　esi, [ebx].TImageData.Stride　 
　　add　　　 esi, [ebx].TImageData.Scan0　 
　　mov　　　　 edx, x　　　　　 //　 for (; x < Width; x ++){　 
　　@xLoop:　　　　　　　　　　　//　 {　 
　　push　　　esi　 
　　push　　　edx　 
　　push　　　ecx　 
　　mov　　　 eax, edx　 
　　sar　　　 eax, 8　
　　shl　　　 eax, 2　
　　add　　　 esi, eax　　　　 //　　 esi += (x / 256 * 4)　 
　　call　　　GetColor　　　　 //　　 mm0 = GetColor(src, esi, x, y)　 
　　call　　　AlphaBlendPixel　//　　 AlphaBlendPixel(mm0, edi)　 
　　add　　　 edi, 4　　　　　 //　　 edi += 4　 
　　pop　　　 ecx　 
　　pop　　　 edx　 
　　pop　　　 esi　 
　　　　add　　　　 edx, xDelta　　　　//　　 x0 += xDelta　 
　　cmp　　　 edx, Width　 
　　jl　　　　@xLoop　　　　　 //　 }　 
　　add　　　 edi, dstOffset　 //　 edi += dstOffset　 
　　　　add　　　　 ecx, yDelta　　　　//　 y0 += yDelta　 
　　cmp　　　 ecx, Height　 
　　jl　　　　@yLoop　　　　　 // }　 
　　emms　 
　end;　 
　
begin　
　Radius := GetInterpolateProc(IpMode, GetColor);　 
　xDelta := (Source.Width shl 8) div Dest.Width;　 
　yDelta := (Source.Height shl 8) div Dest.Height;　 
　x := (xDelta{ shr 1}) + (Radius shl 7);　 
　y := (yDelta{ shr 1}) + (Radius shl 7);　 
　src := ImageGetExpandData(Source, 0, 0, Source.Width, Source.Height, Radius);　 
　try　
　　DoScale(Dest);　 
　finally　
　　FreeImageData(src);　 
　end;　 
end;　 
　
procedure ImageScale(Dest: TImageData; x, y: Integer;　 
　const Source: TImageData; ScaleX, ScaleY: Single; IpMode: TInterpolateMode);　 
var　
　src, dst: TImageData;　 
begin　
　if not ((ScaleX > 0.0) and (ScaleY > 0.0)) then　
　　Exit;　 
　dst := GetSubImageData(Dest, x, y, Round(Source.Width * ScaleX),　 
　　Round(Source.Height * ScaleY));　 
　if ImageEmpty(dst) then Exit;　 
　if x < 0 then x := -Trunc(x / ScaleX) else x := 0;　 
　if y < 0 then y := -Trunc(y / ScaleY) else y := 0;　 
　src := GetSubImageData(Source, x, y, Round(dst.Width / ScaleX),　 
　　Round(dst.Height / ScaleY));　 
　ImageScale(dst, src, IpMode);　 
end;　 
　
procedure ImageScale(Dest: TImageData; const Source: TGraphic;　 
　IpMode: TInterpolateMode);　 
var　
　src: TImageData;　 
begin　
　src := GetImageData(Source);　 
　ImageScale(Dest, src, IpMode);　 
　FreeImageData(src);　 
end;　 
　
procedure ImageScale(Dest: TImageData; x, y: Integer;　 
　const Source: TGraphic; ScaleX, ScaleY: Single; IpMode: TInterpolateMode);　 
var　
　src: TImageData;　 
begin　
　src := GetImageData(Source);　 
　ImageScale(Dest, x, y, src, ScaleX, ScaleY, IpMode);　 
　FreeImageData(src);　 
end;　 
　
procedure ImageScale(Dest: TImageData;　 
　const Source: TGpBitmap; IpMode: TInterpolateMode);　 
var　
　src: TImageData;　 
begin　
　src := GetImageData(Source);　 
　ImageScale(Dest, src, IpMode);　 
　FreeImageData(src);　 
end;　 
　
procedure ImageScale(Dest: TImageData; x, y: Integer;　 
　const Source: TGpBitmap; ScaleX, ScaleY: Single; IpMode: TInterpolateMode);　 
var　
　src: TImageData;　 
begin　
　src := GetImageData(Source);　 
　ImageScale(Dest, x, y, src, ScaleX, ScaleY, IpMode);　 
　FreeImageData(src);　 
end;　 
　
procedure SetBicubicSlope(const Value: Single);　 
type　
　TBicArray = array[0..3] of Smallint;　 
　PBicArray = ^TBicArray;　 
　
var　
　I: Integer;　 
　P: PBicArray;　 
　
　function BicubicFunc(x : double): double;　 
　var　
　　x2, x3: double;　 
　begin　
　　if x < 0.0 then x := -x;　 
　　x2 := x * x;　 
　　x3 := x2 * x;　 
　　if x <= 1.0 then　
　　　Result := (Value + 2.0) * x3 - (Value + 3.0) * x2 + 1.0　
　　else if x <= 2.0 then　
　　　Result := Value * x3 - (5.0 * Value) * x2 + (8.0 * Value) * x - (4.0 * Value)　 
　　else Result := 0.0;　 
　end;　 
　
begin　
　if (BicubicSlope <> Value) and (Value < 0.0) {and (Value >= -2.0)} then　
　begin　
　　BicubicSlope := Value;　 
　　P := BicubicTable;　 
　　for I := 0 to 512 do　
　　begin　
　　　P^[0] := Round(16384 * BicubicFunc(I * (1.0 / 256)));　 
　　　P^[1] := P^[0];　 
　　　P^[2] := P^[0];　 
　　　P^[3] := P^[0];　 
　　　Inc(P);　 
　　end;　 
　end;　 
end;　
过程定义：

　// 设置双立方插值的斜率。缺省值为-0.75
　procedure SetBicubicSlope(const Value: Single);
　// 缩放图像，IpMode插值方式
　procedure ImageScale(Dest: TImageData; const Source: TImageData;
　　IpMode: TInterpolateMode = imDefault); overload;
　// Source分别按比例ScaleX和ScaleY缩放到Dest的(x,y)坐标，IpMode插值方式
　procedure ImageScale(Dest: TImageData; x, y: Integer; const Source: TImageData;
　　ScaleX, ScaleY: Single; IpMode: TInterpolateMode = imDefault); overload;
　// TGraphic对象缩放到Dest
　procedure ImageScale(Dest: TImageData; const Source: TGraphic;
　　IpMode: TInterpolateMode = imDefault); overload;
　procedure ImageScale(Dest: TImageData; x, y: Integer; const Source: TGraphic;
　　ScaleX, ScaleY: Single; IpMode: TInterpolateMode = imDefault); overload;
　// TGpBitmap对象缩放到Dest
　procedure ImageScale(Dest: TImageData;
　　const Source: TGpBitmap; IpMode: TInterpolateMode = imDefault); overload;
　procedure ImageScale(Dest: TImageData; x, y: Integer;
　　const Source: TGpBitmap; ScaleX, ScaleY: Single;
　　IpMode: TInterpolateMode = imDefault); overload;

实现代码：

type
　TInterpolateProc = procedure;

var
　BicubicTable: Pointer;
　BicubicSlope: Single;
　BilinearTable: Pointer;

(*****************************************************************************
* typedef UINT ARGB　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
* ARGB GetBilinearColor(int x(*256), int y(*256), void* Scan0, UINT Stride)　*
*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
* int x0 = x / 256　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* int y0 = y / 256　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* BYTE *pScan0 = Scan0 + y0 * Stride + y0 * 4　　　　　　　　　　　　　　　　*
* BYTE c[4][4]　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* c[0] = *pScan0　　　　　　　　 // (x0, y0)　　　　　　　　　　　　　　　　 *
* c[1] = *(pScan0 + Stride)　　　// (x0, y0+1)　　　　　　　　　　　　　　　 *
* c[2] = *(pScan0 + 4)　　　　　 // (x0+1, y0)　　　　　　　　　　　　　　　 *
* c[3] = *(PScan0 + Stride + 4)　// (x0+1, y0+1)　　　　　　　　　　　　　　 *
* int u = x & 0xff　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* int v = y & 0xff　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* int m0 = (255-v) * (255-u)　　　　　　　　　　　　　　　　　　　　　　　　 *
* int m1 = v * (255-u)　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* int m2 = (255-v) * u　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* int m3 = v * u　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* BYTE ARGB[4]　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
* for (int i = 0; i < 4; i ++)　　　　　　　　　　　　　　　　　　　　　　　 *
*　 ARGB[i] = (c[0][i]*m0 + c[1][i]*m1 + c[2][i]*m2 + c[3][i]*m3) / 65536　　*
*****************************************************************************)

procedure GetBilinearColor;
asm
　　and　　　 edx, 255
　　and　　　 ecx, 255
　　shl　　　 edx, 4
　　shl　　　 ecx, 4
　　mov　　　 eax, BilinearTable
　　movq　　　mm0, [esi]　　　 // mm0 = C2 (x0+1, y0)　C0(x0, y0)
　　movq　　　mm1, mm0
　　add　　　 esi, [ebx].TImageData.Stride
　　// [esi] = C3(x0+1, y0+1) C1(x0, y0+1)
　　punpcklbw mm0, [esi]　　　 // mm0 = A1 A0 R1 R0 G1 G0 B1 B0
　　punpckhbw mm1, [esi]　　　 // mm1 = A3 A2 R3 R2 G3 G2 B3 B2
　　movq　　　mm2, mm0
　　movq　　　mm3, mm1
　　punpcklbw mm0, mm7　　　　 // mm0 = 00 G1 00 G0 00 B1 00 B0
　　punpcklbw mm1, mm7　　　　 // mm1 = 00 G3 00 G2 00 B3 00 B2
　　punpckhbw mm2, mm7　　　　 // mm2 = 00 A1 00 A0 00 R1 00 R0
　　punpckhbw mm3, mm7　　　　 // mm3 = 00 A3 00 A2 00 R3 00 R2
　　movq　　　mm4, [eax + edx]
　　pmullw　　mm4, [eax + ecx + 8]
　　psrlw　　 mm4, 1　　　　　 // 先除以2，否则后面的word有符号乘法会扩展符号位
　　movq　　　mm5, mm4
　　punpckldq mm4, mm4　　　　 // mm4 = 00 m1 00 m0 00 m1 00 m0
　　punpckhdq mm5, mm5　　　　 // mm5 = 00 m3 00 m2 00 m3 00 m2
　　pmaddwd　 mm0, mm4　　　　 // mm0 = G1*m1+G0*m0 B1*m1+B0*m0
　　pmaddwd　 mm1, mm5　　　　 // mm1 = G3*m3+G2*m2 B3*m3+B2*m2
　　pmaddwd　 mm2, mm4　　　　 // mm2 = A1*m1+A0*m0 R1*m1+R0*m0
　　pmaddwd　 mm3, mm5　　　　 // mm3 = A3*m3+A2*m2 R3*m3+R2*m2
　　paddd　　 mm0, mm1　　　　 // mm0 = G3n+G2n+G1n+G0n B3n+B2n+B1n+B0n
　　paddd　　 mm2, mm3　　　　 // mm2 = A2n+A2n+A1n+A0n R3n+R2n+R1n+R0n
　　psrld　　 mm0, 15　　　　　// mm0 = Gn/0x8000　　Bn/0x8000
　　psrld　　 mm2, 15　　　　　// mm2 = An/0x8000　　Rn/0x8000
　　packssdw　mm0, mm2　　　　 // mm0 = 00 An 00 Rn 00 Gn 00 Bn
　　packuswb　mm0, mm0　　　　 // mm0 = An Rn Gn Bn An Rn Gn Bn
end;

procedure GetNearColor;
asm
　　movd　　　mm0, [esi]
end;

procedure GetBicubicColor;

　procedure SumBicubic;
　asm
　　movd　　　mm1, [esi]
　　movd　　　mm2, [esi + 4]
　　movd　　　mm3, [esi + 8]
　　movd　　　mm4, [esi + 12]
　　punpcklbw mm1, mm7
　　punpcklbw mm2, mm7
　　punpcklbw mm3, mm7
　　punpcklbw mm4, mm7
　　psllw　　 mm1, 7
　　psllw　　 mm2, 7
　　psllw　　 mm3, 7
　　psllw　　 mm4, 7
　　pmulhw　　mm1, [edi + 256 * 8 + edx]
　　pmulhw　　mm2, [edi + edx]
　　pmulhw　　mm3, [edi + 256 * 8 + eax]
　　pmulhw　　mm4, [edi + 512 * 8 + eax]
　　paddsw　　mm1, mm2
　　paddsw　　mm3, mm4
　　paddsw　　mm1, mm3
　　pmulhw　　mm1, mm5
　　paddsw　　mm0, mm1
　　add　　　 esi, [ebx].TImageData.Stride
　end;

asm
　　push　　　edi
　　mov　　　 edi, BicubicTable// edi = int64 uvTable　(item * 16384)
　　and　　　 edx, 255　　　　 // u = x & 255
　　shl　　　 edx, 3　　　　　 // edx = u * 8
　　mov　　　 eax, edx　　　　 // eax = -edx
　　neg　　　 eax
　　and　　　 ecx, 255　　　　 // v = y & 255
　　shl　　　 ecx, 3　　　　　 // ecx = v * 8
　　pxor　　　mm0, mm0
　　movq　　　mm5, [edi + 256 * 8 + ecx]
　　call　　　SumBicubic
　　movq　　　mm5, [edi + ecx]
　　call　　　SumBicubic
　　neg　　　 ecx
　　movq　　　mm5, [edi + 256 * 8 + ecx]
　　call　　　SumBicubic
　　movq　　　mm5, [edi + 512 * 8 + ecx]
　　call　　　SumBicubic
　　paddw　　 mm0, mm6　　　　 // argb += 4
　　psraw　　 mm0, 3　　　　　 // argb /= 8
　　packuswb　mm0, mm0
　　pop　 edi
end;

procedure AlphaBlendPixel;
asm
//　　movd　　　mm0, eax　　　　// mm0 = 00 00 00 00 As Rs Gs Bs
　　movd　　　mm1, [edi]　　　// mm1 = 00 00 00 00 Ad Rd Gd Bd
　　punpcklbw mm0, mm7　　　　// mm0 = 00 As 00 Rs 00 Gs 00 Bs
　　punpcklbw mm1, mm7　　　　// mm1 = 00 Ad 00 Rd 00 Gd 00 Bd
　　movq　　　mm2, mm0
　　punpckhwd mm2, mm2
　　punpckhdq mm2, mm2　　　　// mm2 = Alpha Alpha Alpha Alpha
　　psubw　　 mm0, mm1　　　　// mm0 = As-Ad Rs-Rd Gs-Gd Bs-Bd
　　pmullw　　mm0, mm2　　　　// mm0 = As*Alpha Rs*Alpha Gs*Alpha Bs*Alpha
　　psllw　　 mm1, 8　　　　　// mm1 = Ad*256 Rd*256 Gd*256 Bd*256
　　paddw　　 mm0, mm1　　　　// mm0 = 00 An 00 Rn 00 Gn 00 Bn
　　psrlw　　 mm0, 8　　　　　// mm0 = An/256 Rn/256 Gn/256 Bn/256
　　packuswb　mm0, mm7　　　　// mm0 = 00 00 00 00 An Rn Gn Bn
　　movd　　　[edi], mm0
end;

function GetInterpolateProc(IpMode: TInterpolateMode; var Proc: TInterpolateProc): Integer;
begin
　case IpMode of
　　imNear:
　　begin
　　　Result := 1;
　　　Proc := GetNearColor;
　　end;
　　imBicubic:
　　begin
　　　Result := 4;
　　　Proc := GetBicubicColor;
　　end
　else
　　begin
　　　Result := 2;
　　　Proc := GetBilinearColor;
　　end;
　end;
end;

procedure ImageScale(Dest: TImageData; const Source: TImageData; IpMode: TInterpolateMode);
var
　x, y: Integer;
　Width, Height: Integer;
　xDelta, yDelta: Integer;
　Radius, dstOffset: Integer;
　src: TImageData;
　GetColor: TInterpolateProc;

　procedure DoScale(dst: TImageData);
　asm
　　pxor　　　mm7, mm7
　　mov　　　 edx, 04040404h
　　movd　　　mm6, edx
　　punpcklbw mm6, mm7
　　lea　　　 edx, src
　　push　　　edx
　　call　　　SetDataCopyReg
　　imul　　　ecx, xDelta
　　imul　　　edx, yDelta
　　add　　　 ecx, x
　　add　　　 edx, y
　　mov　　　 Width, ecx
　　mov　　　 Height, edx
　　mov　　　 dstOffset, ebx
　　pop　　　 ebx
　　mov　　　 ecx, y　　　　　 // for (; y < Height;　y ++){
@yLoop:　　　　　　　　　　　// {
　　mov　　　 esi, ecx
　　sar　　　 esi, 8　　　　　 //　 esi = Source.Scan0 + y / 256 * Source.Stride
　　imul　　　esi, [ebx].TImageData.Stride
　　add　　　 esi, [ebx].TImageData.Scan0
　　mov  　　edx, x　　　　　 //　 for (; x < Width; x ++){
@xLoop:　　　　　　　　　　　//　 {
　　push　　　esi
　　push　　　edx
　　push　　　ecx
　　mov　　　 eax, edx
　　sar　　　 eax, 8
　　shl　　　 eax, 2
　　add　　　 esi, eax　　　　 //　　 esi += (x / 256 * 4)
　　call　　　GetColor　　　　 //　　 mm0 = GetColor(src, esi, x, y)
　　call　　　AlphaBlendPixel　//　　 AlphaBlendPixel(mm0, edi)
　　add　　　 edi, 4　　　　　 //　　 edi += 4
　　pop　　　 ecx
　　pop　　　 edx
　　pop　　　 esi
add 　　edx, xDelta 　 //　　 x0 += xDelta
　　cmp　　　 edx, Width
　　jl　　　　@xLoop　　　　　 //　 }
　　add　　　 edi, dstOffset　 //　 edi += dstOffset
add 　　ecx, yDelta 　 //　 y0 += yDelta
　　cmp　　　 ecx, Height
　　jl　　　　@yLoop　　　　　 // }
　　emms
　end;

begin
　Radius := GetInterpolateProc(IpMode, GetColor);
　xDelta := (Source.Width shl 8) div Dest.Width;
　yDelta := (Source.Height shl 8) div Dest.Height;
　x := (xDelta{ shr 1}) + (Radius shl 7);
　y := (yDelta{ shr 1}) + (Radius shl 7);
　src := ImageGetExpandData(Source, 0, 0, Source.Width, Source.Height, Radius);
　try
　　DoScale(Dest);
　finally
　　FreeImageData(src);
　end;
end;

procedure ImageScale(Dest: TImageData; x, y: Integer;
　const Source: TImageData; ScaleX, ScaleY: Single; IpMode: TInterpolateMode);
var
　src, dst: TImageData;
begin
　if not ((ScaleX > 0.0) and (ScaleY > 0.0)) then
　　Exit;
　dst := GetSubImageData(Dest, x, y, Round(Source.Width * ScaleX),
　　Round(Source.Height * ScaleY));
　if ImageEmpty(dst) then Exit;
　if x < 0 then x := -Trunc(x / ScaleX) else x := 0;
　if y < 0 then y := -Trunc(y / ScaleY) else y := 0;
　src := GetSubImageData(Source, x, y, Round(dst.Width / ScaleX),
　　Round(dst.Height / ScaleY));
　ImageScale(dst, src, IpMode);
end;

procedure ImageScale(Dest: TImageData; const Source: TGraphic;
　IpMode: TInterpolateMode);
var
　src: TImageData;
begin
　src := GetImageData(Source);
　ImageScale(Dest, src, IpMode);
　FreeImageData(src);
end;

procedure ImageScale(Dest: TImageData; x, y: Integer;
　const Source: TGraphic; ScaleX, ScaleY: Single; IpMode: TInterpolateMode);
var
　src: TImageData;
begin
　src := GetImageData(Source);
　ImageScale(Dest, x, y, src, ScaleX, ScaleY, IpMode);
　FreeImageData(src);
end;

procedure ImageScale(Dest: TImageData;
　const Source: TGpBitmap; IpMode: TInterpolateMode);
var
　src: TImageData;
begin
　src := GetImageData(Source);
　ImageScale(Dest, src, IpMode);
　FreeImageData(src);
end;

procedure ImageScale(Dest: TImageData; x, y: Integer;
　const Source: TGpBitmap; ScaleX, ScaleY: Single; IpMode: TInterpolateMode);
var
　src: TImageData;
begin
　src := GetImageData(Source);
　ImageScale(Dest, x, y, src, ScaleX, ScaleY, IpMode);
　FreeImageData(src);
end;

procedure SetBicubicSlope(const Value: Single);
type
　TBicArray = array[0..3] of Smallint;
　PBicArray = ^TBicArray;

var
　I: Integer;
　P: PBicArray;

　function BicubicFunc(x : double): double;
　var
　　x2, x3: double;
　begin
　　if x < 0.0 then x := -x;
　　x2 := x * x;
　　x3 := x2 * x;
　　if x <= 1.0 then
　　　Result := (Value + 2.0) * x3 - (Value + 3.0) * x2 + 1.0
　　else if x <= 2.0 then
　　　Result := Value * x3 - (5.0 * Value) * x2 + (8.0 * Value) * x - (4.0 * Value)
　　else Result := 0.0;
　end;

begin
　if (BicubicSlope <> Value) and (Value < 0.0) {and (Value >= -2.0)} then
　begin
　　BicubicSlope := Value;
　　P := BicubicTable;
　　for I := 0 to 512 do
　　begin
　　　P^[0] := Round(16384 * BicubicFunc(I * (1.0 / 256)));
　　　P^[1] := P^[0];
　　　P^[2] := P^[0];
　　　P^[3] := P^[0];
　　　Inc(P);
　　end;
　end;
end;


　　临近插值过程很简单，就一句代码，而线性插值过程和双立方插值过程则较复杂，而且对于各像素的插值比例计算更是耗时，为了加快插值速度，线性插值过程和双立方插值过程都用了事先计算好的插值比例表，分别存放在BilinearTable变量和BicubicTable变量中，这2个变量的初始化是在单元的初始化代码中实现的：

view plaincopy to clipboardprint?
procedure InitBilinearTable;　 
begin　
　BilinearTable := GlobalAllocPtr(GMEM_MOVEABLE, 256 * 2 * 8);　 
　asm　
　　push　　　esi　 
　　mov　　　 esi, BilinearTable　 
　　xor　　　 ecx, ecx　 
　@SumLoop:　 
　　mov　　　 edx, ecx　 
　　　　and　　　　 edx, 255　　　　 // u(v) = x & 0xff　 
　　mov　　　 eax, 100h　 
　　sub　　　 eax, edx　 
　　jnz　　　 @@1　
　　dec　　　 edx　 
　　jmp　　　 @@2　
　@@1:　 
　　test　　　edx, edx　 
　　jnz　　　 @@2　
　　dec　　　 eax　 
　@@2:　 
　　shl　　　 edx, 16　
　　or　　　　edx, eax　　　　 // edx = 00 u(v) 00 ff-u(v)　 
　　movd　　　mm0, edx　 
　　movd　　　mm1, edx　 
　　punpcklwd mm0, mm0　　　　 // mm0 = 00　u 00　u 00 ff-u 00 ff-u　 
　　punpckldq mm1, mm1　　　　 // mm1 = 00　v 00 ff-v 00　v 00 ff-v　 
　　movq　　　[esi], mm0　 
　　movq　　　[esi + 8], mm1　 
　　add　　　 esi, 16　
　　inc　　　 ecx　 
　　cmp　　　 ecx, 256　
　　jl　　　　@SumLoop　 
　　emms　 
　　pop　　　 esi　 
　end;　 
end;　 
　
initialization　
begin　
　InitBilinearTable;　 
　BicubicTable := GlobalAllocPtr(GMEM_MOVEABLE, (512 + 1) * 8);　 
　SetBicubicSlope(-0.75);　 
end;　 
finalization　
begin　
　GlobalFreePtr(BicubicTable);　 
　GlobalFreePtr(BilinearTable);　 
end;　
procedure InitBilinearTable;
begin
　BilinearTable := GlobalAllocPtr(GMEM_MOVEABLE, 256 * 2 * 8);
　asm
　　push　　　esi
　　mov　　　 esi, BilinearTable
　　xor　　　 ecx, ecx
　@SumLoop:
　　mov　　　 edx, ecx
and 　　edx, 255　　　　 // u(v) = x & 0xff
　　mov　　　 eax, 100h
　　sub　　　 eax, edx
　　jnz　　　 @@1
　　dec　　　 edx
　　jmp　　　 @@2
　@@1:
　　test　　　edx, edx
　　jnz　　　 @@2
　　dec　　　 eax
　@@2:
　　shl　　　 edx, 16
　　or　　　　edx, eax　　　　 // edx = 00 u(v) 00 ff-u(v)
　　movd　　　mm0, edx
　　movd　　　mm1, edx
　　punpcklwd mm0, mm0　　　　 // mm0 = 00　u 00　u 00 ff-u 00 ff-u
　　punpckldq mm1, mm1　　　　 // mm1 = 00　v 00 ff-v 00　v 00 ff-v
　　movq　　　[esi], mm0
　　movq　　　[esi + 8], mm1
　　add　　　 esi, 16
　　inc　　　 ecx
　　cmp　　　 ecx, 256
　　jl　　　　@SumLoop
　　emms
　　pop　　　 esi
　end;
end;

initialization
begin
　InitBilinearTable;
　BicubicTable := GlobalAllocPtr(GMEM_MOVEABLE, (512 + 1) * 8);
　SetBicubicSlope(-0.75);
end;
finalization
begin
　GlobalFreePtr(BicubicTable);
　GlobalFreePtr(BilinearTable);
end;


　　其中，通过调用SetBicubicSlope可改变双立方插值的效果，这个值一般在-0.5　--　-2.0之间，初始值为-0.75。

　　图像旋转过程也要用到上面的插值过程的。

　　关于线性插值原理，在GetBilinearColor过程前面有一段伪代码作为解释；为了帮助理解双立方插值方式，下面给出其纯Pascal的浮点版和整数版代码：

view plaincopy to clipboardprint?
type　
　TImageData = packed record　
　　Width: LongWord;　　　　 // 图像宽度　 
　　Height: LongWord;　　　　// 图像高度　 
　　Stride: LongWord;　　　　// 图像扫描线字节长度　 
　　Scan0: Pointer;　　　　　// 图像数据地址　　 
　end;　 
　
// 浮点数版，Source四周的边界分别扩展了3　 
procedure BicubicScale(Source, Dest: TImageData);　 
　const A = -0.75;　　　　　// 0.0 < BicuBicSlope <= 2.0　 
　
　function BicubicFunc(x : double): double;　 
　var　
　　x2, x3: double;　 
　begin　
　　if x < 0 then x := -x;　 
　　x2 := x * x;　 
　　x3 := x2 * x;　 
　　if x <= 1 then　
　　　Result := (A + 2) * x3 - (A + 3) * x2 + 1　
　　else if x <= 2 then　
　　　Result := A * x3 - (5 * A) * x2 + (8 * A) * x - (4 * A)　 
　　else Result := 0;　 
　end;　 
　
　function Bicubic(fx, fy: double): TRGBQuad;　 
　var　
　　x, y, x0, y0: Integer;　 
　　fu, fv: double;　 
　　pixel: array[0..3, 0..3] of PRGBQuad;　 
　　afu, afv, aARGB, sARGB: array[0..3] of double;　 
　　i, j: Integer;　 
　begin　
　　x0 := Trunc(floor(fx));　 
　　y0 := Trunc(floor(fy));　 
　　fu := fx - x0;　 
　　fv := fy - y0;　 
　　for i := 0 to 3 do　
　　begin　
　　　for j := 0 to 3 do　
　　　begin　
　　　　x := x0 - 1 + j;　 
　　　　y := y0 - 1 + i;　 
　　　　pixel[i, j] := PRGBQuad(LongWord(Source.Scan0) + y * Source.Stride + x shl 2);　 
　　　end;　 
　　　sARGB[i] := 0;　 
　　end;　 
　　afu[0] := BicubicFunc(1 + fu);　 
　　afu[1] := BicubicFunc(fu);　 
　　afu[2] := BicubicFunc(1 - fu);　 
　　afu[3] := BicubicFunc(2 - fu);　 
　　afv[0] := BicubicFunc(1 + fv);　 
　　afv[1] := BicubicFunc(fv);　 
　　afv[2] := BicubicFunc(1 - fv);　 
　　afv[3] := BicubicFunc(2 - fv);　 
　　for i := 0 to 3 do　
　　begin　
　　　for j := 0 to 3 do　
　　　　aARGB[j] := 0;　 
　　　for j := 0 to 3 do　
　　　begin　
　　　　aARGB[3] := aARGB[3] + afu[j] * pixel[i, j]^.rgbReserved;　 
　　　　aARGB[2] := aARGB[2] + afu[j] * pixel[i, j]^.rgbRed;　 
　　　　aARGB[1] := aARGB[1] + afu[j] * pixel[i, j]^.rgbGreen;　 
　　　　aARGB[0] := aARGB[0] + afu[j] * pixel[i, j]^.rgbBlue;　 
　　　end;　 
　　　sARGB[3] := sARGB[3] + aARGB[3] * afv[i];　 
　　　sARGB[2] := sARGB[2] + aARGB[2] * afv[i];　 
　　　sARGB[1] := sARGB[1] + aARGB[1] * afv[i];　 
　　　sARGB[0] := sARGB[0] + aARGB[0] * afv[i];　 
　　end;　 
　　Result.rgbBlue := Max(0, Min(255, Round(sARGB[0])));　 
　　Result.rgbGreen := Max(0, Min(255, Round(sARGB[1])));　 
　　Result.rgbRed := Max(0, Min(255, Round(sARGB[2])));　 
　　Result.rgbReserved := Max(0, Min(255, Round(sARGB[3])));　 
　end;　 
var　
　x, y: Integer;　 
　fx, fy: double;　 
　Offset: LongWord;　 
　p: PLongWord;//PRGBQuad;　 
begin　
　Offset := Dest.Stride - Dest.Width shl 2;　 
　p := PLongWord(Dest.Scan0);　 
　for y := 0 to Dest.Height - 1 do　
　begin　
　　fy := (y + 0.4999999) * Source.Height / Dest.Height - 0.5;　 
　　for x := 0 to Dest.Width - 1 do　
　　begin　
　　　fx := (x + 0.4999999) * Source.Width / Dest.Width - 0.5;　 
　　　P^ := LongWord(Bicubic(fx, fy));　 
　　　Inc(p);　 
　　end;　 
　　Inc(LongWord(p), Offset);　 
　end;　 
end;　 
　
　
const InterpolationRadius = 3;　 
var　
　BicubicUVTable: array[0..512] of Integer;　 
　
procedure InitBicubicUVTable;　 
const A = -0.75;　 
　
　function BicubicFunc(x : double): double;　 
　var　
　　x2, x3: double;　 
　begin　
　　if x < 0 then x := -x;　 
　　x2 := x * x;　 
　　x3 := x2 * x;　 
　　if x <= 1 then　
　　　Result := (A + 2) * x3 - (A + 3) * x2 + 1　
　　else if x <= 2 then　
　　　Result := A * x3 - (5 * A) * x2 + (8 * A) * x - (4 * A)　 
　　else Result := 0;　 
　end;　 
var　
　I: Integer;　 
begin　
　for I := 0 to 512 do　
　　BicubicUVTable[I] := Round(256 * BicubicFunc(I * (1.0 / 256)));　 
end;　 
　
// 定点数版，Source四周的边界分别扩展了3　 
procedure BicubicScale(Source, Dest: TImageData);　 
　
　function Bicubic(x, y: Integer): TRGBQuad;　 
　var　
　　x0, y0, u, v: Integer;　 
　　pixel: PRGBQuad;　 
　　au, av, aARGB, sARGB: array[0..3] of Integer;　 
　　i, j: Integer;　 
　begin　
　　u := x and 255;　 
　　v := y and 255;　 
　　pixel := PRGBQuad(LongWord(Source.Scan0) + (y div 256 - 1) * Source.Stride + ((x div 256 - 1) shl 2));　 
　　for i := 0 to 3 do　
　　　sARGB[i] := 0;　 
　　au[0] := BicubicUVTable[256 + u];　 
　　au[1] := BicubicUVTable[u];　 
　　au[2] := BicubicUVTable[256 - u];　 
　　au[3] := BicubicUVTable[512 - u];　 
　　av[0] := BicubicUVTable[256 + v];　 
　　av[1] := BicubicUVTable[v];　 
　　av[2] := BicubicUVTable[256 - v];　 
　　av[3] := BicubicUVTable[512 - v];　 
　　for i := 0 to 3 do　
　　begin　
　　　for j := 0 to 3 do　
　　　　aARGB[j] := 0;　 
　　　for j := 0 to 3 do　
　　　begin　
　　　　aARGB[3] := aARGB[3] + au[j] * pixel^.rgbReserved;　 
　　　　aARGB[2] := aARGB[2] + au[j] * pixel^.rgbRed;　 
　　　　aARGB[1] := aARGB[1] + au[j] * pixel^.rgbGreen;　 
　　　　aARGB[0] := aARGB[0] + au[j] * pixel^.rgbBlue;　 
　　　　Inc(LongWord(pixel), 4);　 
　　　end;　 
　　　sARGB[3] := sARGB[3] + aARGB[3] * av[i];　 
　　　sARGB[2] := sARGB[2] + aARGB[2] * av[i];　 
　　　sARGB[1] := sARGB[1] + aARGB[1] * av[i];　 
　　　sARGB[0] := sARGB[0] + aARGB[0] * av[i];　 
　　　Inc(LongWord(pixel), FStride - 16);　 
　　end;　 
　　Result.rgbBlue := Max(0, Min(255, sARGB[0] div 65536));　 
　　Result.rgbGreen := Max(0, Min(255, sARGB[1] div 65536));　 
　　Result.rgbRed := Max(0, Min(255, sARGB[2] div 65536));　 
　　Result.rgbReserved := Max(0, Min(255, sARGB[3] div 65536));　 
　end;　 
　
var　
　x, x0, y, xDelta, yDelta: Integer;　 
　w, h: Integer;　 
　Offset: LongWord;　 
　p: PLongWord;　 
begin　
　InitBicubicUVTable;　 
　p := PLongWord(Dest.Scan0);　 
　Offset := Dest.Stride - Dest.Width shl 2;　 
　yDelta := ((Source.Height - InterpolationRadius * 2) * 256) div Dest.Height;　 
　xDelta := ((Source.Width - InterpolationRadius * 2) * 256) div Dest.Width;　 
　y := (yDelta shr 1) - $80 + $200;　 
　x0 := (xDelta shr 1) - $80 + $200;　 
　h := Dest.Height * yDelta + y;　 
　w := Dest.Width * xDelta + x0;　 
　while y < h do　
　begin　
　　x := x0;　 
　　while x < w do　
　　begin　
　　　P^ := LongWord(Bicubic(x, y));　 
　　　Inc(x, xDelta);　 
　　　Inc(p);　 
　　end;　 
　　Inc(y, yDelta);　 
　　Inc(LongWord(p), Offset);　 
　end;　 
end;　
type
　TImageData = packed record
　　Width: LongWord;　　　　 // 图像宽度
　　Height: LongWord;　　　　// 图像高度
　　Stride: LongWord;　　　　// 图像扫描线字节长度
　　Scan0: Pointer;　　　　　// 图像数据地址
　end;

// 浮点数版，Source四周的边界分别扩展了3
procedure BicubicScale(Source, Dest: TImageData);
　const A = -0.75;　　　　　// 0.0 < BicuBicSlope <= 2.0

　function BicubicFunc(x : double): double;
　var
　　x2, x3: double;
　begin
　　if x < 0 then x := -x;
　　x2 := x * x;
　　x3 := x2 * x;
　　if x <= 1 then
　　　Result := (A + 2) * x3 - (A + 3) * x2 + 1
　　else if x <= 2 then
　　　Result := A * x3 - (5 * A) * x2 + (8 * A) * x - (4 * A)
　　else Result := 0;
　end;

　function Bicubic(fx, fy: double): TRGBQuad;
　var
　　x, y, x0, y0: Integer;
　　fu, fv: double;
　　pixel: array[0..3, 0..3] of PRGBQuad;
　　afu, afv, aARGB, sARGB: array[0..3] of double;
　　i, j: Integer;
　begin
　　x0 := Trunc(floor(fx));
　　y0 := Trunc(floor(fy));
　　fu := fx - x0;
　　fv := fy - y0;
　　for i := 0 to 3 do
　　begin
　　　for j := 0 to 3 do
　　　begin
　　　　x := x0 - 1 + j;
　　　　y := y0 - 1 + i;
　　　　pixel[i, j] := PRGBQuad(LongWord(Source.Scan0) + y * Source.Stride + x shl 2);
　　　end;
　　　sARGB[i] := 0;
　　end;
　　afu[0] := BicubicFunc(1 + fu);
　　afu[1] := BicubicFunc(fu);
　　afu[2] := BicubicFunc(1 - fu);
　　afu[3] := BicubicFunc(2 - fu);
　　afv[0] := BicubicFunc(1 + fv);
　　afv[1] := BicubicFunc(fv);
　　afv[2] := BicubicFunc(1 - fv);
　　afv[3] := BicubicFunc(2 - fv);
　　for i := 0 to 3 do
　　begin
　　　for j := 0 to 3 do
　　　　aARGB[j] := 0;
　　　for j := 0 to 3 do
　　　begin
　　　　aARGB[3] := aARGB[3] + afu[j] * pixel[i, j]^.rgbReserved;
　　　　aARGB[2] := aARGB[2] + afu[j] * pixel[i, j]^.rgbRed;
　　　　aARGB[1] := aARGB[1] + afu[j] * pixel[i, j]^.rgbGreen;
　　　　aARGB[0] := aARGB[0] + afu[j] * pixel[i, j]^.rgbBlue;
　　　end;
　　　sARGB[3] := sARGB[3] + aARGB[3] * afv[i];
　　　sARGB[2] := sARGB[2] + aARGB[2] * afv[i];
　　　sARGB[1] := sARGB[1] + aARGB[1] * afv[i];
　　　sARGB[0] := sARGB[0] + aARGB[0] * afv[i];
　　end;
　　Result.rgbBlue := Max(0, Min(255, Round(sARGB[0])));
　　Result.rgbGreen := Max(0, Min(255, Round(sARGB[1])));
　　Result.rgbRed := Max(0, Min(255, Round(sARGB[2])));
　　Result.rgbReserved := Max(0, Min(255, Round(sARGB[3])));
　end;
var
　x, y: Integer;
　fx, fy: double;
　Offset: LongWord;
　p: PLongWord;//PRGBQuad;
begin
　Offset := Dest.Stride - Dest.Width shl 2;
　p := PLongWord(Dest.Scan0);
　for y := 0 to Dest.Height - 1 do
　begin
　　fy := (y + 0.4999999) * Source.Height / Dest.Height - 0.5;
　　for x := 0 to Dest.Width - 1 do
　　begin
　　　fx := (x + 0.4999999) * Source.Width / Dest.Width - 0.5;
　　　P^ := LongWord(Bicubic(fx, fy));
　　　Inc(p);
　　end;
　　Inc(LongWord(p), Offset);
　end;
end;


const InterpolationRadius = 3;
var
　BicubicUVTable: array[0..512] of Integer;

procedure InitBicubicUVTable;
const A = -0.75;

　function BicubicFunc(x : double): double;
　var
　　x2, x3: double;
　begin
　　if x < 0 then x := -x;
　　x2 := x * x;
　　x3 := x2 * x;
　　if x <= 1 then
　　　Result := (A + 2) * x3 - (A + 3) * x2 + 1
　　else if x <= 2 then
　　　Result := A * x3 - (5 * A) * x2 + (8 * A) * x - (4 * A)
　　else Result := 0;
　end;
var
　I: Integer;
begin
　for I := 0 to 512 do
　　BicubicUVTable[I] := Round(256 * BicubicFunc(I * (1.0 / 256)));
end;

// 定点数版，Source四周的边界分别扩展了3
procedure BicubicScale(Source, Dest: TImageData);

　function Bicubic(x, y: Integer): TRGBQuad;
　var
　　x0, y0, u, v: Integer;
　　pixel: PRGBQuad;
　　au, av, aARGB, sARGB: array[0..3] of Integer;
　　i, j: Integer;
　begin
　　u := x and 255;
　　v := y and 255;
　　pixel := PRGBQuad(LongWord(Source.Scan0) + (y div 256 - 1) * Source.Stride + ((x div 256 - 1) shl 2));
　　for i := 0 to 3 do
　　　sARGB[i] := 0;
　　au[0] := BicubicUVTable[256 + u];
　　au[1] := BicubicUVTable[u];
　　au[2] := BicubicUVTable[256 - u];
　　au[3] := BicubicUVTable[512 - u];
　　av[0] := BicubicUVTable[256 + v];
　　av[1] := BicubicUVTable[v];
　　av[2] := BicubicUVTable[256 - v];
　　av[3] := BicubicUVTable[512 - v];
　　for i := 0 to 3 do
　　begin
　　　for j := 0 to 3 do
　　　　aARGB[j] := 0;
　　　for j := 0 to 3 do
　　　begin
　　　　aARGB[3] := aARGB[3] + au[j] * pixel^.rgbReserved;
　　　　aARGB[2] := aARGB[2] + au[j] * pixel^.rgbRed;
　　　　aARGB[1] := aARGB[1] + au[j] * pixel^.rgbGreen;
　　　　aARGB[0] := aARGB[0] + au[j] * pixel^.rgbBlue;
　　　　Inc(LongWord(pixel), 4);
　　　end;
　　　sARGB[3] := sARGB[3] + aARGB[3] * av[i];
　　　sARGB[2] := sARGB[2] + aARGB[2] * av[i];
　　　sARGB[1] := sARGB[1] + aARGB[1] * av[i];
　　　sARGB[0] := sARGB[0] + aARGB[0] * av[i];
　　　Inc(LongWord(pixel), FStride - 16);
　　end;
　　Result.rgbBlue := Max(0, Min(255, sARGB[0] div 65536));
　　Result.rgbGreen := Max(0, Min(255, sARGB[1] div 65536));
　　Result.rgbRed := Max(0, Min(255, sARGB[2] div 65536));
　　Result.rgbReserved := Max(0, Min(255, sARGB[3] div 65536));
　end;

var
　x, x0, y, xDelta, yDelta: Integer;
　w, h: Integer;
　Offset: LongWord;
　p: PLongWord;
begin
　InitBicubicUVTable;
　p := PLongWord(Dest.Scan0);
　Offset := Dest.Stride - Dest.Width shl 2;
　yDelta := ((Source.Height - InterpolationRadius * 2) * 256) div Dest.Height;
　xDelta := ((Source.Width - InterpolationRadius * 2) * 256) div Dest.Width;
　y := (yDelta shr 1) - $80 + $200;
　x0 := (xDelta shr 1) - $80 + $200;
　h := Dest.Height * yDelta + y;
　w := Dest.Width * xDelta + x0;
　while y < h do
　begin
　　x := x0;
　　while x < w do
　　begin
　　　P^ := LongWord(Bicubic(x, y));
　　　Inc(x, xDelta);
　　　Inc(p);
　　end;
　　Inc(y, yDelta);
　　Inc(LongWord(p), Offset);
　end;
end;


　　另外，有关插值边界的处理，一般有2种办法，一是在插值过程中进行判断坐标是否超界而作相应的处理，二是舍弃边界部分，对于后者我是不主张的，因为那样是不完整的处理。我采用了扩展边框的办法进行边框插值处理，这样一来，虽然多了一道拷贝过程，却少了具体插值过程的坐标判断，二者抵消，插值速度应该是差不多的（据我测试，扩展边框办法在图像放大和旋转处理中速度还是略快一些），但是简化了插值代码。

　　下面是一个简单的图像缩放例子：

view plaincopy to clipboardprint?
type　
　TMainForm = class(TForm)　 
　　Image1: TImage;　 
　　RadioButton1: TRadioButton;　 
　　RadioButton2: TRadioButton;　 
　　RadioButton3: TRadioButton;　 
　　Button1: TButton;　 
　　Image2: TImage;　 
　　procedure FormCreate(Sender: TObject);　 
　　procedure RadioButton1Click(Sender: TObject);　 
　　procedure Button1Click(Sender: TObject);　 
　private　
　　{ Private declarations }　
　　FMode: TInterpolateMode;　 
　public　
　　{ Public declarations }　
　end;　 
　
var　
　MainForm: TMainForm;　 
　
implementation　
　
{$R *.dfm}　
　
procedure TMainForm.FormCreate(Sender: TObject);　 
begin　
　Image1.Picture.Bitmap.PixelFormat := pf24Bit;　 
　RadioButton2.Checked := True;　 
　RadioButton1Click(RadioButton2);　 
end;　 
　
procedure TMainForm.RadioButton1Click(Sender: TObject);　 
var　
　M: TInterpolateMode;　 
　Data: TImageData;　 
begin　
　M := TInterpolateMode(TRadioButton(Sender).Tag);　 
　if FMode <> M then　
　begin　
　　FMode := M;　 
　　Data := NewImageData(Image1.Width, Image1.Height, 0);　 
　　ImageScale(Data, Image2.Picture.Graphic, FMode);　 
　　ImageDataAssignTo(Data, Image1.Picture.Bitmap);　 
　　FreeImageData(Data);　 
　　Image1.Invalidate;　 
　end;　 
end;　 
　
procedure TMainForm.Button1Click(Sender: TObject);　 
begin　
　Close;　 
end;　
type
　TMainForm = class(TForm)
　　Image1: TImage;
　　RadioButton1: TRadioButton;
　　RadioButton2: TRadioButton;
　　RadioButton3: TRadioButton;
　　Button1: TButton;
　　Image2: TImage;
　　procedure FormCreate(Sender: TObject);
　　procedure RadioButton1Click(Sender: TObject);
　　procedure Button1Click(Sender: TObject);
　private
　　{ Private declarations }
　　FMode: TInterpolateMode;
　public
　　{ Public declarations }
　end;

var
　MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
　Image1.Picture.Bitmap.PixelFormat := pf24Bit;
　RadioButton2.Checked := True;
　RadioButton1Click(RadioButton2);
end;

procedure TMainForm.RadioButton1Click(Sender: TObject);
var
　M: TInterpolateMode;
　Data: TImageData;
begin
　M := TInterpolateMode(TRadioButton(Sender).Tag);
　if FMode <> M then
　begin
　　FMode := M;
　　Data := NewImageData(Image1.Width, Image1.Height, 0);
　　ImageScale(Data, Image2.Picture.Graphic, FMode);
　　ImageDataAssignTo(Data, Image1.Picture.Bitmap);
　　FreeImageData(Data);
　　Image1.Invalidate;
　end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
　Close;
end;


　　运行效果图如下：



　　文章中所用数据类型及一些过程见《Delphi图像处理 -- 数据类型及内部过程》和《Delphi图像处理 -- 图像像素结构与图像数据转换》。