AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

BackgroundWorker [ab XE2]

Ein Thema von Sir Rufo · begonnen am 1. Jun 2015 · letzter Beitrag vom 13. Sep 2015
Antwort Antwort
Seite 1 von 2  1 2   
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#1

BackgroundWorker [ab XE2]

  Alt 1. Jun 2015, 14:33
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 BackgroundWorker und exakt den habe ich mal in Delphi umgesetzt. Wenn man also eine Dokumentation sucht, dann schaut man einfach mal in die .Net Doku (Unterschied sind nur die Events, die sind Delphi-typisch als Nicht-Multicast ausgelegt)

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)
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#2

AW: BackgroundWorker [ab XE2]

  Alt 1. Jun 2015, 14:38
http://www.delphipraxis.net/185328-t...ktivieren.html mit dem BackgroundWorker

(Source und EXE im Anhang)

Delphi-Quellcode:
unit Form.Main;

interface

uses
  BackgroundWorker,

  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Layouts;

type
  TService = class( TComponent )
  private
    FIsRunning: Boolean;
  public
    procedure Activate;
    procedure Deactivate;
    property IsRunning: Boolean read FIsRunning;
  end;

  TForm1 = class( TForm )
    Layout1: TLayout;
    Switch1: TSwitch;
    Label1: TLabel;
    AniIndicator1: TAniIndicator;
    procedure Switch1Switch( Sender: TObject );
    procedure FormShow( Sender: TObject );
  private
    FService: TService;
    FServiceWorker: TBackgroundWorker;
    procedure ServiceWorkerDoWork( Sender: TObject; e: TDoWorkEventArgs );
    procedure ServiceWorkerRunCompleted( Sender: TObject; e: TRunWorkerCompletedEventArgs );
  public
    procedure AfterConstruction; override;

  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}
{ TForm1 }

procedure TForm1.AfterConstruction;
begin
  inherited;
  // Service-Instanz
  FService := TService.Create( Self );

  // Der Service-EinAusSchalter
  FServiceWorker := TBackgroundWorker.Create( Self );
  FServiceWorker.OnDoWork := ServiceWorkerDoWork;
  FServiceWorker.OnRunWorkerCompleted := ServiceWorkerRunCompleted;

end;

procedure TForm1.FormShow( Sender: TObject );
begin
  Switch1.IsChecked := FService.IsRunning;
end;

procedure TForm1.ServiceWorkerDoWork( Sender: TObject; e: TDoWorkEventArgs );
begin
  if e.Argument.AsBoolean then
    FService.Activate
  else
    FService.Deactivate;
end;

procedure TForm1.ServiceWorkerRunCompleted( Sender: TObject; e: TRunWorkerCompletedEventArgs );
begin
  AniIndicator1.Visible := False;
  Switch1.Visible := True;

  Switch1.IsChecked := FService.IsRunning;
end;

procedure TForm1.Switch1Switch( Sender: TObject );
begin
  Switch1.Visible := False;
  AniIndicator1.Visible := True;
  FServiceWorker.RunWorkerAsync( Switch1.IsChecked );
end;

{ TService }

procedure TService.Activate;
begin
  if not FIsRunning then
  begin
    Sleep( 1000 );
    case Random( 2 ) of
      1:
        raise Exception.Create( 'Fehlermeldung' );
    end;
    FIsRunning := True;
  end;
end;

procedure TService.Deactivate;
begin
  if FIsRunning then
  begin
    Sleep( 500 );
    FIsRunning := False;
  end;
end;

end.
Angehängte Dateien
Dateityp: zip dp_185328.zip (2,05 MB, 58x aufgerufen)
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)

Geändert von Sir Rufo ( 1. Jun 2015 um 14:55 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#3

AW: BackgroundWorker [ab XE2]

  Alt 1. Jun 2015, 14:47
http://www.delphipraxis.net/185329-q...eck-geben.html mit dem BackgroundWorker

(Source und EXE im Anhang)

Delphi-Quellcode:
unit Form.Main;

interface

uses
  BackgroundWorker,

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls,
  Data.DB, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
  FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
  FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.Actions, Vcl.ActnList,
  Vcl.ToolWin, Vcl.Grids, Vcl.DBGrids;

type
  TForm1 = class( TForm )
    DBGrid1: TDBGrid;
    ToolBar1: TToolBar;
    ProgressBar1: TProgressBar;
    ToolButton1: TToolButton;
    ActionList1: TActionList;
    GetDataAction: TAction;
    DataSource1: TDataSource;
    Label1: TLabel;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    CancelAction: TAction;
    GetDataExceptionAction: TAction;
    procedure GetDataActionExecute( Sender: TObject );
    procedure GetDataActionUpdate( Sender: TObject );
    procedure CancelActionExecute( Sender: TObject );
    procedure CancelActionUpdate( Sender: TObject );
    procedure GetDataExceptionActionExecute( Sender: TObject );
    procedure GetDataExceptionActionUpdate( Sender: TObject );
  private
    FGetDataWorker: TBackgroundWorker;
    FDataTable: TFDMemTable;
    procedure StartDataWorker( AValue: Integer );
    procedure GetDataWorkerDoWork( Sender: TObject; e: TDoWorkEventArgs );
    procedure GetDataWorkerRunWorkerCompleted( Sender: TObject; e: TRunWorkerCompletedEventArgs );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form1: TForm1;

implementation

uses
  Unit2;

{$R *.dfm}

procedure TForm1.AfterConstruction;
begin
  inherited;
  FGetDataWorker := TBackgroundWorker.Create( Self );
  FGetDataWorker.OnDoWork := GetDataWorkerDoWork;
  FGetDataWorker.OnRunWorkerCompleted := GetDataWorkerRunWorkerCompleted;
  FGetDataWorker.WorkerReportsProgress := False;
  FGetDataWorker.WorkerSupportsCancellation := True;
end;

procedure TForm1.BeforeDestruction;
begin
  inherited;
  FreeAndNil( FDataTable );
end;

procedure TForm1.CancelActionExecute( Sender: TObject );
begin
  FGetDataWorker.CancelAsync( );
end;

procedure TForm1.CancelActionUpdate( Sender: TObject );
begin
  TAction( Sender ).Enabled := FGetDataWorker.IsBusy and FGetDataWorker.WorkerSupportsCancellation and not FGetDataWorker.CancellationRequested;
end;

procedure TForm1.GetDataActionExecute( Sender: TObject );
begin
  StartDataWorker( 0 );
end;

procedure TForm1.GetDataActionUpdate( Sender: TObject );
begin
  TAction( Sender ).Enabled := not FGetDataWorker.IsBusy;
end;

procedure TForm1.GetDataExceptionActionExecute( Sender: TObject );
begin
  StartDataWorker( 1 );
end;

procedure TForm1.GetDataExceptionActionUpdate( Sender: TObject );
begin
  TAction( Sender ).Enabled := not FGetDataWorker.IsBusy;
end;

procedure TForm1.GetDataWorkerDoWork( Sender: TObject; e: TDoWorkEventArgs );
begin
  Sleep( 500 );
  if TBackgroundWorker( Sender ).CancellationRequested then
  begin
    e.Cancel := True;
    Exit;
  end;
  Sleep( 2000 );
  if TBackgroundWorker( Sender ).CancellationRequested then
  begin
    e.Cancel := True;
    Exit;
  end;
  // Ab jetzt kann nicht mehr abgebrochen werden
  Sleep( 1000 );

  case e.Argument.AsInteger of
    0:
      e.Result := TFDMemTable.Create( nil );
    1:
      raise Exception.Create( 'Irgendeine Fehlermeldung' );
  end;

end;

procedure TForm1.GetDataWorkerRunWorkerCompleted( Sender: TObject; e: TRunWorkerCompletedEventArgs );
begin
  ProgressBar1.Visible := False;
  if Assigned( e.Error ) then
  begin
    Label1.Visible := True;
    Label1.Caption := e.Error.ToString( );
  end
  else
  begin
    if e.Cancelled then
    begin
      Label1.Visible := True;
      Label1.Caption := 'Cancelled';
    end
    else
    begin
      FDataTable := e.Result.AsType<TFDMemTable>;
      DataSource1.DataSet := FDataTable;
      DBGrid1.Visible := True;
    end;
  end;
end;

procedure TForm1.StartDataWorker( AValue: Integer );
begin
  // Altes Ergebnis löschen
  FreeAndNil( FDataTable );

  Label1.Visible := False;
  DBGrid1.Visible := False;
  ProgressBar1.Visible := True;
  ProgressBar1.Style := TProgressBarStyle.pbstMarquee;

  // BackgroundWorker starten
  FGetDataWorker.RunWorkerAsync( AValue );
end;

end.
Angehängte Dateien
Dateityp: zip dp_185311.zip (1,40 MB, 61x aufgerufen)
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)

Geändert von Sir Rufo ( 1. Jun 2015 um 14:56 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#4

AW: BackgroundWorker [ab XE2]

  Alt 1. Jun 2015, 15:59
Und hier noch ein kommentiertes Beispiel
Delphi-Quellcode:
unit Unit3;

interface

uses
  BackgroundWorker,

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Actions, Vcl.ActnList,
  Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm3 = class( TForm )
    ActionList1: TActionList;
    RunAction: TAction;
    CancelAction: TAction;
    ProgressBar1: TProgressBar;
    ProgressInfoLabel: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure RunActionExecute( Sender: TObject );
    procedure CancelActionExecute( Sender: TObject );
    procedure CancelActionUpdate( Sender: TObject );
    procedure RunActionUpdate( Sender: TObject );
  private
    FWorker: TBackgroundWorker;
    procedure WorkerDoWork( Sender: TObject; e: TDoWorkEventArgs );
    procedure WorkerProgressChanged( Sender: TObject; e: TProgressChangedEventArgs );
    procedure WorkerRunWorkerCompleted( Sender: TObject; e: TRunWorkerCompletedEventArgs );
  public
    procedure AfterConstruction; override;

  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}
{ TForm3 }

procedure TForm3.CancelActionExecute( Sender: TObject );
begin
  FWorker.CancelAsync( );
end;

procedure TForm3.CancelActionUpdate( Sender: TObject );
begin
  // Abbrechen ist nur möglich/sinnvoll, wenn
  // - der Worker läuft
  // - der Worker das Abbrechen unterstützt
  // - der Worker noch nicht zum Abbrechen aufgefordert wurde
  TAction( Sender ).Enabled := FWorker.IsBusy and FWorker.WorkerSupportsCancellation and not FWorker.CancellationRequested;
end;

procedure TForm3.RunActionExecute( Sender: TObject );
begin
  // Darstellung vorbereiten
  ProgressInfoLabel.Caption := 'läuft...';
  ProgressBar1.Style := TProgressBarStyle.pbstMarquee;

  // Worker starten
  FWorker.RunWorkerAsync( 'Argument' );
end;

procedure TForm3.RunActionUpdate( Sender: TObject );
begin
  // Der Worker kann nur gestartet werden, wenn der aktuell nicht läuft
  TAction( Sender ).Enabled := not FWorker.IsBusy;
end;

procedure TForm3.AfterConstruction;
begin
  inherited;
  FWorker := TBackgroundWorker.Create( Self );
  // Eventhandler zuweisen
  FWorker.OnDoWork := WorkerDoWork; // Das läuft im Thread
  FWorker.OnProgressChanged := WorkerProgressChanged;
  FWorker.OnRunWorkerCompleted := WorkerRunWorkerCompleted;
  // Einstellungen setzen
  FWorker.WorkerReportsProgress := True;
end;

procedure TForm3.WorkerDoWork( Sender: TObject; e: TDoWorkEventArgs );
var
  LArgument: string;
  LIdx: Integer;
begin
  // Dieser Teil kann abgebrochen werden
  TBackgroundWorker( Sender ).WorkerSupportsCancellation := True;

  // Argument vom Aufruf
  LArgument := e.Argument.ToString( );

  // Wir warten mal ein Weilchen
  Sleep( 500 );

  // Arbeit simulieren
  for LIdx := 1 to 100 do
  begin

    // Auf Abbruchanforderung prüfen
    if TBackgroundWorker( Sender ).CancellationRequested then
    begin
      e.Cancel := True; // Ja, wir haben die Verarbeitung abgebrochen
      Exit; // raus hier
    end;

    Sleep( 10 );

    // Fortschritt mitteilen
    TBackgroundWorker( Sender ).ReportProgress(
      {PercentProgress} LIdx,
      {UserState} Format( 'Satz: %d', [ LIdx ] ) );
  end;

  // Ab jetzt kann nicht mehr abgebrochen werden
  TBackgroundWorker( Sender ).WorkerSupportsCancellation := False;

  Sleep( 1000 );

  // Ergebnis übergeben
  e.Result := 'Result: ' + LArgument;
end;

procedure TForm3.WorkerProgressChanged( Sender: TObject; e: TProgressChangedEventArgs );
begin
  ProgressBar1.Style := TProgressBarStyle.pbstNormal;
  ProgressBar1.Position := e.PercentProgress;

  ProgressInfoLabel.Caption := e.UserState.ToString( );
end;

procedure TForm3.WorkerRunWorkerCompleted( Sender: TObject; e: TRunWorkerCompletedEventArgs );
begin
  if Assigned( e.Error ) then // Es gab einen Fehler
    ProgressInfoLabel.Caption := e.Error.ToString( )
  else if e.Cancelled then // oder es wurde abgebrochen
    ProgressInfoLabel.Caption := 'abgebrochen'
  else // oder die Aufgabe wurde komplett abgearbeitet
    ProgressInfoLabel.Caption := e.Result.ToString( );
end;

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)
  Mit Zitat antworten Zitat
Benutzerbild von sh17
sh17

Registriert seit: 26. Okt 2005
Ort: Radebeul
1.592 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: BackgroundWorker [ab XE2]

  Alt 2. Jun 2015, 06:25


Für alle vor XE gabs noch diesen:

http://www.delphiarea.com/products/d...kgroundworker/

und jenen

http://andy.jgknet.de/blog/bugfix-un...unction-calls/
Sven Harazim
--
  Mit Zitat antworten Zitat
Benutzerbild von borncrush
borncrush

Registriert seit: 18. Dez 2005
Ort: Berlin
115 Beiträge
 
Delphi XE7 Enterprise
 
#6

AW: BackgroundWorker [ab XE2]

  Alt 2. Jun 2015, 09:54
Hallo,
ich bin eher ein starker Forum-Leser .. aber diesmal ich mal Lob für Sir Rufo aussprechen.
Sind immer super antworten und dieser Thread hat mein Wissen wieder deutlich erweitert. Toll!


Ich weiß zwar nicht woher die Motivation kommt, aber TOLL!!!
Delphi programming
  Mit Zitat antworten Zitat
ConstantGardener

Registriert seit: 24. Jan 2006
Ort: Halberstadt
375 Beiträge
 
Delphi 10.4 Sydney
 
#7

AW: BackgroundWorker [ab XE2]

  Alt 3. Jun 2015, 06:27
...kann mich meinem Vorredner nur anschließen!

Andreas Schachtner
  Mit Zitat antworten Zitat
Headbucket

Registriert seit: 12. Dez 2013
Ort: Dresden
172 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#8

AW: BackgroundWorker [ab XE2]

  Alt 3. Jun 2015, 07:39
Wenn wir schon dabei sind: Ich muss mich auch als Sir Rufo Fan outen.

Die Erklärungen sowie Beispielcodes sind stets gut verständlich und sehr ausführlich.
Ich konnte mir bereits viel abschauen und werde wohl auch in Zukunft noch sehr viel lernen.

Vielen Dank dafür und weiter so!

Edit: Solltest du dich irgendwann dazu entscheiden Programmier-Kurse zu geben, dann wäre ich sofort dabei!
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

Registriert seit: 20. Jan 2006
Ort: Lübbecke
10.977 Beiträge
 
Delphi 12 Athens
 
#9

AW: BackgroundWorker [ab XE2]

  Alt 3. Jun 2015, 07:46
Solltest du dich irgendwann dazu entscheiden Programmier-Kurse zu geben, dann wäre ich sofort dabei!
http://www.delphitage.de/index.php/callforpapers/
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#10

AW: BackgroundWorker [ab XE2]

  Alt 13. Sep 2015, 11:44
Der BackgroundWorker ist nun auch bei github zu finden

https://github.com/SirRufo/BackgroundWorker
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)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:30 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz