用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.