Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

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

SetTimeOut(procedure (Sender: TObject); begin   Self.Counter := Self.Counter + 1; end, 200); 
like image 941
MajidTaheri Avatar asked May 06 '12 06:05

MajidTaheri


1 Answers

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<UINT_PTR, TOnTimerProc>;  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<UINT_PTR, TOnTimerProc>.Create; finalization   TimerList.Free;  end. 
like image 124
TLama Avatar answered Sep 29 '22 02:09

TLama