Background
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
http://qc.embarcadero.com/wc/qcmain.aspx?d=105140
Class Definition
TJSCustomLoopCountFloatAnimation = class(TFloatAnimation)
public
type
TAnimationLoopEvent = reference to procedure (Sender: TObject; const LoopNumber: Integer; var Cancel: Boolean);
private
FLoopCount: Integer;
FCheckingLooping: Boolean;
FOnLoop: TAnimationLoopEvent;
protected
FLoopsComplete: Integer;
procedure FirstFrame; override;
procedure DoLoop(var ACancel: Boolean); virtual;
procedure ProcessAnimation; override;
public
constructor Create(AOwner: TComponent); override;
property LoopCount: Integer read FLoopCount write FLoopCount default 3;
property OnLoop: TAnimationLoopEvent read FOnLoop write FOnLoop;
end;
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)
published
property AutoReverse default True;
property Loop default True;
property LoopCount;
property OnLoop;
end;
Implementation
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.
procedure TJSCustomLoopCountFloatAnimation.ProcessAnimation;
var
LCtx: TRttiContext;
LType: TRttiType;
LField: TRttiField;
LCancel: Boolean;
begin
inherited;
if FCheckingLooping then
begin
LType := LCtx.GetType(Self.ClassInfo);
if Assigned(LType) then
begin
LField := LType.GetField('FTime');
if LField <> nil then
begin
if LField.GetValue(Self).AsExtended = 0 then
begin
Inc(FLoopsComplete);
LCancel := False;
if FLoopsComplete > 1 then
DoLoop(LCancel);
// 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
begin
LField := LType.GetField('FRunning');
if LField <> nil then
LField.SetValue(Self, False);
end;
end;
end;
end;
end;
end;
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
DoProcess;
if not FRunning then
begin
if Assigned(AniThread) then
TAniThread(AniThread).FAniList.Remove(Self);
DoFinish;
end;
...
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.
Download
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.
License Start
This space intentionally left blank…
License End