setTimeout
полезен в языке JavaScript. Как бы вы создали эту функцию в delphi?
SetTimeOut(procedure (Sender: TObject);
begin
Self.Counter := Self.Counter + 1;
end, 200);
setTimeout
полезен в языке JavaScript. Как бы вы создали эту функцию в delphi?
SetTimeOut(procedure (Sender: TObject);
begin
Self.Counter := Self.Counter + 1;
end, 200);
Я думаю, вы можете оставить TTimer
как есть и попытаться использовать SetTimer
и используйте функцию обратного вызова. Вам нужно сохранить идентификаторы таймера и их (анонимные) методы в некоторой коллекции. Поскольку вы не упомянули свою версию Delphi, я использовал простые классы и TObjectList
в качестве коллекции.
Принцип прост: вы просто вызываете функцию SetTimer
с указанной функцией обратного вызова и сохраняете новый идентификатор системного таймера с помощью анонимный метод в коллекцию. Когда эта функция обратного вызова выполняется, найдите таймер, вызвавший этот обратный вызов в коллекции по его идентификатору, убейте его, выполните анонимный метод и удалите его из коллекции. Вот пример кода:
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.
Упрощенная версия (Delphi 2009 up):
Как и предложено комментарием @David, вот тот же код, что и выше, только в отдельном блоке с использованием дженерикового словаря. Использование SetTimeout
от этого устройства такое же, как в приведенном выше коде:
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.
Что-то вроде
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;
Это только что было взломано и не протестировано каким-либо образом, но показывает концепцию. В основном создайте список таймеров и процедур, которые вы хотите вызвать. Поскольку сам объект передается процедуре, когда он вызывается, но вы можете создать третий список, содержащий объект, который будет использоваться в качестве параметра при вызове setTimeout.
Затем объекты очищаются путем освобождения после вызова метода.
Не совсем то же, что и javascripts setTimeout, но приближение delphi.
пс. Я действительно не перешел от Delphi7, поэтому, если в Delphi XE появился новый обманутый способ, я не знаю об этом.
Предполагая, что функция должна вызываться один раз, а не 5 раз в секунду, может быть, так:
Parallel.Async(
procedure; begin
Sleep(200);
Self.Counter:=Self.Counter+1; end; );
Существуют более сложные решения, такие как принятые вами, взятие именованных объектов для действий таймера и использование метода SetTimer. Например http://code.google.com/p/omnithreadlibrary/source/browse/trunk/tests/17_MsgWait/test_17_MsgWait.pas Предыдущие версии имели SetTimer с анонимной функцией, но теперь они ушли.
Однако для упрощенного подхода анонимного закрытия, который вы просили, возможно, Wait (xxX) будет соответствовать.
Я обычно делаю этот путь
TThread.CreateAnonymousThread(procedure begin
Sleep(1000); // timeout
// put here what you want to do
end).Start;