mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-06 01:06:13 +02:00
* ExecuteInThread added
git-svn-id: trunk@33100 -
This commit is contained in:
parent
ae3b0eab2a
commit
789b80f702
@ -644,6 +644,202 @@ begin
|
|||||||
Result := SysUtils.GetTickCount64;
|
Result := SysUtils.GetTickCount64;
|
||||||
end;
|
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 }
|
{ TPersistent implementation }
|
||||||
{$i persist.inc }
|
{$i persist.inc }
|
||||||
|
@ -1558,6 +1558,7 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
{ TThread }
|
{ TThread }
|
||||||
|
TThread = Class;
|
||||||
|
|
||||||
EThread = class(Exception);
|
EThread = class(Exception);
|
||||||
EThreadExternalException = class(EThread);
|
EThreadExternalException = class(EThread);
|
||||||
@ -1565,6 +1566,17 @@ type
|
|||||||
TSynchronizeProcVar = procedure;
|
TSynchronizeProcVar = procedure;
|
||||||
TThreadMethod = procedure of object;
|
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,
|
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
|
||||||
tpTimeCritical);
|
tpTimeCritical);
|
||||||
|
|
||||||
@ -1674,6 +1686,12 @@ type
|
|||||||
class procedure GetSystemTimes(out aSystemTimes: TSystemTimes); static;
|
class procedure GetSystemTimes(out aSystemTimes: TSystemTimes); static;
|
||||||
class function GetTickCount: LongWord; static; deprecated 'Use TThread.GetTickCount64 instead';
|
class function GetTickCount: LongWord; static; deprecated 'Use TThread.GetTickCount64 instead';
|
||||||
class function GetTickCount64: QWord; static;
|
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 AfterConstruction; override;
|
||||||
procedure Start;
|
procedure Start;
|
||||||
procedure Resume; deprecated;
|
procedure Resume; deprecated;
|
||||||
|
Loading…
Reference in New Issue
Block a user