Thema: Delphi Schlafende Threads

Einzelnen Beitrag anzeigen

brechi

Registriert seit: 30. Jan 2004
823 Beiträge
 
#10

AW: Schlafende Threads

  Alt 11. Mai 2012, 20:24
Irgendwie gefällt mir das auch alles nicht, wieso z.b. das ResetEvent vor DoWork? Ausserdem wird as FEvent zu spaet erzeugt.

wie wärs mit:

Delphi-Quellcode:

type
  TSleepingThread = class(TThread)
  protected
    FEvent: TEvent;
    FBusy: Boolean;
    procedure Execute; override;
    procedure DoWork; virtual; abstract;
  public
    function WakeUp: Boolean;
    constructor Create(_Suspended: Boolean);
    destructor Destroy; override;
    property Busy: Boolean read FBusy;
  end;

  TTestThread = class(TSleepingThread)
  private
    FCountLoop: Integer;
  protected
    procedure DoWork; override;
    property CountLoop: Integer read FCountLoop;
  end;

{ TMyThread }

constructor TSleepingThread.Create(_Suspended: Boolean);
begin
  FEvent := TEvent.Create(nil, True, False, '');
  FBusy := False;
  inherited Create(_Suspended);
end;

destructor TSleepingThread.Destroy;
begin
  Terminate; // FTerminate setzen
  WakeUp; // Event setzen
  WaitFor; // warten bis der eigene Thered sich beendet hat
  FreeAndNil(FEvent);
  inherited;
end;

function TSleepingThread.WakeUp: Boolean;
begin
  Result := FBusy;
  if not Result then
    FEvent.SetEvent;
end;

procedure TSleepingThread.Execute;
begin
  while not Terminated do begin
    case FEvent.WaitFor(INFINITE) of
      wrSignaled: begin
          if not Terminated then begin
            FBusy := True;
            DoWork;
            FEvent.ResetEvent;
            FBusy := False;
          end;
        end;
      wrTimeout: ;

      wrError: begin
          ReturnValue := FEvent.LastError;
          Exit;
        end;

      wrAbandoned:
        Exit;
    end;
  end;
end;

{ TTestThread }

procedure TTestThread.DoWork;
var
  t: Cardinal;
begin
  t := GetTickCount;
  while GetTickCount - t < 2000 do
    Sleep(100);
  Inc(FCountLoop);
end;

procedure TForm28.OnTerminateThread(_Sender: Tobject);
begin
  caption := inttostr((_Sender as TTestThread).CountLoop);
end;

procedure TForm28.Button1Click(Sender: TObject);

var
  tt: TTestThread;
begin
// recht sinnloses beispiel da FreeAndNil immer auf Ende wartet aller arbeiten wartet
// und es somit "blockierend" aussieht
  tt := TTestThread.Create(False);
  try
    tt.OnTerminate := OnTerminateThread;
    if tt.WakeUp then begin
      // joa konnte ausgefuerht werden
    end;
    Sleep(10); // naja irgendwas im HauptThread zwischendurch
  finally
    FreeAndNil(tt);
  end;
end;
Edit: Ah Thread falsch aufgeweckt ;P
Edit2: Beispiel erweiter (u.a. busy usw.)

Geändert von brechi (11. Mai 2012 um 20:40 Uhr) Grund: erweitert
  Mit Zitat antworten Zitat