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;