寻求图象缩小失真小的代码！(2分)

寻求图象缩小失真小的代码！本质性缩小，可以按照一定比例的缩小，就象Photoshop的改变图象大小的功能！！

放大或缩小位图：
void __stdcall StretchBmp(Graphics::TBitmap *pBmp, int StretchToWidth, int StretchToHeight) {
int OldW = pBmp->Width;
int OldH = pBmp->Height;
::SetStretchBltMode(pBmp->Canvas->Handle, HALFTONE);
if(pBmp->Width>=StretchToWidth) { // 缩小
::StretchBlt(pBmp->Canvas->Handle,
0,
0,
StretchToWidth,
StretchToHeight,
pBmp->Canvas->Handle,
0,
0,
OldW,
OldH,
SRCCOPY);
pBmp->Width = StretchToWidth;
pBmp->Height = StretchToHeight;
}
else { // 放大
pBmp->Width = StretchToWidth;
pBmp->Height = StretchToHeight;
::StretchBlt(pBmp->Canvas->Handle,
0,
0,
StretchToWidth,
StretchToHeight,
pBmp->Canvas->Handle,
0,
0,
OldW,
OldH,
SRCCOPY);
}
SetBrushOrgEx(pBmp->Canvas->Handle, 0, 0, NULL);
bcb的，你改改，效果较好

楼上的代码只是Resize, 根本做不到不失真。
下面的SmoothResize应该就是你要的。试验过320*200的图像缩小到8*8还能看出原来的样子。
代码改自FastLib， 增加了透明背景的处理（透明色为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;

procedure SmoothResize(DestDC: HDC; dx, dy, dw, dh: Integer;
Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
procedure SmoothResize(Dest: TDIBBmp; Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
procedure TransBlt(destdc: HDC; dx, dy, dw, dh: Integer;
srcdc: HDC; sx, sy, sw, sh: Integer; c: Cardinal);
function NewDIBBmp(var bmp: TDIBBmp): HBITMAP;

implementation
function NewDIBBmp(var bmp: TDIBBmp): HBITMAP;
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:=bmp.w;
bmInfo.bmiHeader.biHeight:=bmp.h;
bmp.hbmp := createDIBSection(0, bminfo, DIB_RGB_COLORS, pointer(bmp.bits), 0, 0);
bmp.lbytes := ((W*24+31)shr 5)shl 2;
bmp.gap := bmp.w mod 4;
result := bmp.hbmp;
end;

procedure SmoothResize(DestDC: HDC; dx, dy, dw, dh: Integer;
Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
var
tmpdc: HDC;
tmp: TDIBBmp;
begin
if ((sw=dw) and (sh=dh)) or (dw<2) or (dh<2) or (sw<1) or (sh<1) then
transblt(destdc, dx, dy, dw, dh, bmp24.canvas.handle, sx, sy, sw, sh, transcolor)
else 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));
if integer(TransColor)<>clNone then
bitblt(tmpdc, 0, 0, dw, dh, destdc, dx, dy, SRCCOPY);
smoothResize(tmp, bmp24, sx, sy, sw, sh, transcolor);
bitblt(destdc, dx, dy, dw, dh, tmpdc, 0, 0, SRCCOPY);
deletedc(tmpdc);
deleteobject(tmp.hBmp);
end;
end;

procedure SmoothResize(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;
pcRGB;
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[Bmp24.Height-1-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 (integer(transcolor) <> clNone) and
(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 (integer(transcolor) <> clNone) and
(col2^.r=PRGB(@transcolor)^.b) and
(col2^.g=PRGB(@transcolor)^.g) and
(col2^.b=PRGB(@transcolor)^.r) then
col2 := pc;
if (integer(transcolor) <> clNone) and
(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;

function IsW2K: Boolean;
begin
result := (win32platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >=5);
end;

function IsW98: Boolean;
begin
result := (win32platform = VER_PLATFORM_WIN32_WINDOWS) and (
(Win32MajorVersion > 4) or (
(Win32MajorVersion=4) and (Win32MinorVersion>0)
));
end;

procedure TransBlt(destdc: HDC; dx, dy, dw, dh: Integer;
srcdc: HDC; sx, sy, sw, sh: Integer; c: Cardinal);
var
monodc: HDC;
monobmp: HBITMAP;
old: THandle;
begin
if isw2k or isw98 then
transparentblt(destdc, dx, dy, dw, dh, srcdc, sx, sy, sw, sh, c)
else begin
monodc := createcompatibledc(0);
monobmp := createbitmap(sw, sh, 1, 1, nil);
old := selectobject(monodc, monobmp);
setbkcolor(srcdc, c);
bitblt(monodc, 0, 0, sw, sh, srcdc, sx, sy, SRCCOPY);
transparentstretchblt(destdc, dx, dy, dw, dh, srcdc, sx, sy, sw, sh, monodc, 0, 0);
selectobject(monodc, old);
deleteobject(monobmp);
deletedc(monodc);
end;
end;

2分少了点

Another_eYes大侠出马？只有2分？太少了!hehe

分数是少了点，但是我总共资本有10分：） 等我有了再加。不过我觉得我很想和你交个朋友的。

怎么调用啊？怎样将我的IMAGE 的图片缩小？有没有小例子？

gz

程序中有几处错误，还要uses一些库文件，呵呵

需要怎么做啊，可以详详细点告诉我吗？

稍加改动的库文件：
unit stretch;

interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, ExtCtrls, StdCtrls;
type
TRGB = packed record
b, g, r: Byte;
end;
PRGB = ^TRGB;
TDIBBmp = record
hBmp: HBITMAP;
w, h: Integer;
gap, Lbytes: Integer;
Bits: PRGB;
end;

procedure SmoothResize(DestDC: HDC; dx, dy, dw, dh: Integer;
Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
procedure SmoothResize(Dest: TDIBBmp; Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
procedure TransBlt(destdc: HDC; dx, dy, dw, dh: Integer;
srcdc: HDC; sx, sy, sw, sh: Integer; c: Cardinal);
function NewDIBBmp(var bmp: TDIBBmp): HBITMAP;

implementation

function NewDIBBmp(var bmp: TDIBBmp): HBITMAP;
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 := bmp.w;
bmInfo.bmiHeader.biHeight := bmp.h;
bmp.hbmp := createDIBSection(0, bminfo, DIB_RGB_COLORS, pointer(bmp.bits), 0,
0);
bmp.lbytes := ((bmp.w * 24 + 31) shr 5) shl 2;
bmp.gap := bmp.w mod 4;
result := bmp.hbmp;
end;

procedure SmoothResize(DestDC: HDC; dx, dy, dw, dh: Integer;
Bmp24: TBitmap; sx, sy, sw, sh: Integer;
TransColor: Cardinal); overload;
var
tmpdc: HDC;
tmp: TDIBBmp;
begin
if ((sw = dw) and (sh = dh)) or (dw < 2) or (dh < 2) or (sw < 1) or (sh < 1)
then
transblt(destdc, dx, dy, dw, dh,bmp24.Canvas.handle,sx,sy,sw,sh,
transcolor)
else
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));
if integer(TransColor) <> clNone then
bitblt(tmpdc, 0, 0, dw, dh, destdc, dx, dy, SRCCOPY);
smoothResize(tmp, bmp24, sx, sy, sw, sh, transcolor);
bitblt(destdc, dx, dy, dw, dh, tmpdc, 0, 0, SRCCOPY);
deletedc(tmpdc);
deleteobject(tmp.hBmp);
end;
end;

procedure SmoothResize(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: PRGB;
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[Bmp24.Height - 1 - 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 (integer(transcolor) <> clNone) and
(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 (integer(transcolor) <> clNone) and
(col2^.r = PRGB(@transcolor)^.b) and
(col2^.g = PRGB(@transcolor)^.g) and
(col2^.b = PRGB(@transcolor)^.r) then
col2 := pc;
if (integer(transcolor) <> clNone) and
(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;

function IsW2K: Boolean;
begin
result := (win32platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >=
5);
end;

function IsW98: Boolean;
begin
result := (win32platform = VER_PLATFORM_WIN32_WINDOWS) and (
(Win32MajorVersion > 4) or (
(Win32MajorVersion = 4) and (Win32MinorVersion > 0)
));
end;

procedure TransBlt(destdc: HDC; dx, dy, dw, dh: Integer;
srcdc: HDC; sx, sy, sw, sh: Integer; c: Cardinal);
var
monodc: HDC;
monobmp: HBITMAP;
old: THandle;
begin
if isw2k or isw98 then
transparentblt(destdc, dx, dy, dw, dh, srcdc, sx, sy, sw, sh, c)
else
begin
monodc := createcompatibledc(0);
monobmp := createbitmap(sw, sh, 1, 1, nil);
old := selectobject(monodc, monobmp);
setbkcolor(srcdc, c);
bitblt(monodc, 0, 0, sw, sh, srcdc, sx, sy, SRCCOPY);
transparentstretchblt(destdc, dx, dy, dw, dh, srcdc, sx, sy, sw, sh,
monodc, 0, 0);
selectobject(monodc, old);
deleteobject(monobmp);
deletedc(monodc);
end;
end;

end.
使用的例子：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
bmp: TBITMAP;
ratio:Real;
implementation
uses stretch;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenPictureDialog1.Filter := '.bmp|*.bmp';
if OpenPictureDialog1.Execute then
begin
Image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
bmp := TBITMAP.Create;
bmp.PixelFormat := pf24bit;
bmp.Width := Image1.width div 2;
bmp.Height := Image1.Height div 2;
bmp.Assign(Image1.Picture.Bitmap);
ratio:=1;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);

begin
ratio:=ratio*0.5;
SmoothResize(IMAGE1.Picture.Bitmap.Canvas.Handle, 0, 0,Round(Image1.width *ratio),
Round(Image1.height *ratio),
bmp, 0, 0, bmp.width, bmp.height,
1);
// Image1.Canvas.Refresh;
Image1.Invalidate;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bmp.Free;
end;

end.

是建立一个stretch.pas 然后包含到工程文件吗？

怎么是一层一层往上面叠加的啊？我不需要叠加在上面，我要重新生成一个图片。

GZ

为什么没有人回答？

经过测试表示当把ratdio设置为0.3以下的时候打印的时候有黑边，对黑色部分处理不理想，
表现位有时候一个眼睛大一个眼睛小

用GDI+
将Graphics的InterpolationMode 设为 InterpolationModeHighQualityBilinear 或
InterpolationModeHighQualityBicubic 就可以平滑地缩放 Image对象了

用GDI+
将Graphics的InterpolationMode 设为 InterpolationModeHighQualityBilinear 或
InterpolationModeHighQualityBicubic 就可以平滑地缩放 Image对象了?

请问可以具体点吗？怎么用GDI+？？

看看下载的文档吧,虽然是C++的,但Delphi的包装很完善,参数都是一致的
文档中有缩放图片的例子
GDI+---->Using GDI+---->Using Images...---->Using Interpolation...

关注

关注