diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc index ea44aef40f..11ce4a433a 100644 --- a/rtl/objpas/classes/classes.inc +++ b/rtl/objpas/classes/classes.inc @@ -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 } diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc index eb8137242a..182efa2edd 100644 --- a/rtl/objpas/classes/classesh.inc +++ b/rtl/objpas/classes/classesh.inc @@ -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;