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

  • 主题发起人 主题发起人 程云
  • 开始时间 开始时间
多人接受答案了。
 
szmic兄发现我开始给出的程序有问题，看来是我写错了，现在把下确的程序
给出。供大家参考。
并感谢szmic兄的指正。



unit UnFM;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, SHDocVw, ExtCtrls, StdCtrls, MPlayer, Animate, GIFCtrl;

type
Twelcome = class(TForm)
Timer: TTimer;
Image: TImage;
MediaPlayer: TMediaPlayer;
RxGIF: TRxGIFAnimator;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure ImageClick(Sender: TObject);
procedure MediaPlayerNotify(Sender: TObject);
private
{ Private declarations }
procedure showpic(PlayMode:integer;RCode:Integer);
procedure PicOne;
public
{ Public declarations }
procedure MCIPlay(Code:Integer);
end;

var
welcome: Twelcome;
MCIStop:Integer=0;
MessFlag:Integer=0;
PicNum:Integer=1;
ForBmp:Integer=1;
RanCode:Integer=80;
CartCode:Integer=0;
FormH:integer=81;

implementation

uses UnWebBrowser;

{$R *.DFM}

procedure Twelcome.MCIPlay(Code:Integer);
begin
if MCIStop=0 then
begin
MCIStop:=1;
MediaPlayer.Close;
end;

case Code of

0:if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T01.mid') then
begin
MediaPlayer.FileName:=(ExtractFilePath(Application.Exename)+'RunLib/T01.mid');
MediaPlayer.Open;
MediaPlayer.Notify:=true;
MediaPlayer.Play;
end;

1:if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T02.mid') then
begin
MediaPlayer.FileName:=(ExtractFilePath(Application.Exename)+'RunLib/T02.mid');
MediaPlayer.Open;
MediaPlayer.Notify:=true;
MediaPlayer.Play;
end;

2:if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T03.mid') then
begin
MediaPlayer.FileName:=(ExtractFilePath(Application.Exename)+'RunLib/T03.mid');
MediaPlayer.Open;
MediaPlayer.Notify:=true;
MediaPlayer.Play;
end;
end;

MCIStop:=0;
end;

procedure Twelcome.PicOne;
var
newbmp,BmpTemp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
BmpTemp:=TBitmap.Create;
BmpTemp.Width:=image.Width;
BmpTemp.Height:=image.Height;

newbmp:= TBitmap.Create;
newbmp.Width:=image.Width;
newbmp.Height:=image.Height;
bmpheight:=image.Height;
bmpwidth:=image.Width;
BmpTemp.Canvas.StretchDraw(Rect(0,0,bmpwidth,bmpheight),image.Picture.Graphic);
i:=0;
while i<=bmpheight do
begin
j:=i;
while(j >0)do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),BmpTemp.Canvas,Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));
newbmp.Canvas.CopyRect(Rect(0,bmpheight-j,bmpwidth,bmpheight-j+1),BmpTemp.Canvas,Rect(0,i-j,bmpwidth,i-j+1));
j:=j-2;
end;
welcome.Canvas.Draw(0,FormH+0,newbmp);
Sleep(RanCode);
i:=i+2;
end;
newbmp.free;
BmpTemp.Free;
CartCode:=1;
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;


procedure Twelcome.FormCreate(Sender: TObject);
begin
RxGIF.Image.LoadFromFile(ExtractFilePath(Application.Exename)+'RunLib/Tit01.GIF');
end;

procedure Twelcome.FormPaint(Sender: TObject);
begin
if MessFlag<>0 then Exit;
if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T01_'+IntToStr(ForBmp)+'.bmp') then
Image.Picture.LoadFromFile(ExtractFilePath(Application.Exename)+'RunLib/T01_'+IntToStr(ForBmp)+'.bmp');
RanCOde:=30+Random(70);
Screen.Cursor:=crHourGlass;
PicOne;
if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T01.mid') then
begin
MediaPlayer.FileName:=ExtractFilePath(Application.Exename)+'RunLib/T01.mid';
MediaPlayer.Open;
MediaPlayer.Play;
end
else
if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T01.wav') then
begin
MediaPlayer.FileName:=ExtractFilePath(Application.Exename)+'RunLib/T01.wav';
MediaPlayer.Open;
MediaPlayer.Play;
end;
MCIPlay(0);
Screen.Cursor:=crHandPoint;
Timer.Enabled:=True;
Image.Visible:=True;
MessFlag:=1;
end;

procedure Twelcome.TimerTimer(Sender: TObject);
begin
Timer.Enabled:=False;
ForBmp:=ForBmp+1;
if FileExists(ExtractFilePath(Application.Exename)+'RunLib/T01_'+IntToStr(ForBmp)+'.bmp') then
begin
Image.Picture.LoadFromFile(ExtractFilePath(Application.Exename)+'RunLib/T01_'+IntToStr(ForBmp)+'.bmp');
end
else
begin
ForBmp:=1;
Image.Picture.LoadFromFile(ExtractFilePath(Application.Exename)+'RunLib/T01_'+IntToStr(ForBmp)+'.bmp');
end;
RanCode:=Random(50);
PicNum:=Random(13);
Screen.Cursor:=crHourGlass;
showpic(PicNum,RanCode);
Screen.Cursor:=crHandPoint;
Timer.Enabled:=True;
end;

procedure Twelcome.ImageClick(Sender: TObject);
begin
if MessFlag=0 then Exit;
MCIStop:=1;
MediaPlayer.Stop;
Timer.Enabled:=False;
welcome.Hide;
Form1.ShowModal;
Close;
end;

procedure Twelcome.MediaPlayerNotify(Sender: TObject);
begin
if MCIStop=1 then Exit;
if MediaPlayer.Mode=mpStopped then
begin
MediaPlayer.Rewind;
MediaPlayer.Play;
end;
MediaPlayer.Notify:=true;
end;

end.

 
您必须登录或注册才可回复。

Similar threads

W
c++ to pasacal 图像处理FFT算法改写(100分)
回复
4
查看
187
wz_hefei
W
W
bitmap的assign问题(100分)
回复
10
查看
373
whether_bobo
W
你
帮我试一下这段代码!图形由四周向中心合拢的！会闪动(50分)
回复
6
查看
152
你若有情
你
Z
请教！MoveTo和lineTo问题？（100分）(100分)
回复
4
查看
198
zhengv
Z
H
关于Timage的缩放问题。(100分)
回复
7
查看
291
PurShe
P
后退
顶部