Вопрос по – Как сделать функцию таймера одного выстрела в Delphi (например, setTimeout в JavaScript)?

19

setTimeout полезно на языке JavaScript. Как бы вы создали эту функцию в Delphi?

SetTimeOut(procedure (Sender: TObject);
begin
  Self.Counter := Self.Counter + 1;
end, 200);
Я не могу понять это. Не могли бы вы попытаться уточнить, пожалуйста. David Heffernan
Вы хотите быстрый и грязный таймер с одним выстрелом. И затем вы можете обернуть его в функцию setTimeout для удобства. David Heffernan

Ваш Ответ

4   ответа
1

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 есть новый нереальный способ сделать это, я об этом не знаю.

нет я хочу использоватьanonymous function, Ваш код использует указатель метода. MajidTaheri
24

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.


Simplified version (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.
Извините меня пожалуйста. Пропустил перерыв. +1. Я бы переместил объявление класса в раздел реализации для лучшей инкапсуляции.
Вам нужно запустить этот цикл в обратном направлении, потому что вы удаляете из списка, по которому вы перебираете
+1 это зло! (:
Это действительно интересный кусок кода, хорошо сделано!
отдельный блок и словарь вместо списка объектов будет идеальным
0

что функция должна вызываться один раз, а не 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).

0

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

  // put here what you want to do

end).Start;

Похожие вопросы