AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi Threads anhalten und fortsetzen
Thema durchsuchen
Ansicht
Themen-Optionen

Threads anhalten und fortsetzen

Ein Thema von SyntaxXx · begonnen am 25. Jun 2015 · letzter Beitrag vom 25. Jun 2015
 
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: Threads anhalten und fortsetzen

  Alt 25. Jun 2015, 12:06
Hier mal ein kleiner Worker-Thread (ohne viel Gedöns), den man auch schlafen legen kann.
Delphi-Quellcode:
unit Unit2;

interface

uses
  Classes, SyncObjs, SysUtils, Generics.Collections;

type
  TWorkerThread = class( TThread )
  private
    FLockObj: TObject;
    FIsSleeping: Boolean;
    FWorkEvent: TEvent;
    FWorkQueue: TQueue<TProc>;
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create( CreateSuspended: Boolean );
    destructor Destroy; override;

    /// <summary>
    /// Arbeit an die WorkerThread-Queue übergeben
    /// </summary>
    procedure PushWork( AWorkProc: TProc );

    /// <summary>
    /// WorkerThread schlafen legen
    /// </summary>
    procedure GoSleeping( );
    /// <summary>
    /// WorkerThread wieder aufwecken
    /// </summary>
    procedure Awake( );
  end;

implementation

{ TWorkerThread }

procedure TWorkerThread.Awake;
begin
  TMonitor.Enter( FLockObj );
  try
    FIsSleeping := False;
    if FWorkQueue.Count > 0 then
      FWorkEvent.SetEvent( );
  finally
    TMonitor.Exit( FLockObj );
  end;
end;

constructor TWorkerThread.Create( CreateSuspended: Boolean );
begin
  FLockObj := TObject.Create( );
  FWorkEvent := TEvent.Create( nil, True, False, '' );
  FWorkQueue := TQueue<TProc>.Create( );

  inherited;
end;

destructor TWorkerThread.Destroy;
begin
  inherited;

  FreeAndNil( FLockObj );
  FreeAndNil( FWorkQueue );
  FreeAndNil( FWorkEvent );
end;

procedure TWorkerThread.Execute;
var
  LWorkProc: TProc;
begin
  inherited;
  while not Terminated do
  begin
    if ( FWorkEvent.WaitFor( ) = wrSignaled ) then
      if not Terminated then
      begin

        // Arbeit aus der Queue holen

        TMonitor.Enter( FLockObj );
        try
          LWorkProc := FWorkQueue.Dequeue( );
          if FWorkQueue.Count = 0 then
            FWorkEvent.ResetEvent( );
        finally
          TMonitor.Exit( FLockObj );
        end;

        // Arbeit erledigen

        LWorkProc( );
      end;
  end;
end;

procedure TWorkerThread.GoSleeping;
begin
  TMonitor.Enter( FLockObj );
  try
    FIsSleeping := True;
    FWorkEvent.ResetEvent( );
  finally
    TMonitor.Exit( FLockObj );
  end;
end;

procedure TWorkerThread.PushWork( AWorkProc: TProc );
begin
  TMonitor.Enter( FLockObj );
  try
    FWorkQueue.Enqueue( AWorkProc );
    if not FIsSleeping then
      FWorkEvent.SetEvent( );
  finally
    TMonitor.Exit( FLockObj );
  end;
end;

procedure TWorkerThread.TerminatedSet;
begin
  inherited;
  FWorkEvent.SetEvent( );
end;

end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:54 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz