BackgroundWorker [ab XE2]

[Sir Rufo]

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.

[Sir Rufo]

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.

[Sir Rufo]

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.