Nearest Neighbor、Bilinear、Bicubic算法的Delp…
2008-04-09 04:20:47来源:互联网 阅读 ()
unit BitmapResize;
interface
uses
Windows, Classes, SysUtils, Graphics;
const PixelCountMax = 32768;
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array [0..PixelCountMax - 1] of TRGBTriple;
procedure ResizeBicubic(Src: TBitmap; var Dest: TBitmap;
DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
procedure ResizeBilinear(Src: TBitmap; var Dest: TBitmap;
DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
procedure ResizeNearestNeighbor(Src: TBitmap; var Dest: TBitmap;
DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
implementation
function Sinc(x: double): double;
begin
if abs(x) < 1 then
Result := 1 - 2 * x * x x * x * abs(x)
else if (abs(x) >= 1) and (abs(x) < 2) then
Result := 4 - 8 * abs(x) 5 * x * x - x * x * abs(x)
else Result := 0;
end;
procedure Bicubic(I1, I2, I3, I4: TRGBTriple; var New: TRGBTriple; u: double);
var
t: integer;
begin
t := trunc(I1.rgbtRed * Sinc(u 1) I2.rgbtRed
* Sinc(u) I3.rgbtRed * Sinc(u - 1) I4.rgbtRed * Sinc(u - 2));
if t > 255 then t := 255;
if t < 0 then t := 0;
New.rgbtRed := Byte(t);
t := trunc(I1.rgbtGreen * Sinc(u 1) I2.rgbtGreen
* Sinc(u) I3.rgbtGreen * Sinc(u - 1) I4.rgbtGreen * Sinc(u - 2));
if t > 255 then t := 255;
if t < 0 then t := 0;
New.rgbtGreen := Byte(t);
t := trunc(I1.rgbtBlue * Sinc(u 1) I2.rgbtBlue
* Sinc(u) I3.rgbtBlue * Sinc(u - 1) I4.rgbtBlue * Sinc(u - 2));
if t > 255 then t := 255;
if t < 0 then t := 0;
New.rgbtBlue := Byte(t);
end;
procedure ResizeBicubic(Src: TBitmap; var Dest: TBitmap;
DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
var
hScale, wScale: double;
f1, f2, f3, f4, fNew: TRGBTriple;
temp1, temp2, temp3, temp4, tempDst: PRGBTripleArray;
x, y, u, v: double;
x1, x2, x3, x4, y1, y2, y3, y4, i, j, tempRGB: integer;
begin
Dest := TBitmap.Create;
Dest.PixelFormat := pf24Bit;
Dest.Width := DestWidth;
Dest.Height := DestHeight;
Src.PixelFormat := pf24Bit;
Src.Width := SrcWidth;
Src.Height := SrcHeight;
hScale := DestHeight / SrcHeight;
wScale := DestWidth / SrcWidth;
for i := 0 to DestHeight - 1 do
begin
x := i / hScale;
x2 := trunc(x);
x1 := x2 - 1;
x3 := x2 1;
x4 := x2 2;
if x1 < 0 then x1 := 0;
if x3 > SrcHeight - 1 then x3 := SrcHeight - 1;
if x4 > SrcHeight - 1 then x4 := SrcHeight - 1;
temp1 := Src.ScanLine[x1];
temp2 := Src.ScanLine[x2];
temp3 := Src.ScanLine[x3];
temp4 := Src.ScanLine[x4];
tempDst := Dest.ScanLine[i];
v := x - x2;
for j := 0 to DestWidth - 1 do
begin
y := j / wScale;
y2 := trunc(y);
y1 := y2 - 1;
y3 := y2 1;
y4 := y2 2;
if y1 < 0 then y1 := 0;
if y3 > SrcWidth - 1 then y3 := SrcWidth - 1;
if y4 > SrcWidth - 1 then y4 := SrcWidth - 1;
u := y - y2;
Bicubic(temp1^[y1], temp1^[y2], temp1^[y3], temp1^[y4], f1, u);
Bicubic(temp2^[y1], temp2^[y2], temp2^[y3], temp2^[y4], f2, u);
Bicubic(temp3^[y1], temp3^[y2], temp3^[y3], temp3^[y4], f3, u);
Bicubic(temp4^[y1], temp4^[y2], temp4^[y3], temp4^[y4], f4, u);
Bicubic(f1, f2, f3, f4, fNew, v);
tempDst^[j] := fNew;
end;
end;
end;
procedure ResizeBilinear(Src: TBitmap; var Dest: TBitmap;
DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
var
hScale, wScale: double;
f1, f2, f3, f4, f12, f34, fNew: TRGBTriple;
temp1, temp2, tempDst: PRGBTripleArray;
x, y: double;
x1, x2, y1, y2, i, j: integer;
begin
Dest := TBitmap.Create;
Dest.PixelFormat := pf24Bit;
Dest.Width := DestWidth;
Dest.Height := DestHeight;
Src.PixelFormat := pf24Bit;
Src.Width := SrcWidth;
Src.Height := SrcHeight;
hScale := DestHeight / SrcHeight;
wScale := DestWidth / SrcWidth;
for i := 0 to DestHeight - 1 do
begin
x := i / hScale;
x1 := trunc(x);
x2 := x1 1;
if x2 > SrcHeight - 1 then x2 := SrcHeight - 1;
temp1 := Src.ScanLine[x1];
temp2 := Src.ScanLine[x2];
tempDst := Dest.ScanLine[i];
for j := 0 to DestWidth - 1 do
begin
y := j / wScale;
y1 := trunc(y);
y2 := y1 1;
if y2 > SrcWidth - 1 then y2 := SrcWidth - 1;
f1 := temp1^[y1];
f2 := temp1^[y2];
f3 := temp2^[y1];
f4 := temp2^[y2];
f12.rgbtRed := trunc(f1.rgbtRed (y - y1) * (f2.rgbtRed - f1.rgbtRed));
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash