CEF4Delphi/demos/Lazarus_Linux_Console/ConsoleBrowser/uworkerthread.pas

211 lines
4.1 KiB
ObjectPascal
Raw Normal View History

unit uworkerthread;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, SyncObjs, Contnrs,
ucustommessage;
const
WORKERTHREADMSG_QUIT = 1;
type
TWorkerThread = class(TThread)
protected
FCritSect : TCriticalSection;
FEvent : TEvent;
FWaiting : boolean;
FStop : boolean;
FMsgQueue : TObjectQueue;
function Lock : boolean;
procedure Unlock;
function CanContinue : boolean;
procedure ReadAllPendingMessages;
procedure ProcessValue(const aInfo : TMsgInfo); virtual;
function ReadPendingMessage(var aMsgInfo : TMsgInfo) : boolean;
procedure StopThread;
procedure DestroyQueue;
procedure EnqueueMessage(const aMsgInfo : TMsgInfo); overload;
procedure EnqueueMessage(aMsg: integer; aIntParam : integer = 0; const aStrParam : string = ''); overload;
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure AfterConstruction; override;
end;
implementation
constructor TWorkerThread.Create;
begin
FCritSect := nil;
FWaiting := False;
FStop := False;
FEvent := nil;
FMsgQueue := nil;
inherited Create(True);
FreeOnTerminate := False;
end;
destructor TWorkerThread.Destroy;
begin
if (FEvent <> nil) then FreeAndNil(FEvent);
if (FCritSect <> nil) then FreeAndNil(FCritSect);
DestroyQueue;
inherited Destroy;
end;
procedure TWorkerThread.DestroyQueue;
begin
if (FMsgQueue <> nil) then
begin
while (FMsgQueue.Count > 0) do
FMsgQueue.Pop.Free;
FreeAndNil(FMsgQueue);
end;
end;
procedure TWorkerThread.AfterConstruction;
begin
inherited AfterConstruction;
FEvent := TEvent.Create(nil, False, False, '');
FCritSect := TCriticalSection.Create;
FMsgQueue := TObjectQueue.Create;
end;
function TWorkerThread.Lock : boolean;
begin
if (FCritSect <> nil) then
begin
FCritSect.Acquire;
Result := True;
end
else
Result := False;
end;
procedure TWorkerThread.Unlock;
begin
if (FCritSect <> nil) then FCritSect.Release;
end;
procedure TWorkerThread.StopThread;
begin
if Lock then
begin
FStop := True;
Unlock;
end;
end;
procedure TWorkerThread.EnqueueMessage(aMsg, aIntParam : integer; const aStrParam : string);
var
TempMsgInfo : TMsgInfo;
begin
TempMsgInfo.Msg := aMsg;
TempMsgInfo.StrParam := aStrParam;
TempMsgInfo.IntParam := aIntParam;
EnqueueMessage(TempMsgInfo);
end;
procedure TWorkerThread.EnqueueMessage(const aMsgInfo : TMsgInfo);
begin
if Lock then
try
if (FMsgQueue <> nil) then
FMsgQueue.Push(TCustomMessage.Create(aMsgInfo));
if FWaiting then
begin
FWaiting := False;
FEvent.SetEvent;
end;
finally
Unlock;
end;
end;
function TWorkerThread.ReadPendingMessage(var aMsgInfo : TMsgInfo) : boolean;
var
TempMessage : TCustomMessage;
begin
Result := False;
if Lock then
try
FWaiting := False;
if (FMsgQueue <> nil) and (FMsgQueue.Count > 0) then
begin
TempMessage := TCustomMessage(FMsgQueue.Pop);
aMsgInfo := TempMessage.Value;
Result := True;
TempMessage.Free;
end;
finally
Unlock;
end;
end;
procedure TWorkerThread.ReadAllPendingMessages;
var
TempInfo : TMsgInfo;
begin
while ReadPendingMessage(TempInfo) do
case TempInfo.Msg of
WORKERTHREADMSG_QUIT :
begin
StopThread;
exit;
end;
else ProcessValue(TempInfo);
end;
end;
procedure TWorkerThread.ProcessValue(const aInfo : TMsgInfo);
begin
//
end;
function TWorkerThread.CanContinue : boolean;
begin
Result := False;
if Lock then
try
if not(Terminated) and not(FStop) then
begin
Result := True;
FWaiting := True;
FEvent.ResetEvent;
end;
finally
Unlock;
end;
end;
procedure TWorkerThread.Execute;
begin
while CanContinue do
begin
FEvent.WaitFor(INFINITE);
ReadAllPendingMessages;
end;
end;
end.