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
Antwort Antwort
Benutzerbild von Sir Rufo
Sir Rufo

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

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
Antwort Antwort


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 20:54 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