实现图片显示动画效果；(300分)

实现图片显示动画效果；

大家好又要麻烦一下各位了，公司要作点多媒体光盘，需要一些图片显示的动画效果。
我这有三百分，其中有五十分是给老猫的，已欠了他好几回了，这次一定给他。
另外每一个动画效果10分。
下面我已列出的几个简单的效果就不用再帖进来了（不过你如果有更好的算法我也很欢迎）。

但不可拿一些假货充数，如：
procedure TForm1.timer1Timer(Sender: TObject);
begin
if dbimage1.left >0then
begin
dbimage1.left:=dbimage1.left-3;
dbimage1.width:=dbimage1.width+3;
end
else
begin
dbimage1.left:=form1.width;
dbimage1.width:=0;
end;
end;


以下是已有的动画效果：

procedure Twelcome.showpic(PlayMode:integer;RCode:Integer);
var
newbmp:TBitmap;
x,y,i,j,k,x1,x2,y1,y2,ynum,xnum,ScrH,ScrW:integer;
begin
newbmp:=TBitmap.Create;
newbmp.Width := Image.Width;
newbmp.Height := Image.Height;
ScrH:=Image.Height;
ScrW:=Image.Width;
newbmp.Canvas.StretchDraw(Rect(0,0,ScrW,ScrH),Image.Picture.Graphic);

case PlayMode of
0:begin //从左向右移动(设x初值为Screen.Width)
x:=ScrW;
while x>0 do
begin
x:=x-10;
welcome.Canvas.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),newbmp.Canvas,Rect(x,0,x+10,ScrH));
Sleep(RCode);
end;
end;
1:begin //从右向左拉(设x初值为0)
x:=0;
while x<ScrW do
begin
x:=x+10;
welcome.Canvas.CopyRect(Rect(x,FormH+0,x-10,FormH+ScrH),newbmp.Canvas,Rect(x,0,x-10,ScrH));
Sleep(RCode);
end;
end;
2:begin //从下向上拉(设y初值为ScrH)
y:=ScrH;
while y>0 do
begin
y:=y-10;
welcome.Canvas.CopyRect(Rect(0,FormH+y,ScrW,FormH+y+10),newbmp.Canvas,Rect(0,y,ScrW,y+10));
Sleep(RCode);
end;
end;
3:begin //从上向下拉(设y初值为0)
y:=0;
while y<ScrH do
begin
y:=y+10;
welcome.Canvas.CopyRect(Rect(0,FormH+y,ScrW,FormH+y-10),newbmp.Canvas,Rect(0,y,ScrW,y-10));
Sleep(RCode);
end;
end;
4:begin //从中间往两边拉
x:=ScrW div 2;
x1:=x;
x2:=x;
while x1>0 do
begin
x1:=x1-10;
x2:=x2+10;
welcome.Canvas.CopyRect(Rect(x1,FormH+0,x1+10,FormH+ScrH),newbmp.Canvas,Rect(x1,0,x1+10,ScrH));
welcome.Canvas.CopyRect(Rect(x2,FormH+0,x2-10,FormH+ScrH),newbmp.Canvas,Rect(x2,0,x2-10,ScrH));
Sleep(RCode);
end;
end;
5:begin //两边从往中间拉
x:=ScrW;
x1:=0;
while x>(x div 2)do
begin
x:=x-10;
x1:=x1+10;
welcome.Canvas.CopyRect(Rect(x,FormH+0,x+10,FormH+ScrH),newbmp.Canvas,Rect(x,0,x+10,ScrH));
welcome.Canvas.CopyRect(Rect(x1,FormH+0,x1-10,FormH+ScrH),newbmp.Canvas,Rect(x1,0,x1-10,ScrH));
Sleep(RCode);
end;
end;
6:begin //从两边间隔拉
x:=ScrW;
x1:=0;
while x>0do
begin
x:=x-10;
x1:=x1+10;
ynum:=ScrH div 20;
for j:=0 to ynum do
begin
welcome.Canvas.CopyRect(Rect(x,FormH+j*20,x+10,FormH+j*20+10),newbmp.Canvas,Rect(x,j*20,x+10,j*20+10));
welcome.Canvas.CopyRect(Rect(x1,FormH+j*20+10,x1-10,FormH+j*20+20),newbmp.Canvas,Rect(x1,j*20+10,x1-10,j*20+20));
end;
Sleep(RCode);
end;
end;
7:begin //从上下间隔拉
y:=ScrH;
y1:=0;
while y>0do
begin
y:=y-10;
y1:=y1+10;
xnum:=ScrW div 20;
for j:=0 to xnum do
begin
welcome.Canvas.CopyRect(Rect(j*20,FormH+y,j*20+10,FormH+y+10),newbmp.Canvas,Rect(j*20,y,j*20+10,y+10));
welcome.Canvas.CopyRect(Rect(j*20+10,FormH+y1,j*20+20,FormH+y1-10),newbmp.Canvas,Rect(j*20+10,y1,j*20+20,y1-10));
end;
Sleep(RCode);
end;
end;
8:begin //从中间往四边拉
x:=ScrW div 2;
y:=ScrH div 2;
y1:=y; y2:=y-2; x1:=x; x2:=x;
while (x1>0) or (y1>0) do
begin
x1:=x1-2; x2:=x2+2;
y1:=y1-2; y2:=y2+2;
welcome.Canvas.CopyRect(Rect(x1,FormH+0,x1+2,FormH+ScrH),newbmp.Canvas,Rect(x1,0,x1+2,ScrH));
welcome.Canvas.CopyRect(Rect(0,FormH+y1,ScrW,FormH+y1+2),newbmp.Canvas,Rect(0,y1,ScrW,y1+2));
welcome.Canvas.CopyRect(Rect(x2,FormH+0,x2-2,FormH+ScrH),newbmp.Canvas,Rect(x2,0,x2-2,ScrH));
welcome.Canvas.CopyRect(Rect(0,FormH+y2,ScrW,FormH+y2+2),newbmp.Canvas,Rect(0,y2,ScrW,y2+2));
Sleep(RCode);
end;
end;
9:begin //从四边往中间拉
x:=ScrW;
y:=ScrH;
x1:=0;y1:=0;
while (x>(x div 2)) or (y>(y div 2))do
begin
x:=x-2; x1:=x1+2;
y:=y-2; y1:=y1+2;
welcome.Canvas.CopyRect(Rect(x,FormH+0,x+2,FormH+ScrH),newbmp.Canvas,Rect(x,0,x+2,ScrH));
welcome.Canvas.CopyRect(Rect(0,FormH+y,ScrW,FormH+y+2),newbmp.Canvas,Rect(0,y,ScrW,y+2));
welcome.Canvas.CopyRect(Rect(x1,FormH+0,x1-2,FormH+ScrH),newbmp.Canvas,Rect(x1,0,x1-2,ScrH));
welcome.Canvas.CopyRect(Rect(0,FormH+y1,ScrW,FormH+y1-2),newbmp.Canvas,Rect(0,y1,ScrW,y1-2));
Sleep(RCode);
end;
end;
10:begin //马赛克
for i:=0 to ScrW*ScrH div 10 do
begin
j := Random(ScrW div 4)*4;
k := Random(ScrH div 4)*4;
welcome.Canvas.CopyRect(Rect(j,FormH+k,j+4,FormH+k+4),newbmp.Canvas,Rect(j,k,j+4,k+4));
end;
welcome.Canvas.CopyRect(Rect(0,FormH+0,ScrW,FormH+ScrH),newbmp.Canvas,Rect(0,0,ScrW,ScrH));
end;
11:begin //左右两次刷新
x:=0;
while x<(ScrW+6) do
begin
x:=x+6;
welcome.Canvas.CopyRect(Rect(x-3,FormH+0,x-6,FormH+ScrH),newbmp.Canvas,Rect(x-3,0,x-6,ScrH));
Sleep(10);
end;
while (x+6)>0 do
begin
x:=x-6;
welcome.Canvas.CopyRect(Rect(x+3,FormH+0,x+6,FormH+ScrH),newbmp.Canvas,Rect(x+3,0,x+6,ScrH));
Sleep(10);
end;
end;
12:begin //左右两次刷新
x:=ScrW;
while (x+6)>0 do
begin
x:=x-6;
welcome.Canvas.CopyRect(Rect(x+3,FormH+0,x+6,FormH+ScrH),newbmp.Canvas,Rect(x+3,0,x+6,ScrH));
Sleep(10);
end;
while x<(ScrW+6) do
begin
x:=x+6;
welcome.Canvas.CopyRect(Rect(x-3,FormH+0,x-6,FormH+ScrH),newbmp.Canvas,Rect(x-3,0,x-6,ScrH));
Sleep(10);
end;
end;
end;
newbmp.Free;
end;

我第一个进来，哈哈，等我有时间再看看

也学点

看看

to wjiachun:
嘿嘿！便宜你了，不过你可的多出点力，不然不和你算完。


各位，不要光看，这次只有符合答案的才给分。
（另外每一个动画效果10分）

时钟走针效果，大概要改。
procedure DrawClock(DC, CDC: HDC);
var
OldRgn, Rgn: HRgn;
I, WidthDiv2, HeightDiv2, R, n: Integer;
a, da: Single;
Points: array[0..2] of TPoint;
begin
WidthDiv2 := Form.Width Div 2;
HeightDiv2 := Form.Height Div 2;
R := Round((Sqrt(sqr(WidthDiv2) + sqr(HeightDiv2))) * 1.5);
da := Pi * 2 / FStep;
a := Pi / 2;
Points[0] := Point(WidthDiv2, HeightDiv2);
OldRgn := CreateRectRgn(0, 0, FForm.Width, FForm.Height);
if FDirection then n := 1 else n := -1;
for I := 1 to FStep do
begin
BeginTime;
if I <> 1 then
Points[1] := Points[2]
else
Points[1] := Point(WidthDiv2 + Round(R * Cos(a)), HeightDiv2 + Round(R * Sin(a)));
a := a + da * n;
Points[2] := Point(WidthDiv2 + Round(R * Cos(a)), HeightDiv2 + Round(R * Sin(a)));
Rgn := CreatePolygonRgn(Points, 3, WINDING);
SelectClipRgn(DC, OldRgn);
ExtSelectClipRgn(DC, Rgn, RGN_AND);
DeleteObject(Rgn);
Bitblt(DC, 0, 0, FForm.Width, FForm.Height, CDC, 0, 0, SRCCOPY);
SleepTime;
end;
DeleteObject(OldRgn);
end;

累

to avant:
但看程序，很不错，我得回去试试。

to Urlzo:
"累"字何解？

让帖子靠前放点。

>>"累"字何解？
我想他是说用Delphi累啊，比如Flash,Director,QuackTime……之类的作
多媒体光盘的效果特好，呵呵，你上面的效果好像差不多了，还有什么？

有点长，是以前从网上下载的。
var
i: integer;

const pin: array[1..9, 1..2] of byte =
((2, 2), (2, 1), (3, 1),
(3, 2), (3, 3), (2, 3),
(1, 3), (1, 2), (1, 1));

type PLinRec = ^LinRec;
LinRec = record
hor: boolean;
lin: byte;
end;

type PBlockRec = ^BlockRec;
BlockRec = record
x, y: byte;
end;

procedure PaintEffect(TheEffect: byte; src, dst: TCanvas; BoxWidth: byte);
var x, y, i, j, k, m, xx, yy, q: byte;
x2, y2, x3, y3, x4, y4: byte;
mid, midx, midy: byte;
cnt, pix: word;
bound, bounds2: TRect;
LinList: TList;
Lin: PLinRec;
Block: PBlockRec;
canwid, canhei: word;
BoxAcross, BoxDown: byte;

procedure DrawBox(x1, y1: byte);
var TheRect: TRect;
l, t, r, b: word;
begin
l := (x1 - 1) * BoxWidth;
t := (y1 - 1) * BoxWidth;
r := x1 * BoxWidth;
b := y1 * BoxWidth;
if r > canwid then r := canwid;
if b > canhei then b := canhei;
TheRect := Rect(l, t, r, b);
dst.CopyRect(TheRect, src, TheRect);
end;


function GetHorLine(bline: byte): TRect;
var l, t, r, b: word;
begin
l := 0;
t := (bline - 1) * BoxWidth;
r := canwid;
b := bline * BoxWidth;
if b > canhei then b := canhei;
GetHorLine := Rect(l, t, r, b);
end;

begin
bound := src.ClipRect;
canwid := bound.right - bound.left + 1;
canhei := bound.bottom - bound.top + 1;
BoxAcross := Trunc(Int(canwid / BoxWidth));
if (canwid mod BoxWidth) <> 0 then Inc(BoxAcross);
BoxDown := Trunc(Int(canhei / BoxWidth));
if (canhei mod BoxWidth) <> 0 then Inc(BoxDown);
case TheEffect of
0: dst.CopyRect(src.ClipRect, src, src.ClipRect);
1: for i := 1 to BoxAcross do
for q := 1 to BoxDown do DrawBox(i, q);
2: for i := BoxAcross downto 1 do
for q := 1 to BoxDown do DrawBox(i, q);
3: for i := 1 to BoxDown do
for q := 1 to BoxAcross do DrawBox(q, i);
4: for i := BoxDown downto 1 do
for q := 1 to BoxAcross do DrawBox(q, i);
5: begin
k := Round(BoxAcross / 2);
for i := 0 to k do begin
for q := 1 to BoxDown do DrawBox(i + 1, q);
for q := 1 to BoxDown do DrawBox(BoxAcross - i, q);
end;
end;
6: begin
k := Round(BoxAcross / 2);
for i := k to BoxAcross do begin
for q := 1 to BoxDown do DrawBox(i, q);
j := BoxAcross - i;
if j > 0 then for q := 1 to BoxDown do DrawBox(j, q);
end;
end;
7: begin
k := Round(BoxDown / 2);
for i := 0 to k do begin
for q := 1 to BoxAcross do DrawBox(q, i + 1);
for q := 1 to BoxAcross do DrawBox(q, BoxDown - i);
end;
end;
8: begin
k := Round(BoxDown / 2);
for i := k to BoxDown do begin
for q := 1 to BoxAcross do DrawBox(q, BoxDown - i);
for q := 1 to BoxAcross do DrawBox(q, i);
j := BoxDown - i;
if j > 0 then for q := 1 to BoxAcross do DrawBox(q, j);
end;
end;
9: begin
for x := 1 to BoxAcross do begin
j := (BoxAcross + 1) - x;
y := 1;
while y <= BoxDown do begin
DrawBox(x, y);
if y < BoxDown then DrawBox(j, y + 1);
inc(y, 2);
end;
end;
end;
10: begin
for y := 1 to BoxDown do begin
j := (BoxDown + 1) - y;
x := 1;
while x <= BoxAcross do begin
DrawBox(x, y);
if x < BoxAcross then DrawBox(x + 1, j);
inc(x, 2);
end;
end;
end;
11: begin
for k := 1 to 2 do begin
for x := 1 to BoxAcross do begin
y := k;
while y <= BoxDown do begin
DrawBox(x, y);
inc(y, 2);
end;
end;
end;
end;
12: begin
for k := 1 to 2 do begin
for y := 1 to BoxDown do begin
x := k;
while x <= BoxAcross do begin
DrawBox(x, y);
inc(x, 2);
end;
end;
end;
end;
13: begin
for x := 1 to BoxAcross do begin
y := 1;
while y <= BoxDown do begin
DrawBox(x, y);
inc(y, 2);
end;
end;
for x := BoxAcross downto 1 do begin
y := 2;
while y <= BoxDown do begin
DrawBox(x, y);
inc(y, 2);
end;
end;
end;
14: begin
for y := 1 to BoxDown do begin
x := 1;
while x <= BoxAcross do begin
DrawBox(x, y);
inc(x, 2);
end;
end;
for y := BoxDown downto 1 do begin
x := 2;
while x <= BoxAcross do begin
DrawBox(x, y);
inc(x, 2);
end;
end;
end;
15: begin
for i := 1 to BoxWidth do begin
pix := i - 1;
bounds2 := src.ClipRect;
canhei := bounds2.bottom - bounds2.top + 1;
while pix <= canhei do begin
Bound := Rect(0, pix, bounds2.right - bounds2.left + 1, pix + 1);
dst.CopyRect(Bound, src, Bound);
inc(pix, BoxWidth);
end;
end;
end;
16: begin
for i := 1 to BoxWidth do begin
pix := i - 1;
bounds2 := src.ClipRect;
canwid := bounds2.right - bounds2.left + 1;
while pix <= canwid do begin
Bound := Rect(pix, 0, pix + 1, bounds2.bottom - bounds2.top + 1);
dst.CopyRect(Bound, src, Bound);
inc(pix, BoxWidth);
end;
end;
end;
17: begin
for i := 1 to BoxWidth do begin
pix := i - 1;
bounds2 := src.ClipRect;
canwid := bounds2.right - bounds2.left + 1;
canhei := bounds2.bottom - bounds2.top + 1;
while (pix <= canhei) or (pix <= canwid) do begin
bounds2 := src.ClipRect;
Bound := Rect(pix, 0, pix + 1, bounds2.Bottom - Bounds2.top + 1);
dst.CopyRect(Bound, src, Bound);
Bound := Rect(0, pix, bounds2.right - bounds2.left + 1, pix + 1);
dst.CopyRect(Bound, src, Bound);
inc(pix, BoxWidth);
end;
end;
end;
18: begin
x := 0; y := 1;
while (x < BoxAcross) or (y < BoxDown) do begin
inc(x);
if x > BoxAcross then begin
x := BoxAcross;
if y < BoxDown then inc;
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (i < 1) or (j > BoxDown) or (i > BoxAcross) then break;
end;
end;
end;
19: begin
x := 1; y := BoxDown + 1;
while (x < BoxAcross) or (y < 1) do begin
dec;
if y < 1 then begin
y := 1;
if x < BoxAcross then inc(x);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (j < 1) or (i > BoxAcross) then break;
end;
end;
end;
20: begin
x := BoxAcross + 1; y := 1;
while (x > 1) or (y < BoxDown) do begin
dec(x);
if x < 1 then begin
x := 1;
if y < BoxDown then inc;
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (i < 1) or (i > BoxAcross) then break;
end;
end;
end;
21: begin
x := BoxAcross; y := BoxDown + 1;
while (x > 1) or (y > 1) do begin
dec;
if y < 1 then begin
y := 1;
if x > 1 then dec(x);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (j > BoxDown) or (i < 1) or (j < 1) then break;
end;
end;
end;
22: begin
x := 0; y := 1; xx := BoxAcross; yy := BoxDown + 1;
while ((x < BoxAcross) or (y < BoxDown)) and
((xx > 1) or (yy > 1)) do begin
inc(x); dec(yy);
if x > BoxAcross then begin
x := BoxAcross;
if y < BoxDown then inc;
end;
if yy < 1 then begin
yy := 1;
if xx > 1 then dec(xx);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (i < 1) or (j > BoxDown) or (i > BoxAcross) then break;
end;
i := xx; j := yy;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (j > BoxDown) or (i < 1) or (j < 1) then break;
end;
end;
end;
23: begin
x := BoxAcross + 1; y := 1; xx := 1; yy := BoxDown + 1;
while ((x > 1) or (y < BoxDown)) and
((xx < BoxAcross) or (yy < 1)) do begin
dec(x);
if x < 1 then begin
x := 1;
if y < BoxDown then inc;
end;
dec(yy);
if yy < 1 then begin
yy := 1;
if xx < BoxAcross then inc(xx);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (i < 1) or (i > BoxAcross) then break;
end;
i := xx; j := yy;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (j < 1) or (i > BoxAcross) then break;
end;
end;
end;
24: begin
if BoxAcross > BoxDown then mid := BoxDown else mid := BoxAcross;
x := mid + 1; y := 1; xx := mid - 1; yy := 1;
while ((x > 1) or (y > 1)) or
((xx < BoxAcross) or (yy < BoxDown)) do begin
dec(x); inc(xx);
if x < 1 then begin
x := 1;
if y > 1 then dec;
end;
if xx > BoxAcross then begin
xx := BoxAcross;
if yy < BoxDown then inc(yy);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (i < 1) or (j > BoxDown) or (i > BoxAcross) then break;
end;
i := xx; j := yy;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (j > BoxDown) or (i < 1) or (j < 1) then break;
end;
end;
end;
25: begin
if BoxAcross > BoxDown then mid := BoxDown else mid := BoxAcross;
mid := BoxAcross - mid;
x := mid + 1; y := 1; xx := mid - 1; yy := 1;
while ((x > 1) or (y < BoxDown)) or
((xx < BoxAcross) or (yy > 1)) do begin
dec(x);
if x < 1 then begin
x := 1;
if y < BoxDown then inc;
end;
inc(xx);
if xx > BoxAcross then begin
xx := BoxAcross;
if yy > 1 then dec(yy);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (i < 1) or (i > BoxAcross) then break;
end;
i := xx; j := yy;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (j < 1) or (i > BoxAcross) then break;
end;
end;
end;
26: begin
midx := Round(BoxAcross / 2);
midy := Round(BoxDown / 2);
x := 0; y := 1; x2 := BoxAcross; y2 := BoxDown + 1;
x3 := BoxAcross + 1; y3 := 1; x4 := 1; y4 := BoxDown + 1;
while ((x < midx) or (y < midy)) or
((x2 > midx) or (y2 > midy)) or
((x3 > midx) or (y3 < midy)) or
((x4 < midx) or (y4 < midy)) do begin
inc(x);
if x > midx then begin
x := midx;
if y < midy then inc;
end;
dec(y2);
if y2 < midy then begin
y2 := midy;
if x2 > midx then dec(x2);
end;
dec(x3);
if x3 < midx then begin
x3 := midx;
if y3 < midy then inc(y3);
end;
dec(y4);
if y4 < midy then begin
y4 := midy;
if x4 < BoxAcross then inc(x4);
end;
i := x; j := y;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (i < 1) or (j > midy) or (i > midx) then break;
end;
i := x2; j := y2;
while true do begin
DrawBox(i, j);
dec(i); inc(j);
if (j > BoxDown) or (i < midx) or (j < midy) then break;
end;
i := x3; j := y3;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (i < 1) or (i > BoxAcross) then break;
end;
i := x4; j := y4;
while true do begin
DrawBox(i, j);
inc(i); inc(j);
if (j > BoxDown) or (j < 1) or (i > BoxAcross) then break;
end;
end;
end;
27: begin
midx := Round(BoxAcross / 4);
for i := 1 to BoxDown do begin
for j := 1 to midx do begin
DrawBox(j, i);
DrawBox(midx + j, (BoxDown + 1) - i);
DrawBox((midx * 2) + j, i);
DrawBox((midx * 3) + j, (BoxDown + 1) - i);
end;
end;
end;
28: begin
midy := Round(BoxDown / 4);
for i := 1 to BoxAcross do begin
for j := 1 to midy do begin
DrawBox(i, j);
DrawBox((BoxAcross + 1) - i, midy + j);
DrawBox(i, (midy * 2) + j);
DrawBox((BoxAcross + 1) - i, (midy * 3) + j);
end;
end;
end;
29: begin
midx := Round(BoxAcross / 2);
for i := 1 to BoxDown do begin
for j := 1 to midx do begin
DrawBox(j, i);
DrawBox(midx + j, (BoxDown + 1) - i);
end;
end;
end;
30: begin
midy := Round(BoxDown / 2);
for i := 1 to BoxAcross do begin
for j := 1 to midy do begin
DrawBox(i, j);
DrawBox((BoxAcross + 1) - i, midy + j);
end;
end;
end;
31: begin
midx := Round(BoxAcross / 2);
midy := Round(BoxDown / 2);
for i := 1 to midy + 1 do begin
for j := 1 to midx do begin
DrawBox(j, i);
DrawBox(j, midy + i);
DrawBox(midx + j, (BoxDown + 1) - i - midy);
DrawBox(midx + j, (BoxDown + 1) - i);
end;
end;
end;
32: begin
y := Round(BoxDown / 3);
yy := y * 2;
midx := Round(BoxAcross / 2);
for i := 1 to midx do begin
for j := y to yy do begin
DrawBox(midx + 1 - i, j);
DrawBox(midx + i, j);
end;
end;
for i := 1 to y do begin
for j := 1 to BoxAcross do begin
DrawBox(j, y + 1 - i);
DrawBox(j, yy + i);
end;
end;
end;
33: begin
y := Round(BoxDown / 3);
yy := y * 2;
midx := Round(BoxAcross / 2);
for i := 1 to y do begin
for j := 1 to BoxAcross do begin
DrawBox(j, i);
DrawBox(j, BoxDown + 1 - i);
end;
end;
for i := 1 to midx + 1 do begin
for j := y to yy + 1 do begin
DrawBox(i, j);
DrawBox(BoxAcross + 1 - i, j);
end;
end;
end;
34: begin
LinList := TList.Create;
for i := 1 to BoxAcross do begin
New(Lin);
Lin^.hor := False;
Lin^.lin := i;
LinList.Add(Lin);
end;
for i := 1 to BoxDown do begin
New(Lin);
Lin^.hor := True;
Lin^.lin := i;
LinList.Add(Lin);
end;
(**)
repeat
k := LinList.Count;
j := Round(Random(k));
if PLinRec(LinList.Items[j])^.hor
then for q := 1 to BoxAcross do DrawBox(q, PLinRec(LinList.Items[j])^.lin)
else for q := 1 to BoxAcross do DrawBox(q, PLinRec(LinList.Items[j])^.lin);
Dispose(LinList.Items[j]);
LinList.Delete(j);
until k = 1;
LinList.Free;
end;
35: begin
LinList := TList.Create;
for i := 1 to BoxAcross do begin
for j := 1 to BoxDown do begin
New(Block);
Block^.x := i;
Block^.y := j;
LinList.Add(Block);
end;
end;
(**)
repeat
cnt := LinList.Count;
pix := Round(Random(cnt));
DrawBox(PBlockRec(LinList.Items[pix])^.x,
PBlockRec(LinList.Items[pix])^.y);
Dispose(LinList.Items[pix]);
LinList.Delete(pix);
until cnt = 1;
LinList.Free;
end;
36: begin
for k := 0 to 1 do begin
j := 1;
while j <= BoxDown do begin
i := (j mod 2) + k;
while i <= BoxAcross do begin
DrawBox(i, j);
inc(i, 2);
end;
inc(j);
end;
end;
end;
37: begin
for i := BoxDown downto 1 do begin
bound := GetHorLine(i);
for k := 1 to i do begin
bounds2 := GetHorLine(k);
dst.CopyRect(bounds2, src, bound);
end;
end;
end;
38: begin
for k := 1 to 9 do begin
i := pin[k, 1];
while i <= BoxAcross do begin
j := pin[k, 2];
while j <= BoxDown do begin
DrawBox(i, j);
inc(j, 3);
end;
inc(i, 3);
end;
end;
end;
39: begin
x := 1; y := 1; xx := BoxAcross; yy := BoxDown;
while x < xx do begin
for i := x to xx do DrawBox(i, y);
for i := y to yy do DrawBox(xx, i);
for i := xx downto x do DrawBox(i, yy);
for i := yy downto y do DrawBox(x, i);
inc(x); inc; dec(xx); dec(yy);
end;
end;
40: begin
for k := 1 to 2 do begin
y := k;
while y <= BoxDown do begin
if (y mod 2) = 1
then for x := 1 to BoxAcross do DrawBox(x, y)
else for x := BoxAcross downto 1 do DrawBox(x, y);
inc(y, 2);
end;
end;
end;
41: begin
for k := 1 to 2 do begin
x := k;
while x <= BoxAcross do begin
if (x mod 2) = 1
then for y := 1 to BoxDown do DrawBox(x, y)
else for y := BoxDown downto 1 do DrawBox(x, y);
inc(x, 2);
end;
end;
end;
end;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
if spinedit1.value > 41 then
spinedit1.value := 1;
if spinedit1.value < 1 then
spinedit1.value := 41;
i := spinedit1.Value;
PaintBox1.canvas.Brush.Color := clwhite;
PaintBox1.canvas.FillRect(PaintBox1.canvas.ClipRect);
PaintEffect(i, image1.canvas, PaintBox1.canvas, 1)
end;

我有一个构件，有120种变幻效果，算不算。

Delphi 中 的 图 形 显 示 技 巧

--------------------------------------------------------------------------------

---- 目 前 在 许 多 学 习 软 件、 游 戏 光 盘 中， 经 常 会 看 到 各 种 图 形 显 示 技 巧， 凭 着 图 形 的 移 动、 交 错、 雨 滴 状、 百 页 窗、 积 木 堆 叠 等 显 现 方 式， 画 面 变 得 更 为 生 动 活 泼， 更 能 吸 引 用 户。 本 文 将 探 讨 如 何 在Delphi 中 实 现 各 种 图 形 显 示 技 巧。

---- 基 本 原 理

---- 在Delphi 中， 显 示 一 幅 图 形 非 常 简 单， 只 要 在Form 中 定 义 一 个TImage 组 件， 设 置 其picture 属 性， 然 后 选 择 任 何 有 效 的.ICO、.BMP、.EMF 或.WMF 文 件， 进 行Load， 所 选 文 件 就 显 示 在TImage 组 件 中 了。 但 这 只 是 直 接 将 图 形 显 示 在 窗 体 中， 毫 无 技 巧 可 言。 为 了 使 图 形 显 示 具 有 别 具 一 格 的 效 果， 可 以 按 下 列 步 骤 实 现：

定 义 一 个TImage 组 件， 把 要 显 示 的 图 形 先 装 入 到TImage 组 件 中， 也 就 是 说， 把 图 形 内 容 从 磁 盘 载 入 内 存 中， 作 为 图 形 缓 存。

创 建 一 新 的 位 图 对 象， 其 尺 寸 跟TImage 组 件 中 的 图 形 一 样。

利 用 画 布(Canvas) 的CopyRect 功 能( 将 一 个 画 布 的 矩 形 区 域 拷 贝 到 另 一 个 画 布 的 矩 形 区 域)， 使 用 各 种 技 巧， 动 态 形 成 位 图 文 件 内 容， 然 后 在 窗 体 中 显 示 位 图。
---- 实 现 方 法

---- 1. 推 拉 效 果

---- 将 要 显 示 的 图 形 由 上、 下、 左、 右 各 方 向 拉 进 屏 幕 内 显 示， 同 时 将 屏 幕 上 原 来 的 图 形 覆 盖 掉。 下 面 以 上 拉 效 果 为 例 进 行 说 明。 首 先， 将 放 在 缓 存 图 形 的 第 一 行 像 素 搬 移 至 要 显 示 的 位 图 的 最 后 一 行； 然 后 将 缓 存 图 形 的 前 两 行 像 素， 依 序 搬 移 至 要 显 示 位 图 的 最 后 两 行 像 素； 最 后 搬 移 前 三 行、 前 四 行， 直 到 全 部 图 形 数 据 搬 完 为 止。 在 搬 移 的 过 程 中 即 可 看 到 显 示 的 位 图 由 下 而 上 浮 起， 达 到 上 拉 的 效 果。

---- 程 序：

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(120,100,newbmp);
end;
newbmp.free;
end;

---- 2. 垂 直 交 错 效 果

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

---- 程 序：

procedure TForm1.Button4Click(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<=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 －2;
end;
form1.Canvas.Draw(120,100,newbmp);
i:=i ＋2;
end;
newbmp.free;
end;

---- 3. 水 平 交 错 效 果

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

---- 程 序 略。

---- 4. 雨 滴 效 果

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

---- 程 序：procedure TForm1.Button3Click(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;
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(120,100,newbmp);
end;
newbmp.free;
end;

---- 5. 百 叶 窗 效 果

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

---- 程 序：

procedure TForm1.Button6Click(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(120,100,newbmp);
end;
newbmp.Free;
end;

---- 6. 积 木 效 果

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

---- 程 序：

procedure TForm1.Button7Click(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:=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));
form1.Canvas.Draw(120,100,newbmp);
end;
i:=i －10;
end;
newbmp.free;
end;

---- 上 述 图 形 显 示 效 果 均 已 调 试 通 过， 软 件 环 境 为Delphi 3.0， 硬 件 环 境 为Pentium 100M 兼 容 机。

到这个网址 http://www.csdn.net/Delphi/去，选“VCL控件大集合”，再选“图形图像”，选取“fximg.zip”,总共有40种变化，不知你够不够用？

http://go.163.com/~pengs/DownLoad/Compoents/PicShow.zip

不好意思让大家久等了，公司组织出去玩了几天，才回来。

这么多帖子让我一个一个来说。

to avant:
你能不能把程序写完，这段程序无法看明白。如FStep是啥东西，就让人不明白。

to wjiachun:
"Flash,Director,QuackTime……之类"作这些自然好，只是还有一些如复杂点的
数据库程序不还得用Delphi，所以不得不如此。

to Fudei:
你的程序我试了，还可以，只是不明白，为何有很多变量要定义成byte类型呢？
这样它最大只能为23（应为255，可在这程序中是能为23，不知为何），试想一个
23＊23大的图是如何的小。只要把它们都改为Integer或其它较大的类型就可以了。
还有虽然有41种效果，但水份也不少，而且有一些有我给出的程序中已有了，还
有第34种的"淡出效果"太慢，慢的无法忍受。所以分数是多给你点，但可不是410分。

to Ridolph:
你给出的"雨滴效果"，"百叶窗效果"，"积木效果"很不错，虽然第三种是第一种
的变化，"交错效果"是我学编程以来作的第一种动画效果，只是上面未提及，所以这
给你算成4种，40分。

to wlqzb:
很高兴你的捧场，不过我是不想用控件，但看看也不错，也许能学到不少东西。


好了这个问题，我下次来就结束它。
感谢各位的帮忙，只是wjiachun纯脆来灌水的，嘿嘿！他整天呆在网上，一定
混了不少分，（少声说）不如咱们合伙打劫了他吧，一定肥的流油。

唉，快乐无罪，灌水无罪，以后不能经常上网了 ：（
找了一份兼职，还要每天下午上班的，苦啊……

没工作才苦呢

to wjiachun:
怎么凭你这么大的能耐还没工作吗？我看一定是。。。。嘿嘿！懒毛了。

to Kang:
你也是，还好意说"没工作才苦呢"，和老猫是一家子了。
在论坛上有那么多来招聘的，你就没看中一个。
人家唐大侠来找了好几次，你就不去试试吗？
人家天正公司多好啊！我都想去了。

好了,就到这儿吧!

wjiachun 100分 这是欠他的,大伙不要嫉妒啊!不然我也欠你们个几百分.
Ridolph 50分 这可是凭本事拿的.
Fudei 90 老苦功高啊!
Kang 20 是否能把程序写完,我另外给你分.Email给我也可zzmcy@21cn.com

感谢以下四位的光临每人送10分微表谢意
avant 10
wlqzb 10
Urlzo 10
LawrenceZhang 10