::聽 Author錛歱engyi聽聽聽 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.
]]>