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 T
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.
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?.
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.