我写过一个函数就是干这个的。
SmoothTransBlt
支持平滑缩放。 而且支持透明背景。速度还可以, 500*300图片50%显示用时27ms, 1000%用时1秒半。
提一句:参数中的TransColor是RGBColor, 不是TColor, 请将TColor用ColorToRGB转换成RGB后调用(一个特例, 如果不想透明的话直接传入TColor的clNone值即可)
type
TRGB = packed record
b, g, r: Byte;
end;
PRGB = ^TRGB;
TDIBBmp = record
hBmp: HBITMAP;
w, h: Integer;
gap, Lbytes: Integer;
Bits: PRGB;
end;
function NewDIBBmp(w, h: Integer; var bits: PRGB; var gap, retw: Integer): HBITMAP; overload;
function NewDIBBmp(var bmp: TDIBBmp): HBITMAP; overload;
procedure DestroyDIBBmp(var Bmp: TDIBBmp);
procedure SmoothTransBlt(DestDC: HDC; dx, dy, dw, dh: Integer;
Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
procedure SmoothTransBlt(Dest: TDIBBmp; Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
procedure SmoothBlt(DestDC: HDC; x, y: Integer; Bmp24: TBitmap; TransColor: Cardinal; Percent: Integer= 100);
implementation
function NewDIBBmp(var bmp: TDIBBmp): HBITMAP; overload;
begin
bmp.hbmp := newdibbmp(bmp.w, bmp.h, bmp.bits, bmp.gap, bmp.lbytes);
result := bmp.hbmp;
end;
function NewDIBBmp(w, h: Integer; var bits: PRGB; var gap, retw: Integer): HBITMAP; overload;
var
bmInfo: TBitmapInfo;
begin
bmInfo.bmiHeader.biSize:=SizeOf(TBitmapInfoHeader);
bmInfo.bmiHeader.biPlanes:=1;
bmInfo.bmiHeader.biBitCount:=24;
bmInfo.bmiHeader.biCompression:=BI_RGB;
bmInfo.bmiHeader.biWidth:=W;
bmInfo.bmiHeader.biHeight:=-H;
result := createDIBSection(0, bminfo, DIB_RGB_COLORS, pointer(bits), 0, 0);
retw := ((W*24+31)shr 5)shl 2;
gap := w mod 4;
end;
procedure SmoothTransBlt(DestDC: HDC; dx, dy, dw, dh: Integer;
Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
var
tmpdc: HDC;
tmp: TDIBBmp;
begin
if bmp24.PixelFormat <> pf24Bit then
bmp24.PixelFormat := pf24Bit;
tmp.w := dw;
tmp.h := dh;
newdibbmp(tmp);
tmpdc := createcompatibledc(0);
deleteobject(selectobject(tmpdc, tmp.hbmp));
bitblt(tmpdc, 0, 0, dw, dh, destdc, dx, dy, SRCCOPY);
smoothtransblt(tmp, bmp24, sx, sy, sw, sh, transcolor);
bitblt(destdc, dx, dy, dw, dh, tmpdc, 0, 0, SRCCOPY);
deletedc(tmpdc);
destroydibbmp(tmp);
end;
procedure SmoothTransBlt(Dest: TDIBBmp; Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
var
srcw: Integer;
x,y,xP,yP,
yP2,xP2: Integer;
Read,Read2: PRGB;
t,z,z2,iz2: Integer;
pc
RGB;
w1,w2,w3,w4: Integer;
Col1,Col2,
Col3, Col4: PRGB;
begin
srcw := ((bmp24.width*24+31)shr 5)shl 2;
xP2:=((sw-1)shl 15)div dest.w;
yP2:=((sh-1)shl 15)div dest.h;
yP:=0;
pc := dest.bits;
for y:=0 to dest.h-1 do
begin
xP:=0;
Read:=pointer(bmp24.scanline[yp shr 15 + sy]);
if yP shr 16<sh-1 then
Read2:=pointer(integer(read)-srcw)
else
Read2:=read;
z2:=yP and $7FFF;
iz2:=$8000-z2;
for x:=0 to dest.w-1 do
begin
t:=(xP shr 15)+sx;
Col1:=pointer(integer(read)+t*3);
if xp shr 15 < sw-1 then
col3 := pointer(integer(col1) +3)
else
col3 := col1;
if (integer(transcolor) <> clNone) and
(col1^.r=PRGB(@TransColor)^.b) and
(col1^.g=PRGB(@transcolor)^.g) and
(col1^.b=PRGB(@transcolor)^.r) then
col1 := pc;
if (col3^.r=PRGB(@transcolor)^.b) and
(col3^.g=PRGB(@transcolor)^.g) and
(col3^.b=PRGB(@transcolor)^.r) then
col3 := pc;
Col2:=pointer(integer(read2)+t*3);
col4 := pointer(integer(col2)+3);
if (col2^.r=PRGB(@transcolor)^.b) and
(col2^.g=PRGB(@transcolor)^.g) and
(col2^.b=PRGB(@transcolor)^.r) then
col2 := pc;
if (col4^.r=PRGB(@transcolor)^.b) and
(col4^.g=PRGB(@transcolor)^.g) and
(col4^.b=PRGB(@transcolor)^.r) then
col4 := pc;
z:=xP and $7FFF;
w2:=(z*iz2)shr 15;
w1:=iz2-w2;
w4:=(z*z2)shr 15;
w3:=z2-w4;
pc.b:=
(Col1^.b*w1+col3^.b*w2+
Col2^.b*w3+col4^.b*w4)shr 15;
pc.g:=
(Col1^.g*w1+col3^.g*w2+
Col2^.g*w3+col4^.g*w4)shr 15;
pc.r:=
(Col1^.r*w1+col3^.r*w2+
Col2^.r*w3+col4^.r*w4)shr 15;
Inc(pc);
Inc(xP,xP2);
end;
Inc(yP,yP2);
pc := pointer(integer(pc)+dest.gap);
end;
end;
procedure SmoothBlt(DestDC: HDC; x, y: Integer; Bmp24: TBitmap; TransColor: Cardinal; Percent: integer= 100);
var
w, h: Integer;
begin
w := round(bmp24.width * percent / 100);
h := round(bmp24.height * percent / 100);
smoothtransblt(destdc, x, y, w, h, bmp24, 0, 0, bmp24.width, bmp24.height, transcolor);
end;
procedure DestroyDIBBmp(var Bmp: TDIBBmp);
begin
if bmp.hBmp <> 0 then
begin
deleteobject(bmp.hbmp);
bmp.hbmp := 0;
bmp.w := 0;
bmp.h := 0;
bmp.gap := 0;
bmp.Lbytes := 0;
bmp.Bits := nil;
end;
end;