Uruchom za chwilę

Taki mój kawałek kodu który umożliwia uruchomienie procedury z opóźnieniem,
ja to wykorzystuję przy wszelkiego rodzaju suwakach i innych komponentach wizualnych które są w stanie wygenerować w krótkim czasie wiele zdarzeń podczas podczas przesuwania myszką . A jak procedura obsługi zdarzenia trwa długo to aplikacją się przytyka.
Co prawda niektóre komponenty mają do tego odpowiedni parametr (np. TTreeView.ChangeDelay ) ale niestety nie wszystkie.
Taka bardzo prosta implementacja.

Dlatego też w kodzie obsługi zdarzenia np. suwaka daje taki kod:

var
  a_uruchomMulti: TUruchomZaChwileMulti;
  
procedure TForm2.scrlbr1Change(Sender: TObject);
begin
  a_uruchomMulti.uruchom_za_chwile(3000,procedura_suwak1);
end;

Procedura procedura_suwak1 wykona sie dopiero w 3000ms od ostatnie zdarzenia suwaka.

unit UUruchomZaChwile;
(*
   Autor: Ja
   URL: http://4programmers.net/Forum/Delphi_Pascal/180505-uruchom_za_chwile
   Examples: http://4programmers.net/Forum/Delphi_Pascal/180505-uruchom_za_chwile
   Version: 1.0
*)

interface

uses
  Windows, ExtCtrls, SysUtils;

type
  TUruchomZaChwileProcedure = procedure of object;
  TUruchomZaChwile = class
  private
    a_timer: TTimer;
    a_procedura: TUruchomZaChwileProcedure;
    procedure a_timerTimer(Sender: TObject);
  public
    constructor create;
    destructor Destroy; override;
    procedure uruchom_za_chwile(milisekundy: integer; p_procedura: TUruchomZaChwileProcedure);
  end;

const
  TUruchomZaChwileList_MAX_COUNT = 128;
type
  TUruchomZaChwileMulti = class
  private
    a_count: integer;
    a_lista_timer: array[0..TUruchomZaChwileList_MAX_COUNT-1] of TTimer;
    a_lista_proc: array[0..TUruchomZaChwileList_MAX_COUNT-1] of TMethod;
    procedure a_timerOnTimer(Sender: TObject);
  public
    constructor create;
    destructor Destroy; override;
    procedure uruchom_za_chwile(milisekundy: integer; p_procedura: TUruchomZaChwileProcedure);
  end;



implementation

{ TUruchamiacz }

procedure TUruchomZaChwile.a_timerTimer(Sender: TObject);
begin
  a_timer.Enabled := false; //wyłaczam timer, żeby nie dostać jego eventu jeszcze raz
  if Assigned(a_procedura) then a_procedura();
end;

constructor TUruchomZaChwile.create;
begin
  a_timer := TTimer.create(nil);
  a_timer.Enabled := false;
  a_timer.OnTimer := a_timerTimer;
end;

destructor TUruchomZaChwile.Destroy;
begin
  a_timer.Free();
  inherited;
end;

procedure TUruchomZaChwile.uruchom_za_chwile(milisekundy: integer;
  p_procedura: TUruchomZaChwileProcedure);
begin
  //wyłączneie timera powoduje reset pozostałego interwału.
  a_timer.Enabled := false;

  //setup timera
  a_timer.Interval := milisekundy;
  a_procedura := p_procedura;

  //włączamy go poniownie, z pełnym interwałem.
  a_timer.Enabled := True;
end;

{ TUruchomZaChwileList }

procedure TUruchomZaChwileMulti.a_timerOnTimer(Sender: TObject);
var
  v_id: integer;
begin
  v_id := (sender as Ttimer).Tag;// odczytuje ID mojego timer-a
  a_lista_timer[v_id].Enabled := false;
  TUruchomZaChwileProcedure(a_lista_proc[v_id]);
end;

constructor TUruchomZaChwileMulti.create;
begin
  a_count := 0;
end;

destructor TUruchomZaChwileMulti.Destroy;
var
  i: integer;
begin
  for I := 0 to a_count - 1 do
  begin
    if Assigned(a_lista_timer[i]) then
      a_lista_timer[i].Free;
  end;

  inherited;
end;

procedure TUruchomZaChwileMulti.uruchom_za_chwile(milisekundy: integer;
  p_procedura: TUruchomZaChwileProcedure);
var
  i: integer;
  v_index: integer;
  v_timer: TTimer;
begin
  v_index := -1;
  for I := 0 to a_count - 1 do  // szukamy indeksu procedury
  begin
    if (TMethod(p_procedura).Code = a_lista_proc[i].Code)  and
       (TMethod(p_procedura).Data = a_lista_proc[i].Data)  then
    begin
      v_index := i;
      Break;
    end;
  end;
  // jezeli v_index = -1 to dodajemy procedure do listy bo jej nie ma
  if v_index = -1  then
  begin
    a_lista_proc[a_count].Code := TMethod(p_procedura).Code;
    a_lista_proc[a_count].Data := TMethod(p_procedura).Data;
    //
    a_lista_timer[a_count] := TTimer.Create(nil);
    a_lista_timer[a_count].Enabled := false;
    a_lista_timer[a_count].Tag := a_count;// zaznaczamy timer;
    a_lista_timer[a_count].OnTimer := a_timerOnTimer;
    v_index := a_count;
    Inc(a_count);

    if a_count > TUruchomZaChwileList_MAX_COUNT then
      raise Exception.Create('Za duza ilosc procedur TUruchomZaChwileList, zwieksz TUruchomZaChwileList_MAX_COUNT');
  end;

  v_timer := a_lista_timer[v_index];
  v_timer.Enabled := false; //wyłączneie timera powoduje reset pozostałego interwału.
  v_timer.Interval := milisekundy; //setup timera
  v_timer.Enabled := True; //włączamy go poniownie, z pełnym interwałem.
end;

end.

Przykładowy kod w załączniku (za chwilę)

nie prosciej z SetTimer() i KillTimer()?

Nie lepiej SetTimer?

Po co tak kombinować, obczaj to:

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Edit1Change(Sender: TObject);
  private
    procedure WmTimer(var Msg:TWMTimer);message WM_TIMER;
  public
  end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WmTimer(var Msg:TWMTimer);//message WM_TIMER;
begin
  KillTimer(Handle,Msg.TimerID);
  case Msg.TimerID of
    1: Edit1Change(Self);
  end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if Sender=Self then
  begin
    Memo1.Lines.Add(Edit1.Text);
  end
  else
  begin
    KillTimer(Handle,1);
    SetTimer(Handle,1,1000,nil);
  end;
end;

Hmmm !
Ja bym powiedział że TTimer pod windows to właśnie opakowane KillTimer/SetTimer,
może się kiedyś doczekamy wersji pod alternatywne systemy i kod będzie działać nadal.
A czy jest prościej to każdy musi sobie odpowiedzieć sam.
Mi się wydaje że taki kod:
"a_uruchomMulti.uruchom_za_chwile(3000,procedura_suwak1);"
to już się prościej nie da

chodzi o to ze moglbys w swoim unicie uzyc setTimer/killTimer zamiast TTimer. nie musisz nic tworzyc, zwalniac...

Nowa wersja , trochę mi się wizja zmieniła i zamieniłem timery na SetTimer i KillTimer.
Zastosowanie może być różnorodne
Można poczytać sobie w tym wątku
http://groups.google.com/group/pl.comp.lang.delphi/browse_frm/thread/de301a467e78b785#
Podziękowania dla Arivald-a za inspirację

Zdecydownieje staje sie użycie łatwiejsze całego unitu,

unit UDelayedEvent;

(*
   Autor: Ja
   URL: http://4programmers.net/Forum/Delphi_Pascal/180505-uruchom_za_chwile
   Examples: http://4programmers.net/Forum/Delphi_Pascal/180505-uruchom_za_chwile
   Version: 1.1
   Thanks for:  Arivald
*)

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Contnrs;

type
  // base for all delayed events
  TDelayedEvent = class
  private
    a_originalSender: TObject;
    a_timerId: integer;
    a_timeout: integer;
    a_eventProc: TMethod;
  protected
    procedure Fire(); virtual; abstract; //procedura wołana przez TEventDelayer jak przyjdzie czas na wykonanie eventu
  public
    constructor Create(p_OriginalSender: TObject; aEvent: TMethod; p_timeOut: integer);
  end;

  TDelayedEventClass = class of TDelayedEvent;

  // class for TNotifyEvent
  TDelayedNotifyEvent = class (TDelayedEvent)
  protected
    procedure Fire(); override;
  end;

  // class for TMouseMoveEvent
  TDelayedMouseMoveEvent = class( TDelayedEvent )
  private
    a_shift: TShiftState;
    a_x,a_y: integer;
  protected
    procedure Fire(); override;
  public
    constructor Create(p_OriginalSender: TObject; aEvent: TMethod; p_timeOut: integer; p_shift: TShiftState; p_x,p_y: integer);
  end;


  TEventDelayer = class
  private
    a_timerIdLast: integer;
    a_windowHandle: HWND;
    a_eventsStorage: TObjectList; //lub TList<TDelayedEvent>
    function ExtractDelayedEventForTimerId(p_timerId: Longint): TDelayedEvent;
    function ExtractOldDelayedEvent(p_ed: TDelayedEvent): TDelayedEvent;
    function ExtractDelayedEventStorageIndex(p_ed: TDelayedEvent):Integer;
    procedure AddToStorage(DelayedEvent: TDelayedEvent);
    procedure DeleteDelayedEvent( DelayedEvent: TDelayedEvent);
    procedure WndProc(var p_Msg: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
  public
    function DelayNotifyEvent(var Sender: TObject; Event: TNotifyEvent;  timeout: integer): boolean;// (Sender: TObject; Event: TNotifyEvent; timeout: integer): boolean;
    function DelayMouseMoveEvent(var Sender: TObject; Event: TMouseMoveEvent;  timeout: integer;p_shift: TShiftState; p_x, p_y: integer): boolean;// (Sender: TObject; Event: TNotifyEvent; timeout: integer): boolean;
  end;

function EventDelayer(): TEventDelayer;

implementation

var
  g_EventDelayer: TEventDelayer; // globalny obiekt dla funkcji EventDelayer()

function EventDelayer(): TEventDelayer;
begin
  if not Assigned(g_EventDelayer) then
  begin
    g_EventDelayer:= TEventDelayer.Create;
  end;

  Result := g_EventDelayer
end;

procedure TDelayedNotifyEvent.Fire();
begin
  TNotifyEvent(a_eventProc)(Self);
end;

constructor TDelayedMouseMoveEvent.Create(p_OriginalSender: TObject;
  aEvent: TMethod; p_timeOut: integer; p_shift: TShiftState; p_x, p_y: integer);
begin
  inherited Create(p_OriginalSender,aEvent,p_timeOut);
  a_shift := p_shift;
  a_x := p_x;
  a_y := p_y;
end;

procedure TDelayedMouseMoveEvent.Fire;
begin
  TMouseMoveEvent(a_eventProc)(Self,a_shift,a_x,a_y);
end;

procedure TEventDelayer.AddToStorage(DelayedEvent: TDelayedEvent);
var
  ed: TDelayedEvent;
begin
  //najpierw znajdz stary TDelayedEvent dla danego eventu.
  ed := ExtractOldDelayedEvent(DelayedEvent);
  if Assigned(ed)  then
  begin
    KillTimer(a_windowHandle, ed.a_timerId);
    DeleteDelayedEvent(ed);
  end;

  //dodaj nowy
  Inc(a_timerIdLast); // inkrementuję licznik timerów

  DelayedEvent.a_timerId := a_timerIdLast;// SetTimer(0, 0, DelayedEvent.Timeout, Addr(TimerProc));
  SetTimer(a_windowHandle, a_timerIdLast, DelayedEvent.a_timeout, nil);
  a_eventsStorage.Add(DelayedEvent);
end;

constructor TEventDelayer.Create;
begin
  a_timerIdLast := 0;
  a_eventsStorage:= Contnrs.TObjectList.Create;//

  if a_windowHandle = 0 then
    a_windowHandle := AllocateHWnd(WndProc);
end;

//obsługa opóźniania.
//zwrócenie True z DelayNotifyEvent oznacza że event zostanie opóżniony, i należy wyjść z procedury.
//zwrócenie False oznacza że event już jest opóźniony, należy kontynuować.
function TEventDelayer.DelayMouseMoveEvent(var Sender: TObject;
  Event: TMouseMoveEvent; timeout: integer;p_shift: TShiftState; p_x, p_y: integer): boolean;
begin
  Result := not (Sender is TDelayedEvent);

  //event opóźniony: odtworzyć oryginalną zmienną "Sender"
  if Sender is TDelayedEvent then
  begin
    Sender := (Sender as TDelayedEvent).a_originalSender;
    Exit;
  end;

  //event nie opóźniony: dodać do struktur
  AddToStorage(TDelayedMouseMoveEvent.Create(Sender,  TMethod(Event), timeout,p_shift,p_x,p_y));
end;

function TEventDelayer.DelayNotifyEvent(var Sender: TObject; Event: TNotifyEvent;  timeout: integer): boolean;
begin
  Result := not (Sender is TDelayedEvent);

  //event opóźniony: odtworzyć oryginalną zmienną "Sender"
  if Sender is TDelayedEvent then
  begin
    Sender := (Sender as TDelayedEvent).a_originalSender;
    Exit;
  end;

   //event nie opóźniony: dodać do struktur
   AddToStorage(TDelayedNotifyEvent.Create(Sender, TMethod( Event), timeout));
end;

destructor TEventDelayer.Destroy;
begin
  a_eventsStorage.Free;
  DeallocateHWnd(a_WindowHandle);
  inherited;
end;

function TEventDelayer.ExtractDelayedEventForTimerId(p_timerId: Longint): TDelayedEvent;
var
  i: integer;
begin
  Result := nil;
  for I := 0 to a_eventsStorage.Count - 1 do
  begin
    if (a_eventsStorage.Items[i] as TDelayedEvent).a_timerId = p_timerId then
    begin
      result := (a_eventsStorage.Items[i] as TDelayedEvent);
      Exit;
    end;
  end;
end;

function TEventDelayer.ExtractDelayedEventStorageIndex(p_ed: TDelayedEvent): Integer;
var
  i: integer;
begin
  Result := -1;
  for I := 0 to a_eventsStorage.Count - 1 do
  begin
    if (a_eventsStorage.Items[i] as TDelayedEvent) = p_ed then
    begin
      result := i;
      Exit;
    end;
  end;
end;

function TEventDelayer.ExtractOldDelayedEvent(p_ed: TDelayedEvent): TDelayedEvent;
var
  i: integer;
  v_ob: TDelayedEvent;
begin
  Result := nil;
  for I := 0 to a_eventsStorage.Count - 1 do
  begin
    v_ob := (a_eventsStorage.Items[i] as TDelayedEvent);
    if (v_ob.a_eventProc.Code  = p_ed.a_eventProc.Code)  and (v_ob.a_eventProc.Data  = p_ed.a_eventProc.Data) then
    begin
      result := v_ob;
      Exit;
    end;
  end;
end;

procedure TEventDelayer.DeleteDelayedEvent(DelayedEvent: TDelayedEvent);
var
  v_id : integer;
begin
  v_id := ExtractDelayedEventStorageIndex( DelayedEvent );
  a_eventsStorage.Delete(v_id);
end;

procedure TEventDelayer.WndProc(var p_Msg: TMessage);
var
  v_ob: TDelayedEvent;
  v_timerId: integer;
begin
  with p_Msg do
    if Msg = WM_TIMER then
      try
        begin
          v_timerId := TWMTimer( p_Msg ).TimerID;
          KillTimer(a_windowHandle,v_timerId);
          v_ob :=  ExtractDelayedEventForTimerId( v_timerId );//  TWMTimer(Msg).TimerID);
          if Assigned(v_ob) then
          begin
            v_ob.Fire;
            DeleteDelayedEvent(v_ob);
          end;
        end;
        //Timer;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(a_windowHandle, Msg, wParam, lParam);
end;

{ TDelayedEvent }

constructor TDelayedEvent.Create(p_OriginalSender: TObject;
  aEvent: TMethod; p_timeOut: integer);
begin
  a_originalSender := p_OriginalSender;
  a_eventProc := TMethod(aEvent);
  a_timeOut := p_timeOut;
end;


initialization
//
finalization
  if Assigned(g_EventDelayer) then
    g_EventDelayer.Free;

end.

Nie lepiej użyć Sleep(); ?

TomRiddle napisał(a)

Nie lepiej użyć Sleep(); ?

Nie za bardzo.

Normalnie procedura obsługi zdarzenia wykonuje się natychmiast jak wystąpi zdarzenie
(np. jak naciśnie ktoś klawisz, przesunie suwak albo zmieni rekord w dataset)
Jeżeli użytkownik bardzo szybko generuje nowe zdarzenia nie zależny mi na tym aby wykonać je wszystkie tylko aby wykonać ostatnie zdarzenie jak już skończy pisać, przesuwać suwak albo wybierze rekord w dataset który go interesuje i dopiero wtedy wykonać zdarzenie.
A już szczególnie jak obsługa zdarzenia trwa trochę czasu to wtedy jest "przytykanie"

Najlepiej sciagnać Uruchom za chwilę
A potem zrobić to samo za pomoca sleep ;) Co raczej sie nie uda