Using VCL TTimer in Delphi console application

后端 未结 3 1994
走了就别回头了
走了就别回头了 2021-02-04 09:14

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

相关标签:
3条回答
  • 2021-02-04 09:57

    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.

    0 讨论(0)
  • 2021-02-04 10:04

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

    0 讨论(0)
  • 2021-02-04 10:10

    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.
    
    0 讨论(0)
提交回复
热议问题