Anonymous Timer and FireMonkey

I guess that everyone knows the good old timer and its OnTimer event. There is a timer for the VCL and for FireMonkey as well which are nearly similar.
In both timers there is one thing missing: I would like to use an anonymous method for the OnTimer event instead of the old TNotifyEvent. The reason for this is that anonymous methods capture variables.
Since Delphi doesn’t offer this feature let’s implement it ourself.
Let’s start with a new unit and we will derive from the existing TTimer.

unit FMX.Types.AnonymousTimer;

interface

uses
  System.SysUtils, System.Classes, FMX.Types;

type
  TTimer = class(FMX.Types.TTimer)
  ...
  end;

I’m using the same classname for the new timer because then it is possible to use it without registering a new component. I will show this trick later.
First, let’s add a property for the anonymous method.

...
  TTimer = class(FMX.Types.TTimer)
  strict private
    FOnTimerA: TProc;
    ...
  public
    property OnTimerA: TProc read FOnTimerA write FOnTimerA;
  end;

After we added the new property we have to call it. That’s why I will override the DoOnTimer method.

...
  TTimer = class(FMX.Types.TTimer)
  strict private
    FOnTimerA: TProc;
  strict protected
    procedure DoOnTimer; override;
  public
    property OnTimerA: TProc read FOnTimerA write FOnTimerA;
  end;

implementation

{ TTimer }

procedure TTimer.DoOnTimer;
begin
  if Assigned(FOnTimerA) then
    FOnTimerA
  else
    inherited DoOnTimer;
end;

Now, we have a small problem: Delphi only creates the underlying timer object of the operation system if the OnTimer event of a TTimer is assigned. You can see this in the unit FMX.Types.

unit FMX.Types;
...
procedure TTimer.UpdateTimer;
begin
  KillTimer;
  if (FEnabled) and (FInterval > 0) and 
    (([csDesigning, csLoading, csDestroying] * ComponentState = [])) and
    Assigned(FOnTimer) then
  begin
    ...
  end;
  ...
end;

That’s why we need a dummy OnTimer event.

unit FMX.Types.AnonymousTimer;

interface

uses
  System.SysUtils, System.Classes, FMX.Types;

type
  TTimer = class(FMX.Types.TTimer)
  strict private
    FOnTimerA: TProc;
    procedure OnTimerDummy(Sender: TObject);
  strict protected
    procedure DoOnTimer; override;
  public
    constructor Create(AOwner: TComponent); override;
    property OnTimerA: TProc read FOnTimerA write FOnTimerA;
  end;

implementation

{ TTimer }

constructor TTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  OnTimer := OnTimerDummy;
end;

procedure TTimer.DoOnTimer;
begin
  if Assigned(FOnTimerA) then
    FOnTimerA
  else
    inherited DoOnTimer;
end;

procedure TTimer.OnTimerDummy(Sender: TObject);
begin
  //This is only a dummy event so that the OnTimer event is assigned.
end;

end.

Okay, that’s it. Now we have a TTimer with an anonymous method. I guess we should use it then. 🙂

We simply create a form, put two labels and a normal timer on it. Then we add the unit FMX.Types.AnonymousTimer to the uses clause after the unit FMX.Types. The designer now creates a normal timer and we can set all the normal timer properties.

At runtime the compiler replaces the normal timer with our new one because the last unit in the uses clause has the highest visibility. This trick only works because we added no published properties to our new timer component.

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
  FMX.StdCtrls, FMX.Types.AnonymousTimer;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  I := 0;
  Timer1.OnTimerA := procedure
  begin
    Inc(I);
    if I > 100 then
      I := 0;
    Label1.Text := I.ToString;
  end;
end;

end.

The result is a label which shows the expired seconds until 100.

This entry was posted in FireMonkey, Tips and Tricks and tagged , . Bookmark the permalink.