Laufende whileschleife auf Knopfdruck unterbrechen

[Sir Rufo]

Da ich per PN danach gefragt wurde, hier eine (schnell dahin getippte) Variante für so einen IdleJob :

Die Basis:

Delphi-Quellcode:

unit uIdleJob;

interface

uses
  {System.}Classes, {TNotifyEvent}
  {Vcl.}AppEvnts; {TApplicationEvents}

type
  TJobFinishState = ( jfsCancelled, jfsFinished );
  TFinishNotifyEvent = procedure( Sender: TObject; State: TJobFinishState ) of object;

  TIdleJob = class abstract
  private
    FAppEvnt: TApplicationEvents;
    FOnFinish: TFinishNotifyEvent;
    FOnStep: TNotifyEvent;
    procedure HandleOnIdle( Sender: TObject; var Done: Boolean );
    function GetIsRunning: Boolean;
    procedure DoOnFinish( AState: TJobFinishState );
    procedure DoOnStep;
  protected
    procedure DoStart; virtual;
    procedure DoStep; virtual; abstract;
    procedure DoStop; virtual;
    procedure JobFinished( NotifyLastStep: Boolean = True );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

    procedure Start;
    procedure Stop;

    property IsRunning: Boolean read GetIsRunning;
    property OnFinish: TFinishNotifyEvent read FOnFinish write FOnFinish;
    property OnStep: TNotifyEvent read FOnStep write FOnStep;
  end;

implementation

{ TIdleJob }

procedure TIdleJob.AfterConstruction;
begin
  inherited;
  FAppEvnt := TApplicationEvents.Create( nil );
end;

procedure TIdleJob.BeforeDestruction;
begin
  FAppEvnt.Free;
  inherited;
end;

procedure TIdleJob.DoOnFinish( AState: TJobFinishState );
begin
  if Assigned( FOnFinish )
  then
    FOnFinish( Self, AState );
end;

procedure TIdleJob.DoOnStep;
begin
  if Assigned( FOnStep )
  then
    FOnStep( Self );
end;

procedure TIdleJob.JobFinished( NotifyLastStep: Boolean );
begin
  FAppEvnt.OnIdle := nil;
  if NotifyLastStep
  then
    DoOnStep;
  DoOnFinish( jfsFinished );
end;

procedure TIdleJob.DoStart;
begin
end;

procedure TIdleJob.DoStop;
begin
end;

function TIdleJob.GetIsRunning: Boolean;
begin
  Result := Assigned( FAppEvnt.OnIdle );
end;

procedure TIdleJob.HandleOnIdle( Sender: TObject; var Done: Boolean );
begin
  DoStep( );
  if IsRunning
  then
    DoOnStep;
end;

procedure TIdleJob.Start;
begin
  if IsRunning
  then
    Exit;

  FAppEvnt.OnIdle := HandleOnIdle;
  DoStart;
  DoOnStep;
end;

procedure TIdleJob.Stop;
begin
  if not IsRunning
  then
    Exit;

  FAppEvnt.OnIdle := nil;
  DoStop;
  DoOnFinish( jfsCancelled );
end;

end.

Eine Loop Ableitung:

Delphi-Quellcode:

unit uMyLoopJob;

interface

uses
  System.SysUtils,
  uIdleJob;

type
  TMyLoopJob = class( TIdleJob )
  private
    FFrom, FTo, FStep: Integer;
    FCurrent: Integer;
  protected
    procedure DoStart; override;
    procedure DoStep; override;
    procedure DoStop; override;
  public
    constructor Create( const AFrom, ATo, AStep: Integer );

    property Current: Integer read FCurrent;
  end;

implementation

{ TMyLoopJob }

constructor TMyLoopJob.Create( const AFrom, ATo, AStep: Integer );
begin
  inherited Create;
  FFrom := AFrom;
  FTo := ATo;
  FStep := AStep;
end;

procedure TMyLoopJob.DoStart;
begin
  inherited;
  FCurrent := FFrom;
end;

procedure TMyLoopJob.DoStep;
begin
  inherited;
  Sleep( 20 ); // Wir simulieren mal ein bisserl Rechenlast
  Inc( FCurrent );
  if FCurrent >= FTo
  then
    begin
      FCurrent := FTo;
      JobFinished( True );
    end;
end;

procedure TMyLoopJob.DoStop;
begin
  inherited;
  // nichts zu tun hier
end;

end.

und jetzt mit einer Form zusammen

Delphi-Quellcode:

unit Unit2;

interface

uses
  uIdleJob, uMyLoopJob,

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

type
  TForm2 = class( TForm )
    StartLoopButton: TButton;
    StopLoopButton: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    procedure StartLoopButtonClick( Sender: TObject );
    procedure StopLoopButtonClick( Sender: TObject );
  private
    FLoopJob: TMyLoopJob;
    procedure LoopJobStep( Sender: TObject );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
{ TForm2 }

procedure TForm2.AfterConstruction;
begin
  inherited;
  FLoopJob := TMyLoopJob.Create( 1, 100, 1 );
  FLoopJob.OnStep := LoopJobStep;
end;

procedure TForm2.BeforeDestruction;
begin
  FLoopJob.Free;
  inherited;
end;

procedure TForm2.StartLoopButtonClick( Sender: TObject );
begin
  FLoopJob.Start;
end;

procedure TForm2.StopLoopButtonClick( Sender: TObject );
begin
  FLoopJob.Stop;
end;

procedure TForm2.LoopJobStep( Sender: TObject );
begin
  Label1.Caption := IntToStr( FLoopJob.Current );
  ProgressBar1.Position := FLoopJob.Current;
end;

end.

Was man hier schön sieht:

Die Basis kümmert sich um den gesamten Verwaltungskram, der konkrete Job nur noch um sich selber und die Form steuert/reagiert nur noch.
Oder anders ausgedrückt, je konkreter ich werde umso weniger Code muss ich schreiben