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.

Answer 2

像

这样的东西

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近似相同。

PS。我还没有真正从Delphi7开始，所以如果在Delphi XE中有一种新的方式，我不知道它。

Answer 3

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

Answer 4

我通常这样做

#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <sys/wait.h>
#include <signal.h>
#include <readline/history.h>
#include <readline/readline.h>
#include "flush.h"
#include "env.h"
#include "fget.h"

char * flush_builtins[] =
{
  "cd",
  "help",
  "exit",
  "ver",
  "fget"
};

int flush_num_builtins() {
  return sizeof(flush_builtins) / sizeof(char *);
}

int (*flush_func[]) (char **) =
{
  &flush_cd,
  &help,
  &exit_flush,
  &ver,
  &fget
};

static int flush_startp(char **args)
{
  pid_t pid;
  int status;
  pid = fork();
  if (pid == 0)
  {
    if (execvp(args[0], args) == -1)
    {
      fprintf(stderr, "flush: command not found\n");
    }
    exit(1);
  }
  else if (pid < 0)
  {
    fprintf(stderr, "flush: command not found\n");
  }
  else
  {
    do
    {
      waitpid(pid, &status, WUNTRACED);
    } while (!WIFEXITED(status) && !WIFSIGNALED(status));
  }

  return 1;
}

static int flush_exec(char **args)
{
  int i;

  if (args[0] == NULL)
  {
    return 1;
  }

  for (i = 0; i < flush_num_builtins(); i++)
  {
    if (strcmp(args[0], flush_builtins[i]) == 0) {
      return (*flush_func[i])(args);
    }
  }

  return flush_startp(args);
}

static char * flush_read(void)
{
  fflush(stdout);
  char *line_read = malloc(sizeof(char) * LINE_BUF);
  char *prompt = malloc(sizeof(char) * LINE_BUF);
  char *current, buffer[TOK_BUF];
  current = getcwd(buffer, TOK_BUF);

  strcat(prompt, get_user());
  strcat(prompt, " :: ");

  if (strcmp(current, get_home()) == 0)
  {
    strcat(prompt, "~");
  }

  else
  {
    strcat(prompt, get_cwd());
  }

  strcat(prompt, " % ");
  line_read = readline(prompt);

  if (line_read && *line_read)
  {
    add_history(line_read);
  }

  return line_read;
  free(prompt);
  free(line_read);
  free(current);
}

static char **flush_getargs(char * line)
{
  int bufsize = TOK_BUF;
  int i = 0;
  char **tokens = malloc(bufsize * sizeof(char *));
  char **token;

  if (!tokens)
  {
    fprintf(stderr, "allocation error\n");
    exit(1);
  }

  token = strtok(line, DELIM);
  while (token != NULL)
  {
    tokens[i] = token;
    i++;
    token = strtok(NULL, DELIM);
  }

  tokens[i] = NULL;
  return tokens;
}


static void flush_loop(void)
{
  char *line;
  char **args;
  int  status;

  do
  {
    line = flush_read();
    args = flush_getargs(line);
    status = flush_exec(args);
    free(line);
    free(args);
  } while (status);
}

static void handler(int num)
{
  signal(SIGINT, handler);
  flush_loop();
  fflush(stdout);
}

int main()
{
  init();
  signal(SIGINT, handler);
  flush_loop();
  return 0;
}

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

4 个答案: