写一个图像慢慢切小的效果！或者百叶窗效果！我不想要第三方控件(100分)(100分)

如题有例子吗！
能给我吗！ableyang_china@163.net

在FORM上放一IMAGE控件在LOAD一张图片然后在BUTTON中如下所写
你再修修改改并不难,下面是一个图片的两边向中间的滑动效果
procedure TForm1.Button1Click(Sender: TObject);
var
newbmp:tbitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= tbitmap.create;
newbmp.width:=image1.width;
newbmp.height:=image1.height;
bmpheight:=image1.height;
bmpwidth:=image1.width;
i:=0;
while i<=bmpwidth do
begin
j:=i;
while j >0 do
begin
newbmp.canvas.copyrect(rect(j-1,0,j,bmpheight),
image1.canvas,
rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));
newbmp.canvas.copyrect(rect
(bmpwidth-j,0,bmpwidth-j+1,bmpheight),
image1.canvas,
rect(i-j,0,i-j+1,bmpheight));
j:=j-2;
end;
canvas.draw(2,10,newbmp);
i:=i+2;
end;
newbmp.free;
image1.Visible:=true;
end;

这里有几种特效
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
newbmp:Tbitmap;
i,bmpheight,bmpwidth:integer;
begin
newbmp:=TBitmap.Create;
newbmp.Width:=image1.Width ;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.width;
for i:=0 to bmpheight do
begin
newbmp.Canvas.CopyRect(Rect(0,bmpheight-i,bmpwidth,bmpheight),image1.Canvas,Rect(0,0,bmpwidth,i));
Form1.Canvas.Draw(0,0,newbmp);
end;
newbmp.free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
newbmp:TBitmap;
j,i,bmpheight,bmpwidth:integer;
begin
newbmp:=TBitmap.Create;
newbmp.Width :=image1.Width ;
newbmp.Height :=image1.Height ;
bmpheight:=image1.Height ;
bmpwidth:=image1.Width ;
for i:=bmpheight downto 1 do
for j:=1 to i do
begin
newbmp.Canvas.CopyRect (Rect(0,j-1,bmpwidth,j),image1.Canvas,Rect(0,i-1,bmpwidth,i));
form1.Canvas.Draw(0,0,newbmp);
end;
newbmp.free;
end;

//百叶窗效果
procedure TForm1.Button4Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
xgroup,xcount:integer;
begin
newbmp:=TBitmap.Create;
newbmp.width:=image1.width;
newbmp.Height :=image1.height;
bmpheight:=image1.Height ;
bmpwidth:=image1.width;
xgroup:=16;
xcount:=bmpheight div xgroup;
for i:=0 to xcount do
for j:=0 to xgroup do
begin
newbmp.Canvas.copyRect(Rect(0,xcount*j+i-1,bmpwidth,xcount*j+i),image1.Canvas,Rect(0,xcount*j+i-1,bmpwidth,xcount*j+i));
form1.Canvas.Draw(0,0,newbmp);
end;
newbmp.free;

end;

end.

百叶窗效果：
procedure TMainForm.shutterClick(Sender: TObject);
var
newbmp: TBitmap;
i, j, bmpheight, bmpwidth: integer;
xgroup, xcount: integer;
begin
newbmp := TBitmap.Create;
newbmp.Width := childForm.image1.Width;
newbmp.Height := childForm.image1.Height;
bmpheight := childForm.image1.Height;
bmpwidth := childForm.image1.Width;
xgroup := 20;
xcount := bmpheight div xgroup;
for i := 0 to xcount do
for j := 0 to xgroup do
begin
newbmp.Canvas.CopyRect(Rect(0, xcount * j + i, bmpwidth, xcount *
j
+ i + 1), childForm.image1.Canvas, Rect(0, xcount * j + i,
bmpwidth,
xcount * j + 1 + i));
childForm.Canvas.Draw(childForm.Image1.Left, childForm.Image1.top,
newbmp);
application.ProcessMessages;
end;
newbmp.Free;
end;

慢慢切小的有没有！
我主要是要那种效果！

//////////////////////////////////////////////////////////////////////
// 图形特效 //
// 原文作者未注明，所以在此无法注明程序出处。 //
// 我在原来的代码基础上加以小范围的改写，使之成为通用函数。 //
// 可以再进行改写，将参数变为CANVAS，这样可引用的范围就扩大了。//
// xxhadsg //
// 2000.7 //
//////////////////////////////////////////////////////////////////////
unit Draw;

interface

uses
Windows,graphics,extctrls,SysUtils, Classes;

procedure Push(image1,image2:TImage); //从下向上拉出(可增加方向)
procedure Cross(image1,image2:TImage); //交错显示(可增加方向)
procedure Drop(image1,image2:TImage); //水滴效果
procedure Wood(image1,image2:TImage); //堆积木效果
procedure PWindows(image1,image2:TImage); //水平百页窗(可增加方向)

implementation

{　
Delphi 中 的 图 形 显 示 技 巧
---- 基 本 原 理
---- 在Delphi 中， 显 示 一 幅 图 形 非 常 简 单， 只 要 在Form 中 定 义 一 个TImage 组 件， 设 置 其picture 属 性， 然 后 选 择 任 何 有 效 的.ICO、.BMP、.EMF 或.WMF 文 件， 进 行Load， 所 选 文 件 就 显 示 在TImage 组 件 中 了。 但 这 只 是 直 接 将 图 形 显 示 在 窗 体 中， 毫 无 技 巧 可 言。 为 了 使 图 形 显 示 具 有 别 具 一 格 的 效 果， 可 以 按 下 列 步 骤 实 现：
定 义 一 个TImage 组 件， 把 要 显 示 的 图 形 先 装 入 到TImage 组 件 中， 也 就 是 说， 把 图 形 内 容 从 磁 盘 载 入 内 存 中， 作 为 图 形 缓 存。
创 建 一 新 的 位 图 对 象， 其 尺 寸 跟TImage 组 件 中 的 图 形 一 样。
利 用 画 布(Canvas) 的CopyRect 功 能( 将 一 个 画 布 的 矩 形 区 域 拷 贝 到 另 一 个 画 布 的 矩 形 区 域)， 使 用 各 种 技 巧， 动 态 形 成 位 图 文 件 内 容， 然 后 在 窗 体 中 显 示 位 图。
---- 实 现 方 法
}
{---- 1. 推 拉 效 果
---- 将 要 显 示 的 图 形 由 上、 下、 左、 右 各 方 向 拉 进 屏 幕 内 显 示，
// 同 时 将 屏 幕 上 原 来 的 图 形 覆 盖 掉。 下 面 以 上 拉 效 果 为 例
//进 行 说 明。 首 先， 将 放 在 缓 存 图 形 的 第 一 行 像 素 搬 移 至 要
//显 示 的 位 图 的 最 后 一 行； 然 后 将 缓 存 图 形 的 前 两 行 像 素，
//依 序 搬 移 至 要 显 示 位 图 的 最 后 两 行 像 素； 最 后 搬 移 前 三 行、
// 前 四 行， 直 到 全 部 图 形 数 据 搬 完 为 止。 在 搬 移 的 过 程 中
//即 可 看 到 显 示 的 位 图 由 下 而 上 浮 起， 达 到 上 拉 的 效 果。
---- 程 序：
}

procedure Push(image1,image2:TImage);
var
newbmp: TBitmap;
i,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
for i:=0 to bmpheight do
begin
newbmp.Canvas.CopyRect(Rect(0,bmpheight-i,bmpwidth,bmpheight),image1.Canvas,Rect(0,0,bmpwidth,i));
image2.Canvas.Draw(0,0,newbmp);
// sleep(5);
image2.Refresh ;
end;
newbmp.free;
end;
//---- 2. 垂 直 交 错 效 果

//---- 将 要 显 示 的 图 形 拆 成 两 部 分，
//奇 数 行 像 素 由 上 往 下 搬 移， 偶 数 行 像 素 则 由 下 往 上 搬 移，
//而 且 两 者 同 时 进 行。 从 屏 幕 上 便 可 看 到 分 别 由 上 下 两 端
//出 现 的 较 淡 图 形 向 屏 幕 中 央 移 动， 直 到 完 全 清 楚 为 止。

//---- 程 序：

procedure Cross(image1,image2:TImage);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=0;
while i<=bmpheight do
begin
j:=i;
while j>0 do
begin
newbmp.Canvas.CopyRect(Rect(0,j -1,bmpwidth,j),
image1.Canvas,Rect(0,bmpheight -i +j -1,bmpwidth,bmpheight -i +j));
newbmp.Canvas.CopyRect(Rect(0,bmpheight -j,
bmpwidth,bmpheight -j +1),image1.Canvas,Rect(0,i -j,bmpwidth,i -j +1));
j:=j -1;
end;
image2.Canvas.Draw(0,0,newbmp);
// sleep(5);
image2.Refresh ;
i:=i +2;
end;
newbmp.free;
end;
//---- 3. 水 平 交 错 效 果

//---- 同 垂 直 交 错 效 果 实 现 方 法 一 样，
// 只 是 将 分 成 两 组 后 的 图 形 分 别 由 左 右 两 端 移 进 屏 幕。

//---- 程 序 略。

//---- 4. 雨 滴 效 果

//---- 将 缓 存 图 形 的 最 后 一 行 像 素， 依 次 搬 移 到 可 视 位 图 的
//第 一 行， 让 此 行 像 素 在 屏 幕 上 留 下 它 的 轨 迹。 接 着 再 把 缓 存
// 图 形 的 倒 数 第 二 行 像 素， 依 次 搬 移 到 可 视 位 图 的 第 二 行，
// 其 余 的 依 此 类 推。

//---- 程 序：
procedure Drop(image1,image2:TImage);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
for i:=bmpheight downto 1 do
for j:=1 to i do
begin
newbmp.Canvas.CopyRect(Rect(0,j -1,bmpwidth,j),
image1.Canvas,Rect(0,i -1,bmpwidth,i));
image2.Canvas.Draw(0,0,newbmp);
// sleep(5);
image2.Refresh ;
end;
newbmp.free;
end;
//---- 5. 百 叶 窗 效 果

//---- 将 放 在 缓 存 图 形 的 数 据 分 成 若 干 组， 然 后 依 次 从 第 一 组
// 到 最 后 一 组 搬 移， 第 一 次 每 组 各 搬 移 第 一 行 像 素 到 可 视
//位 图 的 相 应 位 置， 第 二 次 各 组 搬 移 第 二 行 像 素， 接 着 搬 移
//第 三 行、 第 四 行 像 素。

//---- 程 序：

procedure PWindows(image1,image2:TImage);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
xgroup,xcount:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
xgroup:=16;
xcount:=bmpheight div xgroup;
for i:=0 to xcount do
for j:=0 to xgroup do
begin
newbmp.Canvas.CopyRect(Rect(0,xcount *j +i -1,bmpwidth,xcount *j
+i),image1.Canvas,Rect(0,xcount *j +i -1,bmpwidth,xcount *j +i));
image2.Canvas.Draw(0,0,newbmp);
// sleep(5);
image2.Refresh ;
end;
newbmp.Free;
end;
//---- 6. 积 木 效 果

//---- 积 木 效 果 是 雨 滴 效 果 的 一 种 变 化， 不 同 之 处 在 于，
//积 木 效 果 每 次 搬 移 的 是 一 块 图 形， 而 不 只 是 一 行 像 素。

//---- 程 序：

procedure Wood(image1,image2:TImage);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=bmpheight;
while i>0 do
begin
for j:=10 to i do
begin
newbmp.Canvas.CopyRect(Rect(0,j
-10,bmpwidth,j),image1.Canvas,Rect(0,i -10,bmpwidth,i));
image2.Canvas.Draw(0,0,newbmp);
// sleep(5);
image2.Refresh ;
end;
i:=i -10;
end;
newbmp.free;
end;

end.

书上有的全部被大家抄过来了,但是书上很难找的就没有像慢慢切小的,就是不见大家回答

把变大反过来。

unit CutPhoto;

interface

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

type
TCutPhotoForm = class(TForm)
StartEffect: TTimer;
Closeimage: TImage;
procedure StartEffectTimer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
NewBmp: TBitmap;
end;

var
CutPhotoForm: TCutPhotoForm;

implementation
uses
InterfaceForm;

{$R *.dfm}

procedure TCutPhotoForm.StartEffectTimer(Sender: TObject);
var
FullRgn, TranRgn, ImageRgn: THandle;
Margin, X, Y: Integer;
i, times, stepx, stepy: Integer;
begin
StartEffect.Enabled := false; //停止时间

//application.CreateForm(TPhotoForm,PhotoForm);
//PhotoForm.Show;
//PhotoForm.BringToFront;
CutPhotoForm.BringToFront;
times := 25;
stepx := round(CloseImage.width / times / 2);
stepy := round(CloseImage.height / times / 2);
for i := 0 to times do
begin
FullRgn := CreateRectRgn(0, 0, CloseImage.width, CloseImage.Height);
ImageRgn := CreateRectRgn(i * stepx, i * stepy, CloseImage.width - i * stepx, CloseImage.height - i * stepy);
combineRgn(FullRgn, FullRgn, ImageRgn, RGN_And);
SetWindowRgn(Handle, FullRgn, True);
sleep(60);
end;
FullRgn := CreateRectRgn(0, 0, CloseImage.width, CloseImage.Height);
combineRgn(FullRgn, FullRgn, FullRgn, RGN_DIFF);
SetWindowRgn(Handle, FullRgn, true);

end;

procedure TCutPhotoForm.BitBtn1Click(Sender: TObject);
begin
Self.StartEffect.Enabled := true;
end;

end.

慢慢切小!

多人接受答案了。