BackgroundWorker [ab XE2]

[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.