Using VCL TTimer in Delphi console application

Question

As the question subject says. I have a console application in Delphi, which contains a TTimer variable. The thing I want to do is assign an event handler to TTimer.OnTimer event. I am totally new to Delphi, I used to use C# and adding the event handlers to events is totally different. I have found out that one does not simply assign a procedure to event as a handler, you have to create a dummy class with a method which will be the handler, and then assign this method to the event. Here is the code I currently have:

program TimerTest;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  extctrls;

type
  TEventHandlers = class
    procedure OnTimerTick(Sender : TObject);
  end;

var
  Timer : TTimer;
  EventHandlers : TEventHandlers;


procedure TEventHandlers.OnTimerTick(Sender : TObject);
begin
  writeln('Hello from TimerTick event');
end;

var
  dummy:string;
begin
  EventHandlers := TEventHandlers.Create();
  Timer := TTimer.Create(nil);
  Timer.Enabled := false;
  Timer.Interval := 1000;
  Timer.OnTimer := EventHandlers.OnTimerTick;
  Timer.Enabled := true;
  readln(dummy);
end.

It seems correct to me, but it does not work for some reason.

EDIT
It appears that the TTimer component won't work because console applications do not have the message loop. Is there a way to create a timer in my application?

Riddell

The event-handler-assignment differences between C# and Delphi are not as you describe. You can't simply assign a standalone function to a C# event, either. (The reasons are different in the two languages, but the net result is the same. In C#, it's because you can't declare standalone functions in the first place; in Delphi, it's because standalone functions aren't the same as methods.) – Catachresis

Answer 1

Your code does not work because TTimer component internally uses WM_TIMER message processing and a console app does not have a message loop. To make your code work you should create a message pumping loop yourself:

program TimerTest;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows,
  extctrls;

type
  TEventHandlers = class
    procedure OnTimerTick(Sender : TObject);
  end;

var
  Timer : TTimer;
  EventHandlers : TEventHandlers;


procedure TEventHandlers.OnTimerTick(Sender : TObject);
begin
  writeln('Hello from TimerTick event');
end;

procedure MsgPump;
var
  Unicode: Boolean;
  Msg: TMsg;

begin
  while GetMessage(Msg, 0, 0, 0) do begin
    Unicode := (Msg.hwnd = 0) or IsWindowUnicode(Msg.hwnd);
    TranslateMessage(Msg);
    if Unicode then
      DispatchMessageW(Msg)
    else
      DispatchMessageA(Msg);
  end;
end;

begin
  EventHandlers := TEventHandlers.Create();
  Timer := TTimer.Create(nil);
  Timer.Enabled := false;
  Timer.Interval := 1000;
  Timer.OnTimer := EventHandlers.OnTimerTick;
  Timer.Enabled := true;
  MsgPump;
end.

Dinky

That's a rather complex message loop. What's wrong with while GetMessage() do begin TranslateMessage(); DispatchMessage(); end; like in a good old fashioned Petzold program? – Snakeroot

You may as well not propogate needlessly complex code. And indeed your message loop never goes idle. Your code runs the CPU hot. – Snakeroot

All the IsUnicode stuff is pointless here. You are only hosting one window. You know how it was created. – Snakeroot

I prefer to leave it as is as a standard message loop template – Dinky

@DavidHeffernan - Can you provide a fix to this solution, if there is indeed a problem? – Astrix

@Leonardo There's no problem to be fixed. IsUnicode will always evaluate to True in modern Unicode Delphi. My point is just that this message loop is needlessly complicated, in my view. – Snakeroot

If somebody want to simplify the above message loop he can also remove TranslateMessage call cause it is pointless here too. – Dinky

question. if i open the console app 20 times does the timer will work on all apps? or there is a conflict? – Flickinger

FMX.Types.TTimer Vcl.ExtCtrls.TTimer how you can include ttimer in console? this code is not working i think. – Flickinger

Answer 2

As others have mentioned, console applications don't have a message pump.

Here is a TConsoleTimer thread class which mimics a TTimer class. The main difference is that the code in the event is executed in the TConsoleTimer thread.

Update

At the end of this post is a way to have this event called in the main thread.

unit ConsoleTimer;

interface

uses
  Windows, Classes, SyncObjs, Diagnostics;

type
  TConsoleTimer = Class(TThread)
  private
    FCancelFlag: TSimpleEvent;
    FTimerEnabledFlag: TSimpleEvent;
    FTimerProc: TNotifyEvent; // method to call
    FInterval: integer;
    procedure SetEnabled(doEnable: boolean);
    function GetEnabled: boolean;
    procedure SetInterval(interval: integer);
  protected
    procedure Execute; override;
  public
    Constructor Create;
    Destructor Destroy; override;
    property Enabled : boolean read GetEnabled write SetEnabled;
    property Interval: integer read FInterval write SetInterval;
    // Note: OnTimerEvent is executed in TConsoleTimer thread
    property OnTimerEvent: TNotifyEvent read FTimerProc write FTimerProc;
  end;

implementation

constructor TConsoleTimer.Create;
begin
  inherited Create(false);
  FTimerEnabledFlag := TSimpleEvent.Create;
  FCancelFlag := TSimpleEvent.Create;
  FTimerProc := nil;
  FInterval := 1000;
  Self.FreeOnTerminate := false; // Main thread controls for thread destruction
end;

destructor TConsoleTimer.Destroy; // Call TConsoleTimer.Free to cancel the thread
begin
  Terminate; 
  FTimerEnabledFlag.ResetEvent; // Stop timer event
  FCancelFlag.SetEvent; // Set cancel flag
  Waitfor; // Synchronize
  FCancelFlag.Free;
  FTimerEnabledFlag.Free;
  inherited;
end;

procedure TConsoleTimer.SetEnabled(doEnable: boolean);
begin
  if doEnable then
    FTimerEnabledFlag.SetEvent
  else
    FTimerEnabledFlag.ResetEvent;
end;

procedure TConsoleTimer.SetInterval(interval: integer);
begin
  FInterval := interval;
end;

procedure TConsoleTimer.Execute;
var
  waitList: array [0 .. 1] of THandle;
  waitInterval,lastProcTime: Int64;
  sw: TStopWatch;
begin
  sw.Create;
  waitList[0] := FTimerEnabledFlag.Handle;
  waitList[1] := FCancelFlag.Handle;
  lastProcTime := 0;
  while not Terminated do
  begin
    if (WaitForMultipleObjects(2, @waitList[0], false, INFINITE) <>
      WAIT_OBJECT_0) then
      break; // Terminate thread when FCancelFlag is signaled
    if Assigned(FTimerProc) then
    begin
      waitInterval := FInterval - lastProcTime;
      if (waitInterval < 0) then
        waitInterval := 0;
      if WaitForSingleObject(FCancelFlag.Handle,waitInterval) <> WAIT_TIMEOUT then
        break;

      if WaitForSingleObject(FTimerEnabledFlag.Handle, 0) = WAIT_OBJECT_0 then
      begin
        sw.Start;
        FTimerProc(Self);
        sw.Stop;
        // Interval adjusted for FTimerProc execution time
        lastProcTime := sw.ElapsedMilliSeconds;
      end;
    end;
  end;
end;

function TConsoleTimer.GetEnabled: boolean;
begin
  Result := (FTimerEnabledFlag.Waitfor(0) = wrSignaled);
end;

end.

And a test:

program TestConsoleTimer;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,ConsoleTimer;

type
  TMyTest = class
    procedure MyTimerProc(Sender: TObject);
  end;

procedure TMyTest.MyTimerProc(Sender: TObject);
begin
  // Code executed in TConsoleTimer thread !
  WriteLn('Timer event');
end;

var
  MyTest: TMyTest;
  MyTimer: TConsoleTimer;
begin
  MyTest := TMyTest.Create;
  try
    MyTimer := TConsoleTimer.Create;
    MyTimer.Interval := 1000;
    MyTimer.OnTimerEvent := MyTest.MyTimerProc;
    WriteLn('Press [Enter] key to end.');
    MyTimer.Enabled := true;
    ReadLn;
    MyTimer.Free;
  finally
    MyTest.Free;
    WriteLn('End.');
  end;
end.

---

As mentioned above, how do I make the event execute in the main thread?

Reading Delphi 7: Handling events in console application (TidIRC) gives the answer.

Add a method in TConsoleTimer:

procedure TConsoleTimer.SwapToMainThread;
begin
  FTimerProc(Self);
end;

and change the call in the Execute method to:

Synchronize(SwapToMainThread);

To pump the synchronized calls, use CheckSynchronize() function in Classes unit:

while not KeyPressed do CheckSynchronize(); // Pump the synchronize queue

Note: the console KeyPressed function can be found here:How i can implement a IsKeyPressed function in a delphi console application?.

Foredate

be careful with calling Writeln from threads - these calls require some kind of synchronization, ex critical section. – Dinky

@Serg, yes that is true. But here for a quick demonstration it's ok. – Foredate

If you set Interval to e.g. 5000, and enable the timer, the event is fired immediately and only then triggers every 5 sec. I would expect it to begin fire the first event after 5 sec. – Pinup

@LURD, thanks. but now if I set Enabled := false right after the first 5 sec, it will trigger another event after 5 sec. – Pinup

@kobic, Yes, I saw that when investigating yesterday. Enclose the last part (before sw.Start) with if WaitForSingleObject(FTimerEnabledFlag,0) = WAIT_OBJECT_0 then begin .. end; I'll fix the answer later today. – Foredate

@LURD, I edited your answer. I also added a "just in case" Terminate in the destructor (not sure if it's needed here), and moved Execute to the protected section, so the compiler won't complain about lower visibility. – Pinup

@LURD, inspired by your excelent code, can you please take a look (and review) at: codereview.stackexchange.com/questions/153819/… – Pinup

@LURD great example. I have used it for a test example. The only addition that i have made, is to call sw.Reset, in order to keep the circle of the timer stable. – Kwashiorkor

Answer 3

Console applications don't have a message pump, but do have threads. If you create a thread that does the work and waits for the next second when the work is done, you should get the result you want. Read the documentation about TThread how to create a dedicated thread. Getting data to and from a thread is less straightforward though. That's why there are a number of alternatives to the 'raw' TThread that help with this, like OmniThreadLibrary.

Prevot

An easy way is to just have a thread with a loop in it, and in the loop is a Sleep() that waits for the desired time to elapse. – Zagreb