如何在Delphi中制作一次定时器功能(如JavaScript中的setTimeout)？

Question

这setTimeout在JavaScript语言中很有用.你会如何在delphi中创建这个函数？

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

Answer 1

我想你可能会保持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 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.