Delphi中位图缩放效果代码

时间：2011/9/3 15:01:01 点击：

　　核心提示：procedure StretchBitmap(Dest, Src: TBitmap);var sw, sh, dw, dh, B, N, x, y, i, j, k, nPixelSize: DWo...

procedure StretchBitmap(Dest, Src: TBitmap);
var
sw, sh, dw, dh, B, N, x, y, i, j, k, nPixelSize: DWord;
pLinePrev, pLineNext, pDest, pA, pB, pC, pD: PByte;
begin
sw := Src.Width -1;
sh := Src.Height -1;
dw := Dest.Width -1;
dh := Dest.Height -1;
//获得显示模式
nPixelSize := Integer(Src.PixelFormat);
if nPixelSize < 4 then
    nPixelSize := 4
else if nPixelSize = 4 then
    inc(nPixelSize)
else if nPixelSize > 7 then
    nPixelSize := 7;
Dest.PixelFormat := TPixelFormat(nPixelSize);
nPixelSize := nPixelSize - 3;
for i := 0 to dh do
begin
    pDest := Dest.ScanLine[i];
    y := i * sh div dh;
    N := dh - i * sh mod dh;
    pLinePrev := Src.ScanLine[y];
    Inc(y);
    if N = dh then
      pLineNext := pLinePrev
    else
      pLineNext := Src.ScanLine[y];
    for j := 0 to dw do
    begin
      x := j * sw div dw * nPixelSize;
      B := dw - j * sw mod dw;
      pA := pLinePrev;
      Inc(pA, x);
      pB := pA;
      Inc(pB, nPixelSize);
      pC := pLineNext;
      Inc(pC, x);
      pD := pC;
      Inc(pD, nPixelSize);
      if B = dw then begin
        pB := pA;
        pD := pC;
      end;
      for k := 0 to nPixelSize -1 do
      begin
        pDest^ := Byte(DWord( (B * N * DWord(pA^ - pB^ - pC^ + pD^) + dw * N * pB^
                              + dh * B * pC^ + (dw * dh - dh * B - dw * N)* pD^
                              + dw * dh div 2) div (dw * dh) ));
        Inc(pDest);
        Inc(pA);
        Inc(pB);
        Inc(pC);
        Inc(pD);
      end;
    end;
end;
end;