AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

BackgroundWorker [ab XE2]

Ein Thema von Sir Rufo · begonnen am 1. Jun 2015 · letzter Beitrag vom 13. Sep 2015
 
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, 62x 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
 


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 05:24 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz