用delphi编写图片播放组件2022-04-22 12:39:51 ...{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 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;interfaceuses 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;implementationuses 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;beginIF FshowPic<> nil thenbeginFActive:= true;FshowPic.Resume;end;end;procedure TXPImage.Pause;beginIF FshowPic<> nil thenFActive:= 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. 上一篇：DOM基础实例下一篇：Delphi中实现变长函数笔记