如何实现图像的平滑缩放 ( 积分: 300 )

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
image1.Picture.LoadFromFile('原图.bmp');
image3.Picture.LoadFromFile('Office Word缩放.bmp');
SetStretchBltMode(image2.Canvas.Handle,STRETCH_ANDSCANS);
image2.Canvas.StretchDraw(rect(0,0,image2.Width,image2.Height),image1.Picture.Bitmap);
image2.Picture.SaveToFile('TBitmap缩放.bmp');
end;
end.


对应的form
object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 416
Top = 32
Width = 760
Height = 591
AutoSize = True
end
object Image2: TImage
Left = 64
Top = 16
Width = 177
Height = 177
end
object Image3: TImage
Left = 64
Top = 232
Width = 177
Height = 177
end
object Label1: TLabel
Left = 16
Top = 24
Width = 39
Height = 13
Caption = 'TBitmap'
end
object Label2: TLabel
Left = 16
Top = 232
Width = 26
Height = 13
Caption = 'Word'
end
object Button1: TButton
Left = 280
Top = 288
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end

通过StretchDraw缩小的图片严重失真了，很不好看，但是通过word缩小的图片却很好看，如何实现word的缩放效果？

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
image1.Picture.LoadFromFile('原图.bmp');
image3.Picture.LoadFromFile('Office Word缩放.bmp');
SetStretchBltMode(image2.Canvas.Handle,STRETCH_ANDSCANS);
image2.Canvas.StretchDraw(rect(0,0,image2.Width,image2.Height),image1.Picture.Bitmap);
image2.Picture.SaveToFile('TBitmap缩放.bmp');
end;
end.


对应的form
object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 416
Top = 32
Width = 760
Height = 591
AutoSize = True
end
object Image2: TImage
Left = 64
Top = 16
Width = 177
Height = 177
end
object Image3: TImage
Left = 64
Top = 232
Width = 177
Height = 177
end
object Label1: TLabel
Left = 16
Top = 24
Width = 39
Height = 13
Caption = 'TBitmap'
end
object Label2: TLabel
Left = 16
Top = 232
Width = 26
Height = 13
Caption = 'Word'
end
object Button1: TButton
Left = 280
Top = 288
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end

通过StretchDraw缩小的图片严重失真了，很不好看，但是通过word缩小的图片却很好看，如何实现word的缩放效果？

SetStretchBltMode(image2.Canvas.Handle, HalfTone);

我第一个试的就是HalfTone，可是没有效果
下载http://www.17hot.net/zhangling/YuanTu.bmp 然后改名为 '原图.bmp'
这个是office word缩的http://www.17hot.net/zhangling/Office%20Word.bmp
然后改名为 'Office Word缩放.bmp'
你再运行我的程序，就可以看到效果了

或者下载压缩文件包
http://www.17hot.net/zhangling/pinghua.rar
YuanTu.bmp 太大了，1.3M，pinghua.rar压缩包只有70k

网上可以搜索到很多这类图像处理的算法的,
我试用过一个叫Graph32的东西, 可以满足你的需求

Graph32.OCX可惜不是windows自己带的，不过明天我也试试看

对不起, 我刚才记错了, 是Graphics32, 专门为Delphi或者CB写的有源码的控件...

如果你图片是1024*768的，只要缩放范围在这个之内，就不会失真，但是超过了就会失真了。

我的原图图片大小是不固定的，但是缩小的图片肯定是比原图小很多很多，用TBitmap通常的方法都会失真。
你可以下载 http://www.17hot.net/zhangling/pinghua.rar 看看

多人接受答案了。