Compile the image playback component in 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;... {number displayed at the time}
// I: integer;
Fitem: txpimage;
Protected
Procedure execute; override;
Public
Procedure setpicture;
Constructor create (aowner: txpimage );
End;

Txpimage = Class (tcomponent)
Private
Factive: Boolean; // whether or not it is activated
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;
// Create a thread
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);... {Note here}
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 (set image in '% s' playing animation ', [fitem. image. Caption]);
If fitem. imgbmp <> nil then
Begin
Try
// Senddebug ('start retrieving images from imagelist ');
Fitem. fimagelist. getbitmap (fidx, fitem. imgbmp );
// Senddebug ('get the image from imagelist ');
// Fitem. fimagelist. getbitmap (fidx, fitem. fimage. Picture. Bitmap );
// Senddebug ('start from giving the image to cutline ');
Fitem. image. setimage (fitem. imgbmp );
// Senddebug ('finish the slave image to the cutline image ');
// Senddebug ('start refreshing cutline ');
// Fitem. fimage. Refresh;
// Senddebug ('refresh cutline ');
Application. processmessages;
Except
On E: exception do
Begin
Smsg: = format ('error location: [% s] class: [% s] Name: [% s] Error class: [% s] error message: [% s] ',
['Playing animations ', classname, fitem. image. Caption, E. classname, E. Message]);
Senddebugex (smsg, mterror );
Writelog (smsg );
End;
End;
End;
// Sendmethodexit (format (set image in '% s' playing animation ', [fitem. image. Caption]);
// Sendseparator;

End;

End.