如何在 Delphi 中创建一个定时器函数(就像JavaScript中的setTimeout)?

eni9jsuy  于 2022-12-03  发布在  Java
关注(0)|答案(5)|浏览(307)

setTimeout在JavaScript语言中很有帮助。你会如何在 Delphi 中创建这个函数?

SetTimeOut(procedure (Sender: TObject);
begin
  Self.Counter := Self.Counter + 1;
end, 200);
7hiiyaii

7hiiyaii1#

我想你可以保持TTimer不变,尝试使用SetTimer函数和它的回调函数。你需要在某个集合中存储定时器ID和它们的(匿名)方法。由于你没有提到你的 Delphi 版本,我使用了一个简单的类和TObjectList作为集合。
原理很简单,您只需调用SetTimer函数并指定回调函数,然后使用匿名方法将新示例化的系统计时器ID存储到集合中。当执行回调函数时,通过其ID在集合中找到导致回调的计时器,将其杀死,执行匿名方法并将其从集合中删除。以下是示例代码:

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以上):

正如@大卫的注解所建议的,这里的代码与上面的代码相同,只是在一个单独的单元中使用了泛型字典。这个单元中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.
omhiaaxx

omhiaaxx2#

比如

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;

这是一个刚刚被破解的程序,没有经过任何测试,但它展示了这个概念。基本上,建立一个你想要调用的定时器和过程的列表。当self对象被调用时,它被传递给过程,但是你可以建立第三个列表,其中包含在setTimeout调用中作为参数使用的对象。
然后在呼叫方法之后,借由释放来清除对象。
与javascripts setTimeout不太一样,但它是一个 Delphi 近似值。
附言:我还没有真正从Delphi7中走出来,所以如果在Delphi XE中有一种新的新奇的方法来做这件事,我不知道。

ifsvaxew

ifsvaxew3#

假设函数每秒被调用一次,而不是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)适合。

cqoc49vn

cqoc49vn4#

我通常这样做

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

  // put here what you want to do

end).Start;
vwkv1x7d

vwkv1x7d5#

我实现的OneShotTimer单元,具有跨平台支持,用 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(Form1,1000,procedure
// begin
// {Do something}
// 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.

相关问题