用delphi编写图片播放组件

...{ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::  Author：pengyi    Email:[e-mail]    ::
:: ::
:: 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.