How to make one shot timer function in Delphi (like setTimeout in JavaScript)?

后端 未结 4 1895
广开言路
广开言路 2020-12-25 14:30

The setTimeout is helpful in JavaScript language. How would you create this function in delphi ?

SetTimeOut(procedure (Sender: TObject);
begin
  Self.Counter         


        
4条回答
  •  南方客
    南方客 (楼主)
    2020-12-25 15:13

    I think you may leave the TTimer as it is and try to use the SetTimer function and use its callback function. You need to store the timer IDs and their (anonymous) methods in some collection. Since you didn't mentioned your Delphi version I've used a simple classes and TObjectList as a collection.

    The principle is easy, you just call the SetTimer function with the callback function specified and store the new instantiated system timer ID with the anonymous method into the collection. When that callback function is performed, find the timer which caused that callback in the collection by its ID, kill it, execute the anonymous method and delete it from the collection. Here is the sample code:

    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls, StdCtrls, Contnrs;
    
    type
      TOnTimerProc = reference to procedure;
      TOneShotTimer = class
        ID: UINT_PTR;
        Proc: TOnTimerProc;
      end;
      procedure SetTimeout(AProc: TOnTimerProc; ATimeout: Cardinal);
    
    type
      TForm1 = class(TForm)
        Timer1: TTimer;
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
      TimerList: TObjectList;
    
    implementation
    
    {$R *.dfm}
    
    procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
      dwTime: DWORD); stdcall;
    var
      I: Integer;
      Timer: TOneShotTimer;
    begin
      for I := 0 to TimerList.Count - 1 do
      begin
        Timer := TOneShotTimer(TimerList[I]);
        if Timer.ID = idEvent then
        begin
          KillTimer(0, idEvent);
          Timer.Proc();
          TimerList.Delete(I);
          Break;
        end;
      end;
    end;
    
    procedure SetTimeout(AProc: TOnTimerProc; ATimeout: Cardinal);
    var
      Timer: TOneShotTimer;
    begin
      Timer := TOneShotTimer.Create;
      Timer.ID := SetTimer(0, 0, ATimeout, @TimerProc);
      Timer.Proc := AProc;
      TimerList.Add(Timer);
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      SetTimeout(procedure
        begin
          ShowMessage('OnTimer');
        end,
        1000
      );
    end;
    
    initialization
      TimerList := TObjectList.Create;
      TimerList.OwnsObjects := True;
    
    finalization
      TimerList.Free;
    
    end.
    


    Simplified version (Delphi 2009 up):

    Like suggested by @David's comment, here is the same code as above, just in a separate unit with the use of generics dictionary. Usage of the SetTimeout from this unit is same as in the above code:

    unit OneShotTimer;
    
    interface
    
    uses
      Windows, Generics.Collections;
    
    type
      TOnTimerProc = reference to procedure;
      procedure SetTimeout(AProc: TOnTimerProc; ATimeout: Cardinal);
    
    var
      TimerList: TDictionary;
    
    implementation
    
    procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
      dwTime: DWORD); stdcall;
    var
      Proc: TOnTimerProc;
    begin
      if TimerList.TryGetValue(idEvent, Proc) then
      try
        KillTimer(0, idEvent);
        Proc();
      finally
        TimerList.Remove(idEvent);
      end;
    end;
    
    procedure SetTimeout(AProc: TOnTimerProc; ATimeout: Cardinal);
    begin
      TimerList.Add(SetTimer(0, 0, ATimeout, @TimerProc), AProc);
    end;
    
    initialization
      TimerList := TDictionary.Create;
    finalization
      TimerList.Free;
    
    end.
    

提交回复
热议问题