[lazarus] 分享一个BMP图像平滑缩放的代码

刚把fastbmp的SmoothResize移植成功，速度比lazarus官方例子要快接近一倍，效果也比他的好，常规的缩放，有些点阵会有变色，但通过插值缩放则不会，而且细节还会得到保留。
先贴出lazarus官方的source:

procedure StretchDrawBitmapToBitmap(SourceBitmap, DestBitmap: TBitmap; DestWidth, DestHeight: integer);var  DestIntfImage, SourceIntfImage: TLazIntfImage;  DestCanvas: TLazCanvas;begin  // Prepare the destination  DestBitmap.Height:=DestHeight;  DestBitmap.Width:=DestWidth;  DestIntfImage := TLazIntfImage.Create(0, 0);  DestIntfImage.LoadFromBitmap(DestBitmap.Handle, 0);  DestCanvas := TLazCanvas.Create(DestIntfImage);  //Prepare the source  SourceIntfImage := TLazIntfImage.Create(0, 0);  SourceIntfImage.LoadFromBitmap(SourceBitmap.Handle, 0);  // Execute the stretch draw via TFPSharpInterpolation  DestCanvas.Interpolation := TFPSharpInterpolation.Create;  DestCanvas.StretchDraw(0, 0, DestWidth, DestHeight, SourceIntfImage);  // Reload the image into the TBitmap  DestBitmap.LoadFromIntfImage(DestIntfImage);  SourceIntfImage.Free;  DestCanvas.Interpolation.Free;  DestCanvas.Free;  DestIntfImage.Free;end;

SmoothResize的source ，代码源自若干年前Gordon Alex Cowie等大神之手的fastbmp，原代码要依赖window api，故一直编译不成功，所以只能抽离此procedure。原来的流程是首选获得bitmap的点阵数据储存于内存，然后scanline时直接取内存块对应位置的数据，速度相当迅猛。当年楼主作的一个类似remote control之类的工具就使用了fastbmp，比用tbitmap快多了而且不耗内存。现在谷歌fastbmp，资料已经寥寥无几了，感叹delphi/pascal已到了末日黄花。。。。

typeTFColor = record    b, g, r: Byte;  end;  PFColor = ^TFColor;  TLine = array[0..0] of TFColor;  PLine = ^TLine;procedure SmoothResize(Src,Dst: TBitmap;newWidth,newHeight:integer);var  x, y, xP, yP,    yP2, xP2: Integer;  Read, Read2: PLine;  t, z, iz, z2, iz2: Integer;  pc: PFColor;begin  if src.Width = 1 then  begin    Exit;  end;  Dst.Width:=newWidth;  Dst.Height:=newHeight;  {if (Dst.Width = src.Width) and (Dst.Height = src.Height) then  begin    CopyMemory(Dst.Bits, Bits, Size);    Exit;  end;  }  xP2 := ((src.Width - 1) shl 16) div Dst.Width;  yP2 := ((src.Height - 1) shl 16) div Dst.Height;  yP := 0;  for y := 0 to Dst.Height - 1 do  begin    xP := 0;    Read := src.ScanLine[yP shr 16];    if yP shr 16 < src.Height - 1 then      Read2 := src.ScanLine[yP shr 16 + 1]    else      Read2 := src.ScanLine[yP shr 16];    pc := Dst.ScanLine[y];    z2 := yP and $FFFF;    iz2 := $10000 - z2;    for x := 0 to Dst.Width - 1 do    begin      t := xP shr 16;      z := xP and $FFFF;      iz := $10000 - z;      pc^.b :=        (((Read^[t].b * iz + Read^[t + 1].b * z) shr 16) * iz2 +        ((Read2^[t].b * iz + Read2^[t + 1].b * z) shr 16) * z2) shr 16;      pc^.r :=        (((Read^[t].r * iz + Read^[t + 1].r * z) shr 16) * iz2 +        ((Read2^[t].r * iz + Read2^[t + 1].r * z) shr 16) * z2) shr 16;      pc^.g :=        (((Read^[t].g * iz + Read^[t + 1].g * z) shr 16) * iz2 +        ((Read2^[t].g * iz + Read2^[t + 1].g * z) shr 16) * z2) shr 16;      Inc(pc);      Inc(xP, xP2);    end;    Inc(yP, yP2);  end;end;

调用例子如下，在exe同目录，必须存在1.bmp图片，运行后会生成2.bmp/3.bmp，很明显2.bmp要平滑得多，而且不变色：

procedure TForm1.Button1Click(Sender: TObject);var w_src_path:string;  w_src,w_dest:TBitmap;  w_t1:TDateTime;begin     w_src_path:=ExtractFileDir(ParamStrUTF8(0))+'/1.bmp';     w_src:=TBitmap.Create;     w_src.LoadFromFile(w_src_path);     w_dest:=TBitmap.Create;     w_t1:=Now;     SmoothResize(w_src,w_dest,320,320);     Label1.Caption:=FloatToStr((Now-w_t1)/1000);     w_dest.SaveToFile(ExtractFileDir(ParamStrUTF8(0))+'/2.bmp');     w_t1:=Now;     StretchDrawBitmapToBitmap(w_src,w_dest,320,320);     Label2.Caption:=FloatToStr((Now-w_t1)/1000);     w_dest.SaveToFile(ExtractFileDir(ParamStrUTF8(0))+'/3.bmp');   /*   w_src,w_dest free ....*/...end;