AGB  ·  Datenschutz  ·  Impressum  







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

Laufende whileschleife auf Knopfdruck unterbrechen

Ein Thema von HL92 · begonnen am 13. Feb 2015 · letzter Beitrag vom 24. Feb 2015
 
Benutzerbild von Sir Rufo
Sir Rufo

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

AW: Laufende whileschleife auf Knopfdruck unterbrechen

  Alt 16. Feb 2015, 18:31
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
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
 


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 14:25 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