In response to a QC report I wrote early last year I decided to implement a LoopCount property on the TFloatAnimation component.
Report No: 105140 Status: Open
Add a LoopCount property to the TAnimation class
TJSCustomLoopCountFloatAnimation = class(TFloatAnimation)
TAnimationLoopEvent = reference to procedure (Sender: TObject; const LoopNumber: Integer; var Cancel: Boolean);
procedure FirstFrame; override;
procedure DoLoop(var ACancel: Boolean); virtual;
procedure ProcessAnimation; override;
constructor Create(AOwner: TComponent); override;
property LoopCount: Integer read FLoopCount write FLoopCount default 3;
property OnLoop: TAnimationLoopEvent read FOnLoop write FOnLoop;
Nothing that interesting in the new descendant. New property called LoopCount to control the number of loops and a new event that gets triggered each time a loop completes.
The published component publishes the new property and event but also changes the default values for two existing properties. It makes sense to set Loop to true when the new class is for enhancing the looping ability and if you’re looping, generally AutoReverse will be set to true.
TJSLoopCountFloatAnimation = class(TJSCustomLoopCountFloatAnimation)
property AutoReverse default True;
property Loop default True;
I won’t post all of the code here because you can download from the link provided below, just a couple of snippets.
We need to override the FirstFrame method to initialise a couple of variables we use.
- Checking to see if the LoopCount property is valid (raise an exception if it isn’t)
- Initialise the variable to zero that counts the interactions
- Make sure we are going to be checking the animation process for loops
Most of the work occurs in the overridden ProcessAnimation method.
if FCheckingLooping then
LType := LCtx.GetType(Self.ClassInfo);
if Assigned(LType) then
LField := LType.GetField('FTime');
if LField <> nil then
if LField.GetValue(Self).AsExtended = 0 then
LCancel := False;
if FLoopsComplete > 1 then
// The first time through, FTime is 0 so we need to offset this by
// adding 1 when checking for completion
if LCancel or (FLoopsComplete = LoopCount + 1) then
LField := LType.GetField('FRunning');
if LField <> nil then
Thanks to extended RTTI we can access a couple of private fields that we need to determine if a loop has been completed. This occurs when the FTime variable is zero. There is one issue with using this value and that is that the first “Loop” should be ignored since the first time ProcessAnimation is called FTime is zero so by the logic used, a loop has completed. This is why the DoLoop method is only called if the FLoopsComplete variable is greater than one.
Naturally it is possible to handle this one-off situation differently using a “First Time Through” variable but under the circumstances, I decided to go with the solution in place.
Once the LoopsComplete value is one greater than the LoopCount (refer to the above two paragraphs if you’ve already forgotten about why) the private field FRunning is set to False. Setting FRunning to false, stops the animation immediately.
Why not just call the public Stop method instead of going to the trouble of setting a private field? The answer to that is found in the ProcessTick method of the animation control (incidently, why isn’t this method virtual?).
ProcessAnimation; // <==== We set FRunning to false here
if not FRunning then
if Assigned(AniThread) then
By setting FRunning to false within our ProcessAnimation override, we are avoiding another frame being processed before the animation is stopped. This is because the Stop method calls ProcessAnimation and DoProcess as well.
You can download the component and a cheesy demo application from the link provided. There is no package for the component to install it into your IDE, this is left as an exercise for the reader .
Loop Animation Demo (short video – 39KB)
Download LoopCount Component and Demo
NOTE: Before downloading the source code you must agree to the license displayed below.
This space intentionally left blank…