如何在Delphi中进行一次性定时器功能(如JavaScript中的setTimeou

原理很简单,您只需使用指定的回调函数调用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,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.

简化版(Delphi2009)：

像@ 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,@TimerProc),AProc);
end;

initialization
  TimerList := TDictionary<UINT_PTR,TOnTimerProc>.Create;
finalization
  TimerList.Free;

end.