|
Registriert seit: 5. Jan 2005 Ort: Stadthagen 9.454 Beiträge Delphi 10 Seattle Enterprise |
#1
In der letzten Zeit konnte man einige Fragen im Forum zum Thema Multi-Threading finden, bzw. solche, die sich erheblich besser mit einem separaten Thread erledigen lassen würden.
Unter .Net findet man den ![]() ![]() Der Code ist getestet mit Delphi XE8 sollte aber ohne Änderungen ab Delphi XE2 laufen. Für ältere Delphi-Versionen dürften die Anpassungen recht simpel sein, da das Prinzip selber simpel ist, diese werde ich aber nicht vornehmen. Auch ist es möglich daraus ein Package zu bilden um diesen BackgroundWorker direkt auf eine Form zu klatschen, das überlasse ich allerdings jedem Einzelnen ![]() Beispiele zur Verwendung folgen als separate Beiträge in diesem Thread, hier erst mal der Code selber:
Delphi-Quellcode:
unit BackgroundWorker;
interface uses System.Classes, System.Rtti, System.SysUtils; {$REGION 'EventArgs'} type TProgressChangedEventArgs = class private FPercentProgress: Integer; FUserState: TValue; public constructor Create( APercentProgress: Integer; AUserState: TValue ); property PercentProgress: Integer read FPercentProgress; property UserState: TValue read FUserState; end; TDoWorkEventArgs = class private FArgument: TValue; FCancel: Boolean; FResult: TValue; public constructor Create( AArgument: TValue ); property Argument: TValue read FArgument; property Cancel: Boolean read FCancel write FCancel; property Result: TValue read FResult write FResult; end; TRunWorkerCompletedEventArgs = class private FCancelled: Boolean; FError: Exception; FResult: TValue; public constructor Create( AResult: TValue; AError: Exception; ACancelled: Boolean ); property Cancelled: Boolean read FCancelled; property Error: Exception read FError; property Result: TValue read FResult; end; {$ENDREGION} {$REGION 'Events'} type TBackgroundWorkerProgressChangedEvent = procedure( Sender: TObject; e: TProgressChangedEventArgs ) of object; TBackgroundWorkerDoWorkEvent = procedure( Sender: TObject; e: TDoWorkEventArgs ) of object; TBackgroundWorkerRunWorkerCompletedEvent = procedure( Sender: TObject; e: TRunWorkerCompletedEventArgs ) of object; {$ENDREGION} {$REGION 'CustomBackgroundWorker'} type TCustomBackgroundWorker = class( TComponent ) private FThread: TThread; FDoWorkEventArg: TDoWorkEventArgs; FCancellationRequested: Boolean; FWorkerReportsProgress: Boolean; FWorkerSupportsCancellation: Boolean; FOnDoWork: TBackgroundWorkerDoWorkEvent; FOnProgressChanged: TBackgroundWorkerProgressChangedEvent; FOnRunWorkerCompleted: TBackgroundWorkerRunWorkerCompletedEvent; function GetCancellationRequested: Boolean; procedure WorkerThreadTerminate( Sender: TObject ); function GetIsBusy: Boolean; protected procedure NotifyDoWork( e: TDoWorkEventArgs ); virtual; procedure NotifyProgressChanged( e: TProgressChangedEventArgs; ADispose: Boolean = True ); virtual; procedure NotifyRunCompleted( e: TRunWorkerCompletedEventArgs; ADispose: Boolean = True ); virtual; public procedure CancelAsync; procedure ReportProgress( PercentProgress: Integer ); overload; procedure ReportProgress( PercentProgress: Integer; UserState: TValue ); overload; procedure RunWorkerAsync; overload; procedure RunWorkerAsync<T>( Argument: T ); overload; procedure RunWorkerAsync( Argument: TValue ); overload; property CancellationRequested: Boolean read GetCancellationRequested; property IsBusy: Boolean read GetIsBusy; protected property OnDoWork: TBackgroundWorkerDoWorkEvent read FOnDoWork write FOnDoWork; property OnProgressChanged: TBackgroundWorkerProgressChangedEvent read FOnProgressChanged write FOnProgressChanged; property OnRunWorkerCompleted: TBackgroundWorkerRunWorkerCompletedEvent read FOnRunWorkerCompleted write FOnRunWorkerCompleted; public property WorkerReportsProgress: Boolean read FWorkerReportsProgress write FWorkerReportsProgress; property WorkerSupportsCancellation: Boolean read FWorkerSupportsCancellation write FWorkerSupportsCancellation; end; {$ENDREGION} {$REGION 'TBackgroundWorker'} type TBackgroundWorker = class( TCustomBackgroundWorker ) published property OnDoWork; property OnProgressChanged; property OnRunWorkerCompleted; property WorkerReportsProgress; property WorkerSupportsCancellation; end; {$ENDREGION} implementation {$REGION 'Ressourcestrings'} resourcestring SWorkerDoesNotSupportsCancellation = 'Worker does not supports cancellation'; SWorkerDoesNotReportsProgress = 'Worker does not reports progress'; SWorkerIsBusy = 'Worker is busy'; {$ENDREGION} {$REGION 'EventArgs'} { TProgressChangedEventArgs } constructor TProgressChangedEventArgs.Create( APercentProgress: Integer; AUserState: TValue ); begin inherited Create; FPercentProgress := APercentProgress; FUserState := AUserState; end; { TDoWorkEventArgs } constructor TDoWorkEventArgs.Create( AArgument: TValue ); begin inherited Create; FArgument := AArgument; end; { TRunWorkerCompletedEventArgs } constructor TRunWorkerCompletedEventArgs.Create( AResult: TValue; AError: Exception; ACancelled: Boolean ); begin inherited Create; FCancelled := ACancelled; FError := AError; FResult := AResult; end; {$ENDREGION} {$REGION 'TCustomBackgroundWorker'} { TCustomBackgroundWorker } procedure TCustomBackgroundWorker.CancelAsync; begin if not WorkerSupportsCancellation then raise EInvalidOpException.Create( SWorkerDoesNotSupportsCancellation ); FCancellationRequested := True; end; procedure TCustomBackgroundWorker.ReportProgress( PercentProgress: Integer ); begin ReportProgress( PercentProgress, TValue.Empty ); end; function TCustomBackgroundWorker.GetCancellationRequested: Boolean; begin Result := ( csDestroying in ComponentState ) or FCancellationRequested; end; function TCustomBackgroundWorker.GetIsBusy: Boolean; begin Result := Assigned( FThread ); end; procedure TCustomBackgroundWorker.NotifyDoWork( e: TDoWorkEventArgs ); begin if Assigned( FOnDoWork ) then FOnDoWork( Self, e ); end; procedure TCustomBackgroundWorker.NotifyProgressChanged( e: TProgressChangedEventArgs; ADispose: Boolean ); begin if not( csDestroying in ComponentState ) then TThread.Queue( nil, procedure begin try if Assigned( FOnProgressChanged ) then FOnProgressChanged( Self, e ); finally if ADispose then e.Free; end; end ) else begin if ADispose then e.Free; end; end; procedure TCustomBackgroundWorker.NotifyRunCompleted( e: TRunWorkerCompletedEventArgs; ADispose: Boolean ); begin try if not( csDestroying in ComponentState ) then if Assigned( FOnRunWorkerCompleted ) then FOnRunWorkerCompleted( Self, e ); finally if ADispose then e.Free; end; end; procedure TCustomBackgroundWorker.ReportProgress( PercentProgress: Integer; UserState: TValue ); begin if not WorkerReportsProgress then raise EInvalidOpException.Create( SWorkerDoesNotReportsProgress ); NotifyProgressChanged( TProgressChangedEventArgs.Create( PercentProgress, UserState ) ); end; procedure TCustomBackgroundWorker.RunWorkerAsync; begin RunWorkerAsync( TValue.Empty ); end; procedure TCustomBackgroundWorker.RunWorkerAsync( Argument: TValue ); begin if IsBusy then raise EInvalidOpException.Create( SWorkerIsBusy ); FCancellationRequested := False; FDoWorkEventArg := TDoWorkEventArgs.Create( Argument ); FThread := TThread.CreateAnonymousThread( procedure begin NotifyDoWork( FDoWorkEventArg ); end ); FThread.OnTerminate := WorkerThreadTerminate; FThread.Start; end; procedure TCustomBackgroundWorker.RunWorkerAsync<T>( Argument: T ); begin RunWorkerAsync( TValue.From<T>( Argument ) ); end; procedure TCustomBackgroundWorker.WorkerThreadTerminate( Sender: TObject ); var LThread: TThread; LDoWorkEventArg: TDoWorkEventArgs; begin LThread := FThread; LDoWorkEventArg := FDoWorkEventArg; FThread := nil; FDoWorkEventArg := nil; try if Assigned( LThread.FatalException ) then NotifyRunCompleted( TRunWorkerCompletedEventArgs.Create( TValue.Empty, LThread.FatalException as Exception, False ) ) else NotifyRunCompleted( TRunWorkerCompletedEventArgs.Create( LDoWorkEventArg.Result, nil, LDoWorkEventArg.Cancel ) ); finally FreeAndNil( LDoWorkEventArg ); end; end; {$ENDREGION} end.
Kaum macht man's richtig - schon funktioniert's
![]() Zertifikat: Sir Rufo (Fingerprint: ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |