paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-13 19:46:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ExecuteInThread added

Browse Source 
git-svn-id: trunk@33100 -
This commit is contained in:
michael 2016-02-16 18:59:35 +00:00
parent ae3b0eab2a
commit 789b80f702
2 changed files with 215 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

196
rtl/objpas/classes/classes.inc
View File

@ -644,6 +644,202 @@ begin
Result := SysUtils.GetTickCount64;
end;
{ TSimpleThread allows objects to create a threading method without defining
a new thread class }
Type
TSimpleThread = class(TThread)
private
FExecuteMethod: TThreadExecuteHandler;
protected
procedure Execute; override;
public
constructor Create(ExecuteMethod: TThreadExecuteHandler; AOnterminate : TNotifyEvent);
end;
TSimpleStatusThread = class(TThread)
private
FExecuteMethod: TThreadExecuteStatusHandler;
FStatus : String;
FOnStatus : TThreadStatusNotifyEvent;
protected
procedure Execute; override;
Procedure DoStatus;
Procedure SetStatus(Const AStatus : String);
public
constructor Create(ExecuteMethod: TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnterminate : TNotifyEvent);
end;
TSimpleProcThread = class(TThread)
private
FExecuteMethod: TThreadExecuteCallBack;
FCallOnTerminate : TNotifyCallBack;
FData : Pointer;
protected
Procedure TerminateCallBack(Sender : TObject);
procedure Execute; override;
public
constructor Create(ExecuteMethod: TThreadExecuteCallBack; AData : Pointer; AOnterminate : TNotifyCallBack);
end;
TSimpleStatusProcThread = class(TThread)
private
FExecuteMethod: TThreadExecuteStatusCallBack;
FCallOnTerminate : TNotifyCallBack;
FStatus : String;
FOnStatus : TThreadStatusNotifyCallBack;
FData : Pointer;
protected
procedure Execute; override;
Procedure DoStatus;
Procedure SetStatus(Const AStatus : String);
Procedure TerminateCallBack(Sender : TObject);
public
constructor Create(ExecuteMethod: TThreadExecuteStatusCallBack; AData : Pointer; AOnStatus : TThreadStatusNotifyCallBack; AOnterminate : TNotifyCallBack);
end;
{ TSimpleThread }
constructor TSimpleThread.Create(ExecuteMethod: TThreadExecuteHandler; AOnTerminate: TNotifyEvent);
begin
FExecuteMethod := ExecuteMethod;
OnTerminate := AOnTerminate;
inherited Create(False);
end;
procedure TSimpleThread.Execute;
begin
FreeOnTerminate := True;
FExecuteMethod;
end;
{ TSimpleStatusThread }
constructor TSimpleStatusThread.Create(ExecuteMethod: TThreadExecuteStatusHandler;AOnStatus : TThreadStatusNotifyEvent; AOnTerminate: TNotifyEvent);
begin
FExecuteMethod := ExecuteMethod;
OnTerminate := AOnTerminate;
FOnStatus:=AOnStatus;
FStatus:='';
inherited Create(False);
end;
procedure TSimpleStatusThread.Execute;
begin
FreeOnTerminate := True;
FExecuteMethod(@SetStatus);
end;
procedure TSimpleStatusThread.SetStatus(Const AStatus : String);
begin
If (AStatus=FStatus) then
exit;
FStatus:=AStatus;
If Assigned(FOnStatus) then
Synchronize(@DoStatus);
end;
procedure TSimpleStatusThread.DoStatus;
begin
FOnStatus(Self,FStatus);
end;
{ TSimpleProcThread }
constructor TSimpleProcThread.Create(ExecuteMethod: TThreadExecuteCallBack; AData : Pointer; AOnTerminate: TNotifyCallBack);
begin
FExecuteMethod := ExecuteMethod;
FCallOnTerminate := AOnTerminate;
FData:=AData;
If Assigned(FCallOnTerminate) then
OnTerminate:=@TerminateCallBack;
inherited Create(False);
end;
procedure TSimpleProcThread.Execute;
begin
FreeOnTerminate := True;
FExecuteMethod(FData);
end;
procedure TSimpleProcThread.TerminateCallBack(Sender : TObject);
begin
if Assigned(FCallOnTerminate) then
FCallOnTerminate(Sender,FData);
end;
{ TSimpleStatusProcThread }
constructor TSimpleStatusProcThread.Create(ExecuteMethod: TThreadExecuteStatusCallback; AData : Pointer; AOnStatus : TThreadStatusNotifyCallBack; AOnTerminate: TNotifyCallBack);
begin
FExecuteMethod := ExecuteMethod;
FCallOnTerminate := AOnTerminate;
FData:=AData;
If Assigned(FCallOnTerminate) then
OnTerminate:=@TerminateCallBack;
FOnStatus:=AOnStatus;
FStatus:='';
inherited Create(False);
end;
procedure TSimpleStatusProcThread.Execute;
begin
FreeOnTerminate := True;
FExecuteMethod(FData,@SetStatus);
end;
procedure TSimpleStatusProcThread.SetStatus(Const AStatus : String);
begin
If (AStatus=FStatus) then
exit;
FStatus:=AStatus;
If Assigned(FOnStatus) then
Synchronize(@DoStatus);
end;
procedure TSimpleStatusProcThread.DoStatus;
begin
FOnStatus(Self,FData,FStatus);
end;
procedure TSimpleStatusProcThread.TerminateCallBack(Sender : TObject);
begin
if Assigned(FCallOnTerminate) then
FCallOnTerminate(Sender,FData);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteHandler; AOnTerminate : TNotifyEvent = Nil) : TThread;
begin
Result:=TSimpleThread.Create(AMethod,AOnTerminate);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteCallback; AData : Pointer; AOnTerminate : TNotifyCallback = Nil) : TThread;
begin
Result:=TSimpleProcThread.Create(AMethod,AData,AOnTerminate);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnTerminate : TNotifyEvent = Nil) : TThread;
begin
If Not Assigned(AOnStatus) then
Raise EThread.Create(SErrStatusCallBackRequired);
Result:=TSimpleStatusThread.Create(AMethod,AOnStatus,AOnTerminate);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusCallback; AOnStatus : TThreadStatusNotifyCallback;AData : Pointer = Nil; AOnTerminate : TNotifyCallBack = Nil) : TThread;
begin
If Not Assigned(AOnStatus) then
Raise EThread.Create(SErrStatusCallBackRequired);
Result:=TSimpleStatusProcThread.Create(AMethod,AData,AOnStatus,AOnTerminate);
end;
{ TPersistent implementation }
{$i persist.inc }

20
rtl/objpas/classes/classesh.inc
View File

@ -1558,13 +1558,25 @@ type
end;
{ TThread }
TThread = Class;
EThread = class(Exception);
EThreadExternalException = class(EThread);
EThreadDestroyCalled = class(EThread);
TSynchronizeProcVar = procedure;
TThreadMethod = procedure of object;
TThreadReportStatus = Procedure(Const status : String) of Object;
TThreadStatusNotifyEvent = Procedure(Sender : TThread; Const status : String) of Object;
TThreadExecuteHandler = TThreadMethod;
TThreadExecuteStatusHandler = Procedure(ReportStatus : TThreadReportStatus) of object;
TNotifyCallBack = Procedure(Sender : TObject; AData : Pointer);
TThreadStatusNotifyCallBack = Procedure(Sender : TThread; AData : Pointer; Const status : String);
TThreadExecuteCallBack = Procedure(AData : Pointer);
TThreadExecuteStatusCallBack = Procedure(AData : Pointer; ReportStatus : TThreadReportStatus);
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
tpTimeCritical);
@ -1674,6 +1686,12 @@ type
class procedure GetSystemTimes(out aSystemTimes: TSystemTimes); static;
class function GetTickCount: LongWord; static; deprecated 'Use TThread.GetTickCount64 instead';
class function GetTickCount64: QWord; static;
// Object based
Class Function ExecuteInThread(AMethod : TThreadExecuteHandler; AOnTerminate : TNotifyEvent = Nil) : TThread; overload; static;
Class Function ExecuteInThread(AMethod : TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnTerminate : TNotifyEvent = Nil) : TThread; overload;static;
// Plain methods.
Class Function ExecuteInThread(AMethod : TThreadExecuteCallback; AData : Pointer = Nil; AOnTerminate: TNotifyCallBack = Nil) : TThread; overload;static;
Class Function ExecuteInThread(AMethod : TThreadExecuteStatusCallback; AOnStatus : TThreadStatusNotifyCallback; AData : Pointer = Nil; AOnTerminate : TNotifyCallBack = Nil) : TThread; overload;static;
procedure AfterConstruction; override;
procedure Start;
procedure Resume; deprecated;