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

正如问题主体所说。我在Delphi中有一个控制台应用程序，它包含一个

TTimer

变量。我想做的事情是为

TTimer.OnTimer

event分配一个事件处理程序。我对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

组件似乎无法工作。有没有办法在我的应用程序中创建计时器？

您的代码不起作用，因为

TTimer

组件内部使用

WM\u 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.

---

控制台应用程序没有消息泵，但有线程。如果您创建了一个执行该工作的线程，并在工作完成后等待下一秒，那么您应该会得到想要的结果。阅读关于TThread如何创建专用线程的文档。不过，从线程获取数据并不那么简单。这就是为什么有许多替代“原始”TThread的方法可以帮助实现这一点，比如OmniThreadLibrary。

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

这里有一个

tConsolletimer

thread类，它模拟了

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.

---

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

阅读给出答案

在

TConsoleTimer

中添加一个方法：

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

并将

Execute

方法中的调用更改为：

Synchronize(SwapToMainThread);

要启动同步调用，请在类单元中使用

CheckSynchronize（）

函数：

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

---

注意：控制台

按键功能可在此处找到：。
这是一个相当复杂的消息循环。GetMessage（）开始TranslateMessage（）时有什么问题；DispatchMessage（）；结束；就像在一个好的老式Petzold程序中一样，您也可以不发布不必要的复杂代码。事实上，您的消息循环从不空闲。您的代码运行CPU热。所有IsUnicode的东西在这里都是毫无意义的。您只托管一个窗口。您知道它是如何创建的。@DavidHeffernan-您能提供此解决方案的修复程序吗，如果确实存在问题？如果有人想简化上述消息循环，他也可以删除
TranslateMessage
调用，因为它在这里也没有意义。从线程调用
Writeln
时要小心-这些调用需要某种同步，不包括关键部分。@Serg，是的，这是正确的。但这里是一个快速演示，它是可以的。如果您将Interval设置为例如5000，并启用计时器，则事件会立即触发，然后每5秒触发一次。我希望它在5秒后开始发射第一个事件。@kobic，是的，我昨天调查时看到了。如果WaitForSingleObject（FTimerEnabledFlag，0）=WAIT_OBJECT_0然后开始，则用
将最后一部分（在sw.Start之前）括起来。。结束今天晚些时候我会修正答案。@LURD，我编辑了你的答案。我还在析构函数中添加了一个“以防万一”
Terminate
（不确定这里是否需要），并将
Execute
移动到protected部分，这样编译器就不会抱怨可见性较低。C#和Delphi之间的事件处理程序分配差异与您描述的不同。您也不能简单地将独立函数分配给C#事件。（这两种语言的原因不同，但最终的结果是相同的。在C#中，这是因为首先不能声明独立函数；在Delphi中，这是因为独立函数与方法不同。）一种简单的方法是让线程中有一个循环，循环中有一个Sleep（）等待所需时间流逝的。
while not KeyPressed do CheckSynchronize(); // Pump the synchronize queue