Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Object-Pascal / Delphi-Language (https://www.delphipraxis.net/35-library-object-pascal-delphi-language/)
-   -   Delphi Delay (https://www.delphipraxis.net/6620-delay.html)

negaH 17. Jul 2003 02:19


Delay
 
Eine Resourceschonendere Variante

Delphi-Quellcode:
procedure Delay(Milliseconds: Integer);
var
  Tick: DWord;
  Event: THandle;
begin
  Event := CreateEvent(nil, False, False, nil);
  try
    Tick := GetTickCount + DWord(Milliseconds);
    while (Milliseconds > 0) and
          (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
    begin
      Application.ProcessMessages;
      if Application.Terminated then Exit;
      Milliseconds := Tick - GetTickcount;
    end;
  finally
    CloseHandle(Event);
  end;
end;

Durch die Anwendung von MsgWaitForMultpleObjects() mit dem niemals signalisierendem Event, wird der aktuelle Thread solange schlafen gelegt bis entweder ein Timeout eintrifft oder aber im Messagequeue Messages abgearbeitet werden müssen. Damit ist diese Delay Funktion gleichermaßen sicher in beliebigen Threads ohne Messagequeues oder dem MainThread einer Anwendung benutztbar.
In einem abgespalteten Thread der kein Messagequeue besitzt verhält sich Delay() so wie Sleep().
In einem Thread mit Messagequeue, z.b. Hauptthread, würde die meiste Zeit der Thread schlafen und nur wenn tatsächlich Messages vorliegen, diese per Application.ProcessMesages abgearbeitet. Da Application.ProcessMessages per PeekMessage() und GetMessage() ein Polling realisiert verbraucht ein unnötiger Aufruf dieser Funktionen mehr CPU Zeit.
Mit obiger Funktion stellen wir um vom Polling auf Ereignisorientiert.

Gruß Hagen

[edit=Chakotay1308] Mfg, Chakotay1308[/edit]
[edit=Matze]"Exit"-Zeile hinzugefügt. Mfg, Matze[/edit]

toms 28. Nov 2010 08:13

AW: Delay in Delphi
 
Und noch eine Variante (NonVCL):

Delphi-Quellcode:
procedure Delay(msecs: Longint);
var
  targettime: Longint;
  Msg: TMsg;
begin
  targettime := GetTickCount + msecs;
  while targettime > GetTickCount do
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      if Msg.message = WM_QUIT then
      begin
        PostQuitMessage(Msg.wParam);
        Break;
      end;
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:16 Uhr.

Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2020 by Daniel R. Wolf