2012-05-06 5 views

Odpowiedz

24

Myślę, że możesz opuścić numer TTimer, tak jak jest, i spróbować użyć funkcji SetTimer i skorzystać z funkcji zwrotnej. Musisz przechowywać identyfikatory timerów i ich (anonimowe) metody w niektórych kolekcjach. Ponieważ nie wspomniałeś o swojej wersji Delphi, użyłem prostych klas i TObjectList jako kolekcji.

Zasada jest prosta, wystarczy wywołać funkcję SetTimer z określoną funkcją wywołania zwrotnego i zapisać nowy instancjonowany identyfikator zegara systemowego z anonimową metodą do kolekcji. Gdy wykonywana jest ta funkcja oddzwaniania, znajdź licznik czasu, który spowodował wywołanie zwrotne w kolekcji według jego identyfikatora, zabij go, wykonaj anonimową metodę i usuń go z kolekcji. Oto przykładowy kod:

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. 


wersja uproszczona (Delphi 2009 w górę):

jak sugeruje @ komentarz Dawida, tutaj jest ten sam kod jak wyżej, tylko w oddzielnym jednostka za pomocą słownika generycznego. Korzystanie z SetTimeout z tego urządzenia jest taka sama jak w powyższym kodzie:

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. 
+4

To naprawdę ciekawy kawałek, ładnie wykonany! – Pateman

+0

Musisz uruchomić tę pętlę do tyłu, ponieważ usuwasz z listy iterację ponad –

+0

@David, nie jest to konieczne tutaj. Usuwam tylko jeden przedmiot i przerywam pętlę. – TLama

1

Coś

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; 

To właśnie zostało przerobione i nie testowane w żaden sposób, ale przedstawia koncepcję. Zasadniczo zbuduj listę timerów i procedur, które chcesz wywołać. Ponieważ jest to obiekt własny jest przekazywany do procedury, gdy jest wywoływany, ale można zbudować trzecią listę zawierającą obiekt, który będzie używany jako parametr w wywołaniu setTimeout.

Obiekty są następnie oczyszczane przez uwolnienie po wywołaniu metody.

Nie do końca tak samo jak javascripts setTimeout, ale przybliżenie delphi.

ps. Tak naprawdę nie przeniosłem się z Delphi7, więc jeśli istnieje nowy sposób w Delphi XE, nie wiem o tym.

+0

nie, chcę użyć [funkcji anonimowej] (http://delphi.about.com/od/objectpascalide/a/understanding-anonymous-methods-in-delphi.htm). wskaźnik użycia kodu. – MajidTaheri

0

Zakładając, funkcja ma być wywoływana raz, a nie 5 razy co drugi, może tak:

Parallel.Async( 
     procedure; begin 
      Sleep(200); 
      Self.Counter:=Self.Counter+1; end;); 

Nie są bardziej złożone rozwiązania, takie jak ten, który zaakceptowałeś, podejmowanie nazwanych obiektów dla działań z timerem i używanie metody SetTimer. Podobnie jak http://code.google.com/p/omnithreadlibrary/source/browse/trunk/tests/17_MsgWait/test_17_MsgWait.pas Poprzednie wersje miały SetTimer z anonimową funkcją, ale już ich nie ma.

Jednak w przypadku uproszczonego anonimowego podejścia, o które prosiłeś, może czekać (xxX).

0

zwykle zrobić w ten sposób

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

    // put here what you want to do 

end).Start; 
Powiązane problemy