图像缩放处理（急）(30分)

请问各位大侠
怎样控制图片的放大和缩小
要求是按比例缩放
马上就用
着急
请指点
分少再加

用image控件并设置一下它的Stretch、with、height属性。[]

hsoft说的对。
如打算更复杂些处理，可安装第三方控件，如ImageEN。

stretchblt

up

to 农夫
在哪有imageEN控件
wshxian@sohu.com
谢谢了

http://bluemoon.myrice.com/efg/index.htm
http://www.efg2.com/Lab/index.html
去这两个地方看看 图形图像

假如不用控件
还有什么方法
请给位高手指点一下
最好能给出一个例子或者代码
谢谢了

呵呵，看看吧,离线数据库找得！
话题247022的标题是： 如何实现ACDsee扩大缩小的效果? (50分)
分类：图形图象 zxy2405 (2000-5-17 17:15:00)
我在form上放了一个panel，在上面放了Image,由于导入的图片比较大，我想
让图片象ACDsee那样按下某一键之后的等量的扩大缩小，该怎么做?Image属性
的width,clientwidth,picture.width,picture.bimap.width,有什么区别？
50分.Email:zxyfd2000@sina.com






cat.yy (2000-8-3 17:57:00)
我提供一个方法（我编过），是用image 框的缩放实现的，控制简单
我说说基本原理：

1. image有个strech属性，将它设为true

2. 计算出将要加载图片的大小，
调整image的尺寸，让它的长宽的比例 = 图片的长宽比例，把这个<b>比例尺</b>
保存到一个全局变量中

3. pannel与form 的缩放也要用到这个比例尺

我这儿有原代码，功能多了点（有图象的缩放，
画图(添/删)，和 编辑过图象的存储/打开）：
（程序基本写完，
有<b>bug</b>请<b><i>MAIL</i></b>我----catyy1101@yeah.net）
--------窗体文件---------------------------------
object Form1: TForm1
Left = 252
Top = 157
Width = 449
Height = 276
Caption = 'Form1'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -18
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 120
TextHeight = 18
object Panel1: TPanel
Left = 0
Top = 0
Width = 441
Height = 41
Align = alTop
TabOrder = 0
object sp_s: TSpeedButton
Left = 152
Top = 8
Width = 23
Height = 22
Hint = '缩小图象'
Caption = '缩'
ParentShowHint = False
ShowHint = True
OnClick = sp_sClick
end
object sp_us: TSpeedButton
Left = 176
Top = 8
Width = 23
Height = 22
Hint = '放大图象'
Caption = '放'
ParentShowHint = False
ShowHint = True
OnClick = sp_usClick
end
object sp_add: TSpeedButton
Left = 288
Top = 8
Width = 23
Height = 22
Hint = '做一次“编辑”'
Caption = '添'
ParentShowHint = False
ShowHint = True
OnClick = sp_addClick
end
object sp_del: TSpeedButton
Left = 312
Top = 8
Width = 23
Height = 22
Hint = '删除一个“编辑”'
Caption = '删'
ParentShowHint = False
ShowHint = True
OnClick = sp_delClick
end
object sp_save: TSpeedButton
Left = 16
Top = 8
Width = 23
Height = 22
Hint = '存储编辑过的图象'
Caption = '包'
ParentShowHint = False
ShowHint = True
OnClick = sp_saveClick
end
object sp_open: TSpeedButton
Left = 40
Top = 8
Width = 23
Height = 22
Hint = '打开已编辑的图象'
Caption = '解'
ParentShowHint = False
ShowHint = True
OnClick = sp_openClick
end
object sp_read: TSpeedButton
Left = 112
Top = 8
Width = 23
Height = 22
Caption = '读'
ParentShowHint = False
ShowHint = True
OnClick = sp_readClick
end
object sp_search: TSpeedButton
Left = 352
Top = 8
Width = 23
Height = 22
Hint = '?'
Caption = '查'
ParentShowHint = False
ShowHint = True
end
object sp_fit: TSpeedButton
Left = 216
Top = 8
Width = 23
Height = 22
Hint = '缩放图象到合适的大小'
Caption = '适'
ParentShowHint = False
ShowHint = True
OnClick = sp_fitClick
end
end
object Panel2: TPanel
Left = 0
Top = 41
Width = 441
Height = 189
Align = alClient
BevelInner = bvLowered
Color = clWindowFrame
TabOrder = 1
object Image1: TImage
Left = 34
Top = 2
Width = 327
Height = 177
Stretch = True
OnMouseDown = Image1MouseDown
end
object Memo1: TMemo
Left = 248
Top = 72
Width = 185
Height = 89
TabOrder = 0
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 230
Width = 441
Height = 19
Panels = <>
SimplePanel = False
end
object SaveDialog1: TSaveDialog
DefaultExt = 'cty'
Filter = '可编辑Bitmap/JPEG图象(*.cty)|*.cty'
Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]
Left = 376
Top = 48
end
object OpenDialog1: TOpenDialog
Left = 408
Top = 48
end
end
---------------------------------------------------------------
---------单元文件----------------------------------------------
unit Unit_image_II;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Buttons, StdCtrls, ExtDlgs, ComCtrls, Grids;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
sp_s: TSpeedButton;
sp_us: TSpeedButton;
sp_add: TSpeedButton;
sp_del: TSpeedButton;
sp_save: TSpeedButton;
sp_open: TSpeedButton;
sp_read: TSpeedButton;
StatusBar1: TStatusBar;
sp_search: TSpeedButton;
Memo1: TMemo;
sp_fit: TSpeedButton;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure sp_sClick(Sender: TObject);
procedure sp_usClick(Sender: TObject);
procedure sp_readClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sp_addClick(Sender: TObject);
procedure sp_saveClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure sp_fitClick(Sender: TObject);
procedure sp_delClick(Sender: TObject);
procedure sp_openClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
cat_add:string;
rule_1:integer; //用做分子
rule_2:integer; //用做分母
open_filename:string;
save_edit:boolean;
save_edit_II:boolean;
add_Number:integer;
x1,y1:integer;
{ Private declarations }
public
function int_from_div(aNum:real):integer;
procedure load_picture_size;
procedure where_show_picture;
procedure show_picture_fit_size;
procedure show_picture_window_size;
procedure show_picture_window_size_II;
procedure where_the_Form;
procedure mouse_fit_button;
procedure suoxiao;
procedure fangda;
procedure Draw_Picture_ASaveACount(xx,yy:integer);
procedure mouse_catch(xx,yy:integer);
procedure load_FromFile_AndDraw;//(ss:string);
procedure save_DB;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

//~~ 将商取整，返回值为integer 型
function TForm1.int_from_div(aNum:real):integer;
var aa1:string;
begin
aa1 :=floattostr(int(aNum)); //div 是整数除，
result :=strtoint(aa1); //mod 是整数余
end;

//~~ 将加载图片的尺寸赋给 image1
procedure TForm1.load_picture_size;
begin
image1.Height :=image1.Picture.Height;
image1.Width :=image1.Picture.Width;
end;

//~~ 显示图片的位置（左上点坐标）
//.. 要调用int_from_div()
procedure TForm1.where_show_picture;
begin
if image1.width<Panel2.Width then
image1.Left :=int_from_div((panel2.Width-image1.Width)div 2) //~~
else
image1.Left :=4;
//
if image1.Height<panel2.Height then
image1.Top :=int_from_div(int((panel2.Height-image1.Height)div 2)) //~~
else
image1.Top :=4;
end;

//~~ 以合适的尺寸显示整个图片
procedure TForm1.show_picture_fit_size;
var
aa01,aa02:integer;
pp01,pp02:integer;
begin
aa01 := image1.Picture.Height;
aa02 := image1.Picture.Width;
// showmessage('h:'+inttostr(aa01)+' w:'+inttostr(aa02));
pp01 := screen.Height - 100; //去除窗口边框的高度
pp02 := screen.Width - 16; //去除窗口边框的宽度
if aa01 * pp02 / aa02 / pp01 - 1 > 0 then
if aa01 > pp01 then //图片高度较大
begin
image1.Height := pp01;
image1.Width := int_from_div(aa02 * pp01 div aa01);
//
form1.Left := 0; /////////////
form1.Top := 0; /////////////
form1.Height := screen.Height;// image1.Height + 100; /////////////
form1.Width := screen.Width;//image1.Width + 16; /////////////
//
rule_1 := pp01;
rule_2 := aa01;
end else begin
load_picture_size;
end;
if aa01 * pp02 / aa02 / pp01 - 1 < 0 then
if aa02 >pp02 then
begin
image1.Width := pp02;
image1.Height := int_from_div(aa01 * pp02 div aa02);
form1.Left := 0; /////////////
form1.Top := 0; /////////////
form1.Height := image1.Height + 100; /////////////
form1.Width := image1.Width + 16; /////////////
//
rule_1 := pp02;
rule_2 := aa02;
end else begin
load_picture_size;
end;
if aa01 / aa02 = pp01 / pp02 then
begin
if aa01 > pp01 then
begin
image1.Height := pp01;
image1.Width := pp02;
form1.Left := 0; /////////////
form1.Top := 0; /////////////
form1.Height := screen.Height;//image1.Height + 100; ////////////
form1.Width := screen.Width;//image1.Width + 16; ////////////
//
rule_1 := pp01;
rule_2 := aa01;
end else begin
load_picture_size; // ~~
form1.Height := image1.Height + 100; ////////////
form1.Width := image1.Width + 16; ////////////
//
rule_1 := 1;
rule_2 := 1;
end;
end;
end;

//~~ 窗口适应图片的大小 （窗口 < 图片时） 图片在窗口上的位置
procedure TForm1.show_picture_window_size;
begin
if not(image1.width+ 8< panel2.Width) then
Form1.Width :=image1.Width +16; //image 到 form 边框宽-象素
if not(image1.Height+ 8< panel2.Height) then
Form1.Height :=image1.Height +100; //image 到 form 边框高-象素
end;
//~~ 窗口适应图片的大小 （窗口 >> 图片时） 图片在窗口上的位置
procedure TForm1.show_picture_window_size_II;
begin
if (form1.width>449)and(form1.Height>276) then
begin
form1.Width :=image1.Width+16; //image 到 form 边框宽-象素
form1.Height :=image1.Height+100; //image 到 form 边框高-象素
end;
if (form1.width>449)and(not(form1.Height>276)) then
form1.Width :=image1.Width+16;
if (not(form1.width>449))and(form1.Height>276) then
form1.Height :=image1.Height+100;
end;

//~~ 窗口在屏幕上的位置
procedure TForm1.Where_the_Form; ///////////////////
begin
{ if screen.width>form1.Width then
form1.Left :=int_from_div((screen.Width-form1.Width) div 2)
else
form1.Left :=0;
if screen.Height>form1.Width then
form1.Top :=int_from_div((screen.Height-form1.Height) div 2)
else
form1.Top :=0;
}
end;

//~~
procedure TForm1.mouse_fit_button;
begin
//?
end;

//~~ 缩小显示的图象
procedure TForm1.suoxiao;
begin
image1.Width := int_from_div((image1.Width div 3)*2); //~~
image1.Height := int_from_div((image1.Height div 3)*2); //~~
//
rule_1 := rule_1 * 2; //比例尺-分子
rule_2 := rule_2 * 3; //比例尺-分母
end;

//~~ 放大显示图象
procedure TForm1.fangda;
begin
image1.width :=int_from_div((image1.Width div 2)*3);
image1.Height :=int_from_div((image1.Height div 2)*3); //~~
//
rule_1 := rule_1 * 3; //比例尺-分子
rule_2 := rule_2 * 2; //比例尺-分母
end;

//~~ 画图模块
procedure Tform1.Draw_Picture_ASaveACount(xx,yy:integer);
var ss:string;
begin
image1.Canvas.Pen.Mode := pmNot;
image1.Canvas.Brush.Style := bsCross;
xx := int_from_div(xx * rule_2 div rule_1);
yy := int_from_div(yy * rule_2 div rule_1);
// image1.canvas.Ellipse(xx-11,yy-11,xx+11+1,yy+11+1);
//
if not((xx=x1)and(yy=y1)) then
begin //这种判断机智不好
x1 := xx;
y1 := yy;
image1.canvas.Ellipse(xx-11,yy-11,xx+11+1,yy+11+1);
add_number := add_number+1;
ss := inttostr(xx)+'^'+inttostr(yy)+'^'+inttostr(add_number);
Memo1.Lines.Add(ss); //将数据存档
end else
if (xx=x1)and(yy=y1) then
Application.MessageBox('无法在当前位置再画图...','',mb_ok+mb_iconStop);
end;

//~~ 捕捉鼠标选中的图
procedure TForm1.mouse_catch(xx,yy:integer);
var
aa,bb:integer;
cc:integer; //用做随机指定圆半径----没什么用！
ss:string;
cat_x,cat_y:integer;
label
ppp;
begin
xx := xx * rule_2 div rule_1; // 比例尺，调整鼠标坐标
yy := yy * rule_2 div rule_1; // 比例尺，调整鼠标坐标
// xx := int_from_div(xx * rule_2 div rule_1); // 比例尺，调整鼠标坐标
// yy := int_from_div(yy * rule_2 div rule_1); // 比例尺，调整鼠标坐标
//
aa := 1;
while aa<Memo1.Lines.Count do //////////?
begin
{ ss := Memo1.Lines[aa];
bb := AnsiPos('^',ss);
cat_x := strtoint(copy(ss,1,bb-1)); //
ss := copy(ss,bb+1,Length(ss)-bb);
cat_y := strtoint(ss); //
} //
ss := Memo1.Lines[aa];
bb := AnsiPos('^',ss);
cat_x := strtoint(copy(ss,1,bb-1)); //
ss := copy(ss,bb+1,Length(ss)-bb);
bb := AnsiPos('^',ss);
cat_y := strtoint(copy(ss,1,bb-1)); //
//
cc := 11; //圆的半径
if ((cat_x-cc <= xx)and(xx <= cat_x+cc))
and((cat_y-cc <= yy)and(yy <= cat_y+cc)) then
begin
image1.Canvas.Pen.Mode := pmNot;
image1.canvas.Ellipse(cat_x-cc,cat_y-cc,cat_x+cc+1,cat_y+cc+1);
//
Memo1.Lines.Delete(aa); //删除memo1 中的该记录
goto ppp;
end;
//
aa := aa+1;
end;
ppp:
end;

//~~ 加载时依文件画图
procedure TForm1.load_FromFile_AndDraw;//(ss:string);
var
aa,bb:integer;
cat_x,cat_y:integer;
ss:string;
begin
image1.Visible := false; //初始化-加载图片到image1框
Image1.Picture.LoadFromFile(Memo1.Lines[0]);
load_picture_size; //~~ 将加载图片的尺寸赋给 image1
where_show_picture; //~~ 显示图片的位置（左上点坐标）
show_picture_window_size; //~~
// image1.Height := image1.Picture.Height;
// image1.Width := image1.Picture.Width;
image1.Visible := true;
//
show_picture_fit_size; //~~
where_show_picture; //~~
//
aa := 1;
while aa<Memo1.Lines.Count do
begin
ss := Memo1.Lines[aa];
bb := AnsiPos('^',ss);
cat_x := strtoint(copy(ss,1,bb-1)); //
ss := copy(ss,bb+1,Length(ss)-bb);
bb := AnsiPos('^',ss);
cat_y := strtoint(copy(ss,1,bb-1)); //
//
image1.Canvas.Pen.Mode := pmNot;
image1.Canvas.Brush.Style := bsCross;
image1.canvas.Ellipse(cat_x-11,cat_y-11,cat_x+11+1,cat_y+11+1);
//
aa := aa+1;
end;
end;

//~~ 将画图数据存入文件
//MEMO1 中的 数据格式为（以圆为例）：
// （圆心 x 值，圆心 y 值，半径 r 值）
procedure TForm1.save_DB;
begin
if Memo1.Lines.Text = '' then
Application.MessageBox('当前没有可编辑的图象，不能存储。'
,'存储错误',mb_ok+mb_IconStop)
else begin
// ? := inputBox('caption文本','label文本','EditPicture.cty');
// 保存在系统.EXE当前目录下
saveDialog1.Title := '保存';
if not(open_filename='') then
saveDialog1.FileName := open_filename;

if SaveDialog1.Execute then
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;

//--------------

procedure TForm1.sp_sClick(Sender: TObject); //缩小
begin
if not((image1.width<18)or(image1.Height<18)) then
begin
Where_the_Form; //~~
//
image1.Visible :=false;
suoxiao; //~~
show_picture_window_size_II; //~~
where_show_picture; //~~
image1.Visible :=true;
end;
end;

procedure TForm1.sp_usClick(Sender: TObject); //放大
begin
Where_the_Form; //~~
//
image1.Visible :=true;
fangda; //~~
where_show_picture; //~~
show_picture_window_size; //~~
image1.Visible :=true;
end;

procedure TForm1.sp_readClick(Sender: TObject);
var aa:string;
label ppp;
begin
if (save_edit=false)and(save_edit_II=true) then
if Application.MessageBox('您编辑的图象没有保存,现在保存？'
,'',mb_YesNo+mb_DefButton1+mb_iconExclamation) = idNo then
begin
Memo1.Lines.Clear;
save_edit := false;
end else
goto ppp;
//
image1.Visible :=false; //初始化（复位）image1的属性
image1.Cursor :=crDefault; //
//
OpenDialog1.Filter :='BMP|*.bmp|JPG|*.jpg';//|All Files|*.*';
OpenDialog1.filename := '';
if (OpenDialog1.Execute=true) then
begin
aa := OpenDialog1.FileName;
//
Memo1.Lines.Add(aa);
//
image1.Picture.LoadFromFile(aa);
load_picture_size; //~~ 将加载图片的尺寸赋给 image1
where_show_picture; //~~ 显示图片的位置（左上点坐标）
show_picture_window_size; //~~
//
image1.Visible :=true;
end;
if (image1.Picture.width>Panel2.Width)
or(image1.Picture.Height>panel2.Height) then
image1.Cursor :=crHandPoint; // 从资源文件中调用 copy(aa1,1,length(aa1))
//
{ image2.Width := image1.Width;
image2.Height := image1.Height;
image2.Left := image1.Left;
image2.Top := image1.Top;
image2.Enabled := true; }
ppp:
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
cat_add := '';
rule_1 := 1;
rule_2 := 1;
open_filename := '';
save_edit := false; //检测是否保存了编辑的图象(保存=true)
save_edit_II := false; //检测是否没有打开编辑的图象（打开=true）
add_number := 0; //计数器-添加了几个图
x1 := 0;
y1 := 0;
//
Memo1.Visible := false;
Memo1.ScrollBars := ssHorizontal;
//
// image1.Canvas.Brush.Style := bsCross; //初始化填充模式
// 点击文件打开EXE 的处理
// ？？
end;

procedure TForm1.sp_addClick(Sender: TObject);
begin
if (image1.Width <= 18)or(image1.Height <= 18) then
Application.MessageBox('图片的长度或宽度不够，不能完成添加。'
,'添加信息',mb_ok+mb_iconInformation)
else
cat_add := 'true';
end;

procedure TForm1.sp_saveClick(Sender: TObject);
begin
save_DB; //~~
save_edit := true;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if cat_add='true' then
begin
draw_picture_ASaveACount(x,y); //~~ 调用画图模块
// if cat_add='true' then
// add_number := add_number+1;
end;
if cat_add='false' then
mouse_catch(x,y); //~~ 捕捉鼠标选中哪个图
end;

procedure TForm1.sp_fitClick(Sender: TObject);
begin
show_picture_fit_size; //~~
where_show_picture; //~~
end;

procedure TForm1.sp_delClick(Sender: TObject);
begin
cat_add := 'false';
end;

procedure TForm1.sp_openClick(Sender: TObject);
begin
OpenDialog1.DefaultExt := 'cty';
OpenDialog1.Filter := '可编辑Bitmap/JPEG图象(*.cty)|*.cty';
OpenDialog1.Title := '';
if OpenDialog1.Execute then
begin
open_filename := OpenDialog1.FileName;
Memo1.Lines.LoadFromFile(Open_FileName);
end;
//
load_FromFile_AndDraw; //~~
save_edit := false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if memo1.Lines.Count=1 then
if Application.MessageBox('您撤消了对这副图的所有编辑删除它吗？'
,'',mb_yesNo+mb_defButton1+mb_iconInformation)=idyes then
begin
deletefile(open_filename);
end else
if saveDialog1.Execute then
Memo1.Lines.SaveToFile(savedialog1.FileName);
end;

end.
--------------------------------------------------------------
-------使用说明-----------------------------------------------
“读”--- 打开一个图片
“包”--- 将编辑过的图片保存成文件（扩展名--.cty）
“解”--- 打开一个编辑过的.cty 文件
“添”--- 在图片上画一个圈
“删”--- 删除图片上的一个圈
“缩”--- 缩小图片为原来的 66.7%
“放”--- 放大图片为原来的 1.5 倍
“适”--- 让图片以适应的大小显示
----------------------------------------------------------------
* * 我的显示分辨率是1024*768 其他分辨率还没测试过。
用delphi 5 编的，在win 98 下测试通过。


<font size=5> 才50分 ！</font>

heat (2000-8-18 22:50:00)
1.获取图象width和height信息,set tg=width div height
2.TImage的Strech=false,Autosize=true
3.load picture
4.TImage的Strech=true,Autosize=false
5.by changeing TImageis size to carry out picture's zoom
operation according to Image.width div Timage.height:=tag

我现在正在看一个GraphicEx的库，里面有图像缩小的算法，速度很快，比Acdsee也慢不
了多少，你去Google里面找这个词，下面是缩放代码：
不过滤镜的函数没有给你拷，他那都有，是有源代码的。
procedure DoStretch(Filter: TFilterFunction; Radius: Single; Source, Target: TBitmap);

// This is the actual scaling routine. Target must be allocated already with sufficient size. Source must
// contain valid data, Radius must not be 0 and Filter must not be nil.

var
ScaleX,
ScaleY: Single; // Zoom scale factors
I, J,
K, N: Integer; // Loop variables
Center: Single; // Filter calculation variables
Width: Single;
Weight: Integer; // Filter calculation variables
Left,
Right: Integer; // Filter calculation variables
Work: TBitmap;
ContributorList: TContributorList;
SourceLine,
DestLine: PPixelArray;
DestPixel: PBGR;
Delta,
DestDelta: Integer;
SourceHeight,
SourceWidth,
TargetHeight,
TargetWidth: Integer;

begin
// shortcut variables
SourceHeight := Source.Height;
SourceWidth := Source.Width;
TargetHeight := Target.Height;
TargetWidth := Target.Width;

if (SourceHeight = 0) or (SourceWidth = 0) or
(TargetHeight = 0) or (TargetWidth = 0) then Exit;

// create intermediate image to hold horizontal zoom
Work := TBitmap.Create;
try
Work.PixelFormat := pf24Bit;
Work.Height := SourceHeight;
Work.Width := TargetWidth;
if SourceWidth = 1 then ScaleX := TargetWidth / SourceWidth
else ScaleX := (TargetWidth - 1) / (SourceWidth - 1);
if (SourceHeight = 1) or (TargetHeight = 1) then ScaleY := TargetHeight / SourceHeight
else ScaleY := (TargetHeight - 1) / (SourceHeight - 1);

// pre-calculate filter contributions for a row
SetLength(ContributorList, TargetWidth);
// horizontal sub-sampling
if ScaleX < 1 then
begin
// scales from bigger to smaller Width
Width := Radius / ScaleX;
for I := 0 to TargetWidth - 1 do
begin
ContributorList.N := 0;
SetLength(ContributorList.Contributors, Trunc(2 * Width + 1));
Center := I / ScaleX;
Left := Floor(Center - Width);
Right := Ceil(Center + Width);
for J := Left to Right do
begin
Weight := Round(Filter((Center - J) * ScaleX) * ScaleX * 256);
if Weight <> 0 then
begin
if J < 0 then N := -J
else
if J >= SourceWidth then N := SourceWidth - J + SourceWidth - 1
else N := J;
K := ContributorList.N;
Inc(ContributorList.N);
ContributorList.Contributors[K].Pixel := N;
ContributorList.Contributors[K].Weight := Weight;
end;
end;
end;
end
else
begin
// horizontal super-sampling
// scales from smaller to bigger Width
for I := 0 to TargetWidth - 1 do
begin
ContributorList.N := 0;
SetLength(ContributorList.Contributors, Trunc(2 * Radius + 1));
Center := I / ScaleX;
Left := Floor(Center - Radius);
Right := Ceil(Center + Radius);
for J := Left to Right do
begin
Weight := Round(Filter(Center - J) * 256);
if Weight <> 0 then
begin
if J < 0 then N := -J
else
if J >= SourceWidth then N := SourceWidth - J + SourceWidth - 1
else N := J;
K := ContributorList.N;
Inc(ContributorList.N);
ContributorList.Contributors[K].Pixel := N;
ContributorList.Contributors[K].Weight := Weight;
end;
end;
end;
end;

// now apply filter to sample horizontally from Src to Work
SetLength(CurrentLineR, SourceWidth);
SetLength(CurrentLineG, SourceWidth);
SetLength(CurrentLineB, SourceWidth);
for K := 0 to SourceHeight - 1 do
begin
SourceLine := Source.ScanLine[K];
FillLineChache(SourceWidth, 3, SourceLine);
DestPixel := Work.ScanLine[K];
for I := 0 to TargetWidth - 1 do
with ContributorList do
begin
DestPixel^ := ApplyContributors(N, ContributorList.Contributors);
// move on to next column
Inc(DestPixel);
end;
end;

// free the memory allocated for horizontal filter weights, since we need the stucture again
for I := 0 to TargetWidth - 1 do ContributorList.Contributors := nil;
ContributorList := nil;

// pre-calculate filter contributions for a column
SetLength(ContributorList, TargetHeight);
// vertical sub-sampling
if ScaleY < 1 then
begin
// scales from bigger to smaller height
Width := Radius / ScaleY;
for I := 0 to TargetHeight - 1 do
begin
ContributorList.N := 0;
SetLength(ContributorList.Contributors, Trunc(2 * Width + 1));
Center := I / ScaleY;
Left := Floor(Center - Width);
Right := Ceil(Center + Width);
for J := Left to Right do
begin
Weight := Round(Filter((Center - J) * ScaleY) * ScaleY * 256);
if Weight <> 0 then
begin
if J < 0 then N := -J
else
if J >= SourceHeight then N := SourceHeight - J + SourceHeight - 1
else N := J;
K := ContributorList.N;
Inc(ContributorList.N);
ContributorList.Contributors[K].Pixel := N;
ContributorList.Contributors[K].Weight := Weight;
end;
end;
end
end
else
begin
// vertical super-sampling
// scales from smaller to bigger height
for I := 0 to TargetHeight - 1 do
begin
ContributorList.N := 0;
SetLength(ContributorList.Contributors, Trunc(2 * Radius + 1));
Center := I / ScaleY;
Left := Floor(Center - Radius);
Right := Ceil(Center + Radius);
for J := Left to Right do
begin
Weight := Round(Filter(Center - J) * 256);
if Weight <> 0 then
begin
if J < 0 then N := -J
else
if J >= SourceHeight then N := SourceHeight - J + SourceHeight - 1
else N := J;
K := ContributorList.N;
Inc(ContributorList.N);
ContributorList.Contributors[K].Pixel := N;
ContributorList.Contributors[K].Weight := Weight;
end;
end;
end;
end;

// apply filter to sample vertically from Work to Target
SetLength(CurrentLineR, SourceHeight);
SetLength(CurrentLineG, SourceHeight);
SetLength(CurrentLineB, SourceHeight);


SourceLine := Work.ScanLine[0];
Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine);
DestLine := Target.ScanLine[0];
DestDelta := Integer(Target.ScanLine[1]) - Integer(DestLine);
for K := 0 to TargetWidth - 1 do
begin
DestPixel := Pointer(DestLine);
FillLineChache(SourceHeight, Delta, SourceLine);
for I := 0 to TargetHeight - 1 do
with ContributorList do
begin
DestPixel^ := ApplyContributors(N, ContributorList.Contributors);
Inc(Integer(DestPixel), DestDelta);
end;
Inc(SourceLine);
Inc(DestLine);
end;

// free the memory allocated for vertical filter weights
for I := 0 to TargetHeight - 1 do ContributorList.Contributors := nil;
// this one is done automatically on exit, but is here for completeness
ContributorList := nil;

finally
Work.Free;
CurrentLineR := nil;
CurrentLineG := nil;
CurrentLineB := nil;
end;
end;

http://www.51delphi.com/delphi/soft?type=图形图像
这几天好像不能下载，斑竹答复是服务器出问题，很快恢复。

再推荐一个：
http://www.delphi-gems.com/Graphics.php#GraphicEx

好的
谢谢了

http://bluemoon.myrice.com/efg/index.htm
http://www.efg2.com/Lab/index.html

接受了