用delphi编写图片播放组件

...{ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


:: Author：pengyi Email:pengyi.yi@126.com ::


:: ::


:: Unit : UnitImagePlay ::


:: ::


:: Developer Team : Mdcl DevTeam ::


:: $Id: UnitImagePlay.pas,v 1.13 2006/07/13 08:22:24 Exp $ ::


:: ::


:: Created Date : 2005-12-8 ::


:: Last Modified: $Date: 2006/07/13 08:22:24 $ ::


:: Last Modifier: $Author:pengyi $ ::


:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }




unit UnitImagePlay;




interface


uses Messages, Windows, SysUtils, Classes, CutlineU,


Controls, Forms, ExtCtrls, Graphics, StdCtrls, Dialogs;


type


TXPImage = class;




TShowPicture = class(TThread)


private




Fidx: integer; ...{当时显示的数}


//I:integer;


FItem: TXPImage;


protected


procedure Execute; override;


public


procedure SetPicture;


constructor Create(Aowner: TXPImage);


end;




TXPImage = class(TComponent)


private


FActive: Boolean; //当前是否激活


FInterval: Integer;


//FTimer :TTimer;


FImgbmp: TBitmap;


//FImage: TImage;


FImage: TCutline;


FImageList: TImageList;


FshowPic: TShowPicture;


procedure SetActive(Value: Boolean); virtual;


procedure SetInterval(Value: Integer);


procedure SetImageList(Value: TImageList);


procedure SetImage(Value: TCutline);


public


constructor Create(AOwner: TComponent); override;


destructor Destroy; override;


procedure Start;


// Procedure Pause;


//Procedure Continue;


procedure Stop;


property Active: Boolean read FActive write SetActive;


property Interval: Integer read FInterval write SetInterval;


property Imgbmp: TBitmap read FImgbmp write FImgbmp;


property ImageList: TImageList read FImageList write SetImageList;


//Property Image:TImage Read FImage Write SetImage;


property Image: TCutline read FImage write SetImage;


//Property showPic:TShowPicture Read FshowPic;


end;




implementation




uses


CommonU, DbugIntf;






...{ TXPImage }




constructor TXPImage.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;




destructor TXPImage.Destroy;


begin


if Assigned(FImgbmp) then


FImgbmp.Free;


//FTimer.Free;


//FImage.Free;


//FImageList.Free;


inherited;


end;




procedure TXPImage.SetActive(Value: Boolean);


begin


FActive := Value;


if (FshowPic <> nil) and Value then


FshowPic := TShowPicture.Create(Self)


else


FshowPic.Terminate;


end;




procedure TXPImage.SetImageList(Value: TImageList);


begin


FImageList := Value;


end;




procedure TXPImage.SetInterval(Value: Integer);


begin


FInterval := value;


end;




procedure TXPImage.SetImage(Value: TCutline);


begin


FImage := Value;


end;




procedure TXPImage.Start;


begin


FActive := true;


//创建线程


FshowPic := TShowPicture.Create(Self);


//FshowPic.Resume;


end;




procedure TXPImage.Stop;


begin


//FActive:= false;


if FshowPic <> nil then


begin


FshowPic.Terminate;


FshowPic := nil;


end;


end;






...{procedure TXPImage.Continue;


begin


IF FshowPic<> nil then


begin


FActive:= true;


FshowPic.Resume;


end;


end;




procedure TXPImage.Pause;


begin


IF FshowPic<> nil then


FActive:= false;


end;}






...{ TShowPicture }




constructor TShowPicture.Create(Aowner: TXPImage);


begin


inherited Create(false);


FItem := Aowner;


Fidx := 0;


FreeOnTerminate := true;


end;




procedure TShowPicture.Execute;


//var


// nTickCount: Cardinal;


begin


inherited;


while not Terminated do


begin


if FItem.Active then


begin


//Application.ProcessMessages;




synchronize(SetPicture); ...{注意此处}


Fidx := Fidx + 1;


if Fidx >= FItem.FImageList.Count then


Fidx := 0;


if terminated then


exit;


//Item.;


Sleep(FItem.FInterval);




// nTickCount := GetTickCount;


// while FItem.Active and (GetTickCount - nTickCount < FItem.FInterval) do


// Application.ProcessMessages;


end


else


begin


Suspend;


end;


end;


end;




procedure TShowPicture.SetPicture;


var


sMsg: string;


begin




//SendMethodEnter(Format('“%s” 播放动画中的设置图片', [FItem.Image.Caption]));


if FItem.Imgbmp <> nil then


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


on E: Exception do


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.