MajidTaheri
MajidTaheri

Reputation: 3983

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

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);

Upvotes: 23

Views: 8055

Answers (5)

Aleksey Aleshkov
Aleksey Aleshkov

Reputation: 1

My implementation of OneShotTimer Unit, with crossplatform support, tested with Delphi XE8, firemonkey

unit OneShotTimerUnit;

interface

uses System.SysUtils, System.Classes, FMX.Types;

// TOneshotTimer class by Aleshkov A.F.
//
// Use one of two constructors:
//
// 1. TOneShotTimer.Create(Owner, Interval, NotifyEvent)
// creates timer with link to NotifyEvent - procedure of object
//
// 2. TOneShotTimer.Create(Owner, Interval, Proc)
// creates timer with link to Procedure (without object)
// you also can use construction like a
// TOneShotTimer.Create(Form1,1000,procedure
// begin
// {Do something}
// end);
// 
// *append. answer to @delphirules. What to do if necessary 
// to call function or procedure with parameters? 
// You can use construction like a:
// TOneShotTimer.Create(Form1,1000,procedure
// begin {Your function or procedure with parameters} end);
//
// TOneShotTimer.Create(Form1,1000,beep); //this example make a system sound after 1 sec
//
// TOneShotTimer selfdestroy after interval
// you dont need to call 'Free' method, but if close your app before timer is finished
// and Owner of timer is nil or non-existent object - you get memory leak
// so, always set Owner reference to main form of your application
//
// You also can create SetTimeout method in your form
//
// procedure TForm1.SetTimeout(AInterval: Cardinal; proc: TProc);
// begin
//   TOneshotTimer.Create(self,AInterval,proc);
// end;

type
  TOneShotTimer = class(TTimer)
  private
    FProc:TProc;
    procedure DefaultEvent(Sender:TObject);
  protected
    procedure DoOnTimer; override;
  public
    constructor Create(AOwner: TComponent; AInterval:Cardinal; AEvent:TNotifyEvent); reintroduce; overload;
    constructor Create(AOwner: TComponent; AInterval:Cardinal; AProc:TProc); reintroduce; overload;
  end;


implementation

{ TOneShotTimer }

constructor TOneShotTimer.Create(AOwner: TComponent; AInterval:Cardinal;
  AEvent: TNotifyEvent);
begin
  inherited Create(AOwner);
  Interval:=AInterval;
  OnTimer:=AEvent;
  Enabled:=true;
end;

constructor TOneShotTimer.Create(AOwner: TComponent; AInterval: Cardinal;
  AProc: TProc);
begin
  inherited Create(AOwner);
  Interval:=AInterval;
  FProc:=AProc;
  OnTimer:=DefaultEvent;
  Enabled:=true;
end;

procedure TOneShotTimer.DefaultEvent(Sender: TObject);
begin
  if assigned(FProc) then FProc;
end;

procedure TOneShotTimer.DoOnTimer;
begin
  inherited;
  self.Free;
end;


end.

Upvotes: 0

Pedro Souza
Pedro Souza

Reputation: 182

I usually do this way

TThread.CreateAnonymousThread(procedure begin
  Sleep(1000); // timeout

  // put here what you want to do

end).Start;

Upvotes: 1

Arioch 'The
Arioch 'The

Reputation: 16065

Assuming, the function is to be called once and not 5 times every second, maybe like that:

 Parallel.Async( 
       procedure; begin
           Sleep(200);
           Self.Counter:=Self.Counter+1; end; );

There are more complex solutions like the one you accepted, taking named objects for timer actions and using SetTimer method. Like http://code.google.com/p/omnithreadlibrary/source/browse/trunk/tests/17_MsgWait/test_17_MsgWait.pas Previous versions had SetTimer with anonymous function, but they are gone now.

However for simplistic anonymous closure approach you asked for, maybe Wait(xxX) would fit.

Upvotes: 0

TLama
TLama

Reputation: 76713

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.

Upvotes: 31

Toby Allen
Toby Allen

Reputation: 11211

Something like

type
TMyProc = Procedure of Object(Sender: TObject);

TMyClass = Object
    HandlerList = TStringList;
    TimerList = TStringlist;

  Procedure CallThisFunction(Sender :TObject); 

  function setTimeout(Timeout: Integer; ProcToCall : TMyProc)

end;






function setTimeout(Timeout: Integer; ProcToCall : TMyProc)
var
  Timer : TTimer;
begin

  Timer := TTimer.Create(nil);
  Timer.OnTimer := CallOnTimer;
  Timer.Interval := Timeout;
  Timer.Enabled := true;
  HandlerList.AddObject(ProcToCall);
  TimerList.AddObject(ProcToCall);

end;


function CallOnTimer(Sender : TObject)
var TimerIndex : Integer;
    HandlerToCall : TMyProc;
    Timer : TTimer;
begin

TimerIndex :=   TimerList.IndexOfObject(Sender);
HandlerToCall := (HandlerList.Objects[TimerIndex] as TMyProc) ;

HandlerToCall(Self);

HandlerList.Delete(TimerIndex);
Timer := (TimerList.Objects(TimerIndex) as TTimer);
Timer.Free;
TimerList.Delete(TimerIndex);


end;

This has just been hacked together and not tested in any way but shows the concept. Basically build a list of the timers and procedures you want to call. As it is the self object is passed to the procedure when it is called but you could build a third list that contained the object to be used as a parameter in the call to setTimeout.

The Objects are then cleaned up by freeing after the method has been called.

Not quite the same as javascripts setTimeout but a delphi approximation.

ps. I haven't really moved on from Delphi7 so if there is a new fangled way of doing this in Delphi XE I don't know about it.

Upvotes: 1

Related Questions