用delphi编写图片播放组件

...{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::Author：pengyiEmail:pengyi.yi@126.com::
::::
::Unit:UnitImagePlay::
::::
::DeveloperTeam:MdclDevTeam::
::$Id:UnitImagePlay.pas,v1.132006/07/1308:22:24Exp$::
::::
::CreatedDate:2005-12-8::
::LastModified:$Date:2006/07/1308:22:24$::
::LastModifier:$Author:pengyi$::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}

unitUnitImagePlay;

interface
usesMessages,Windows,SysUtils,Classes,CutlineU,
Controls,Forms,ExtCtrls,Graphics,StdCtrls,Dialogs;
type
TXPImage=class;

TShowPicture=class(TThread)
private
Fidx:integer;...{当时显示的数}
//I:integer;
FItem:TXPImage;
protected
procedureExecute;override;
public
procedureSetPicture;
constructorCreate(Aowner:TXPImage);
end;

TXPImage=class(TComponent)
private
FActive:Boolean;//当前是否激活
FInterval:Integer;
//FTimer:TTimer;
FImgbmp:TBitmap;
//FImage:TImage;
FImage:TCutline;
FImageList:TImageList;
FshowPic:TShowPicture;
procedureSetActive(Value:Boolean);virtual;
procedureSetInterval(Value:Integer);
procedureSetImageList(Value:TImageList);
procedureSetImage(Value:TCutline);
public
constructorCreate(AOwner:TComponent);override;
destructorDestroy;override;
procedureStart;
//ProcedurePause;
//ProcedureContinue;
procedureStop;
propertyActive:BooleanreadFActivewriteSetActive;
propertyInterval:IntegerreadFIntervalwriteSetInterval;
propertyImgbmp:TBitmapreadFImgbmpwriteFImgbmp;
propertyImageList:TImageListreadFImageListwriteSetImageList;
//PropertyImage:TImageReadFImageWriteSetImage;
propertyImage:TCutlinereadFImagewriteSetImage;
//PropertyshowPic:TShowPictureReadFshowPic;
end;

implementation

uses
CommonU,DbugIntf;

...{TXPImage}

constructorTXPImage.Create(AOwner:TComponent);
begin
inherited;
FInterval:=800;
FImgbmp:=TBitmap.Create;
//FImage:=TCutline.Create(AOwner);
//FImageList:=TImageList.Create(AOwner);
//FTimer:=TTimer.Create(AOwner);
//FImage:=TImage.Create(AOwner);
end;

destructorTXPImage.Destroy;
begin
ifAssigned(FImgbmp)then
FImgbmp.Free;
//FTimer.Free;
//FImage.Free;
//FImageList.Free;
inherited;
end;

procedureTXPImage.SetActive(Value:Boolean);
begin
FActive:=Value;
if(FshowPic<>nil)andValuethen
FshowPic:=TShowPicture.Create(Self)
else
FshowPic.Terminate;
end;

procedureTXPImage.SetImageList(Value:TImageList);
begin
FImageList:=Value;
end;

procedureTXPImage.SetInterval(Value:Integer);
begin
FInterval:=value;
end;

procedureTXPImage.SetImage(Value:TCutline);
begin
FImage:=Value;
end;

procedureTXPImage.Start;
begin
FActive:=true;
//创建线程
FshowPic:=TShowPicture.Create(Self);
//FshowPic.Resume;
end;

procedureTXPImage.Stop;
begin
//FActive:=false;
ifFshowPic<>nilthen
begin
FshowPic.Terminate;
FshowPic:=nil;
end;
end;

...{procedureTXPImage.Continue;
begin
IFFshowPic<>nilthen
begin
FActive:=true;
FshowPic.Resume;
end;
end;

procedureTXPImage.Pause;
begin
IFFshowPic<>nilthen
FActive:=false;
end;}

...{TShowPicture}

constructorTShowPicture.Create(Aowner:TXPImage);
begin
inheritedCreate(false);
FItem:=Aowner;
Fidx:=0;
FreeOnTerminate:=true;
end;

procedureTShowPicture.Execute;
//var
//nTickCount:Cardinal;
begin
inherited;
whilenotTerminateddo
begin
ifFItem.Activethen
begin
//Application.ProcessMessages;
synchronize(SetPicture);...{注意此处}
Fidx:=Fidx+1;
ifFidx>=FItem.FImageList.Countthen
Fidx:=0;
ifterminatedthen
exit;
//Item.;
Sleep(FItem.FInterval);

//nTickCount:=GetTickCount;
//whileFItem.Activeand(GetTickCount-nTickCount<FItem.FInterval)do
//Application.ProcessMessages;
end
else
begin
Suspend;
end;
end;
end;

procedureTShowPicture.SetPicture;
var
sMsg:string;
begin

//SendMethodEnter(Format('“%s”播放动画中的设置图片',[FItem.Image.Caption]));
ifFItem.Imgbmp<>nilthen
begin
try
//SendDebug('开始从Imagelist中获取图片');
FItem.FImageList.GetBitmap(Fidx,FItem.Imgbmp);
//SendDebug('完成从Imagelist中获取图片');
//FItem.FImageList.GetBitmap(Fidx,FItem.FImage.Picture.Bitmap);
//SendDebug('开始从把图片给Cutline图片');
FItem.Image.SetImage(FItem.Imgbmp);
//SendDebug('完成从把图片给Cutline图片');
//SendDebug('开始刷新Cutline');
//FItem.FImage.Refresh;
//SendDebug('完成刷新Cutline');
application.ProcessMessages;
except
onE:Exceptiondo
begin
sMsg:=Format('错误位置：[%s]类：[%s]名称：[%s]错误类：[%s]错误信息：[%s]',
['播放动画',ClassName,FItem.Image.Caption,E.ClassName,E.Message]);
SendDebugEx(sMsg,mtError);
WriteLog(sMsg);
end;
end;
end;
//SendMethodExit(Format('“%s”播放动画中的设置图片',[FItem.Image.Caption]));
//SendSeparator;

end;

end.