Browse Source

* ExecuteInThread added

git-svn-id: trunk@33100 -
michael 9 years ago
parent
commit
789b80f702
2 changed files with 216 additions and 2 deletions
  1. 196 0
      rtl/objpas/classes/classes.inc
  2. 20 2
      rtl/objpas/classes/classesh.inc

+ 196 - 0
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 }

+ 20 - 2
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;