Reputation: 3983
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
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
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
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
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
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