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