[fpc-pascal] Use sleep in thread

[fredvs]

Hello.

You may use RTLEvents to pause a thread. =>

Program Project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes;

Type

  { THelloThread }

  THelloThread = class(TThread)
    fSleepTime,fThreadNum:integer;
    fEvent:PRTLEvent;
    procedure Execute; override;
    constructor Create(sleepTime,threadNum:integer);
    destructor Destroy; override;
  end;

var

  ThreadArray:array[1..10] of THelloThread;

{ THelloThread }

procedure THelloThread.Execute;
begin
  while true do
  begin
    writeln('Thread ',fThreadNum,' sleeping for ',fsleepTime,' ms');
    RTLeventWaitFor(fEvent,fSleepTime);
    if Terminated then break;
    //don't forget to reset,
    RTLeventResetEvent(fEvent);
    writeln('Hello From Thread ',fThreadNum);
  end;
  writeln('Bye from ',fThreadNum);
end;

constructor THelloThread.Create(sleepTime,threadNum: integer);
begin
  inherited Create(true);
  FreeOnTerminate := true;
  fEvent := RTLEventCreate;
  fSleepTime := sleepTime;
  fThreadNum := threadNum;
  Start;
end;

destructor THelloThread.Destroy;
begin
  RTLeventdestroy(fEvent);
  inherited Destroy;
end;

procedure CreateThreads;
var
  l:integer;
begin
  for l := low(ThreadArray) to high(ThreadArray) do
    ThreadArray[l] := THelloThread.Create(l*1000,l);
end;

procedure StopThreads;
var
  l:integer;
begin
  for l := low(ThreadArray) to high(ThreadArray) do
  begin
    ThreadArray[l].Terminate;
    RTLeventSetEvent(ThreadArray[l].fEvent); //wake event up for early
terminattion
    ThreadArray[l].WaitFor;
  end;
end;

begin
  CreateThreads;
  writeln('Press Any Key To Stop.');
  readln;
  StopThreads;
  writeln('All threads stopped');
  readln;
end.



-----
Many thanks ;-)
--
View this message in context: http://free-pascal-general.1045716.n5.nabble.com/Use-sleep-in-thread-tp5721119p5721129.html
Sent from the Free Pascal - General mailing list archive at Nabble.com.