在Delphi控制台应用程序中使用VCL TTimer

Question

如主题所述，我在Delphi中有一个控制台应用程序，其中包含一个TTimer变量。我的目标是将一个事件处理程序分配给TTimer.OnTimer事件。我完全不熟悉Delphi，我曾经使用C＃，将事件处理程序添加到事件中完全不同。我发现不能简单地将过程指定为事件处理程序，必须创建一个带有方法的虚拟类，这个方法将成为处理程序，然后将该方法分配给事件。以下是我当前拥有的代码：

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.

我认为这是正确的，但由于某些原因它无法工作。

编辑
似乎TTimer组件不起作用，因为控制台应用程序没有消息循环。有没有一种方法可以在我的应用程序中创建一个定时器？

- Cracker

---

C#和Delphi之间的事件处理程序分配差异并非您所描述的那样。您不能仅仅将独立函数分配给C#事件。(两种语言的原因不同，但最终结果是相同的。在C#中，这是因为您首先无法声明独立函数；在Delphi中，这是因为独立函数与方法不同。) - Rob Kennedy

Answer 1

正如其他人所提到的，控制台应用程序没有消息泵。

这里有一个TConsoleTimer线程类，它模拟了一个TTimer类。主要区别在于事件中的代码在TConsoleTimer线程中执行。 更新 在本文末尾有一种方法可以在主线程中调用此事件。

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.

还有一个测试：

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.

---

如上所述，我该如何使事件在主线程中执行？

阅读Delphi 7：处理控制台应用程序中的事件（TidIRC）即可得到答案。

在TConsoleTimer中添加一个方法：

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

并将 Execute 方法中的调用更改为：

Synchronize(SwapToMainThread);

为了进行同步调用，请在Classes单元中使用CheckSynchronize()函数：

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

注意：控制台KeyPressed函数可以在这里找到：如何在Delphi控制台应用程序中实现IsKeyPressed函数？。

- LU RD

---

在使用线程调用Writeln时要小心 - 这些调用需要某种形式的同步，例如关键段。 - kludg

@Serg，是的，那是真的。但是在这里进行快速演示就可以了。 - LU RD

@kobic，是的，昨天调查时我看到了那个。请使用if WaitForSingleObject(FTimerEnabledFlag,0) = WAIT_OBJECT_0 then begin .. end;将最后一部分（在sw.Start之前）括起来。我稍后会修复这个答案。 - LU RD

@LURD，我编辑了你的答案。我还在析构函数中添加了一个“以防万一”的Terminate（不确定这里是否需要），并将Execute移动到受保护的部分，这样编译器就不会因为可见性降低而抱怨了。 - kobik

@LURD 很好的例子。我已经将其用作测试示例。我所做的唯一补充是调用 sw.Reset，以保持计时器的稳定循环。 - stmpakir

Answer 2

你的代码无法工作是因为TTimer组件在内部使用WM_TIMER消息处理，而控制台应用程序没有消息循环。要让你的代码工作，你应该自己创建一个消息泵循环：

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.

- kludg

---

这是一个相当复杂的消息循环。像好老式的Petzold程序中使用while GetMessage() do begin TranslateMessage(); DispatchMessage(); end;有什么问题吗？ - David Heffernan

你最好不要传播过于复杂的代码。而且你的消息循环永远不会进入空闲状态。你的代码让CPU始终高负荷运转。 - David Heffernan

我更喜欢将其保留为标准消息循环模板。 - kludg

@DavidHeffernan - 如果确实存在问题，您能否提供修复此解决方案的方法？ - Leonardo Herrera

如果有人想简化上面的消息循环，也可以删除TranslateMessage调用，因为在这里它也是无意义的。 - kludg

Answer 3

控制台应用程序没有消息泵，但有线程。如果您创建一个线程来执行工作并等待下一秒钟完成工作，那么您应该得到想要的结果。阅读有关如何创建专用线程的TThread文档。然而从线程中获取和传递数据则不太直接。这就是为什么有许多替代“原始”TThread的方法来帮助处理此问题，例如OmniThreadLibrary。

- Stijn Sanders

---

一种简单的方法是创建一个带有循环的线程，在循环中使用Sleep()函数等待所需的时间。 - dan-gph