Ansatz für Task-Queue Sequenz

[Sir Rufo]

Also hier mal so ein IdleWorker, der dann auch die Delays berücksichtigt (ACHTUNG: So nur für FMX, für die VCL müsste man die IdleMessage selber verschicken)

Delphi-Quellcode:

unit IdleWorker;

interface

uses
  System.Generics.Collections, System.Generics.Defaults,
  System.Messaging, System.SysUtils, System.TimeSpan, System.DateUtils;

type
  TIdleWorker = class
  private const
    MinWorkingTime = 20;
    DefaultWorkingTime = 50;
  type
    TTask = record
      Action: TProc;
      ExecuteAfter: TDateTime;
    end;
  private
    FTasks: TList<TTask>;
    FWorkingTime: Cardinal;
    procedure SetWorkingTime( const Value: Cardinal );
  protected
    procedure HandleIdleMessage( const Sender: TObject; const m: TMessage );
  public
    constructor Create( );
    destructor Destroy; override;

    procedure Execute( Action: TProc ); overload;
    procedure Execute( Action: TProc; ADelay: TTimeSpan ); overload;
    procedure Execute( Action: TProc; ADelay: Cardinal ); overload;
    procedure Execute( Action: TProc; AExecuteAfter: TDateTime ); overload;

    property WorkingTime: Cardinal read FWorkingTime write SetWorkingTime default DefaultWorkingTime;
  private
    class var _Default: TIdleWorker;
  protected
    class destructor Destroy;
  public
    class function Default: TIdleWorker;
  end;

implementation

uses
  System.Diagnostics,
  FMX.Types;

{ TIdleWorker }

constructor TIdleWorker.Create;
begin
  inherited;
  FWorkingTime := DefaultWorkingTime;
  FTasks := TList<TTask>.Create( TComparer<TTask>.Construct(
    function( const L, R: TTask ): integer
    begin
      Result := CompareDateTime( R.ExecuteAfter, L.ExecuteAfter );
    end ) );

  TMessageManager.DefaultManager.SubscribeToMessage( TIdleMessage, HandleIdleMessage );
end;

class function TIdleWorker.Default: TIdleWorker;
begin
  if not Assigned( _Default ) then
    _Default := TIdleWorker.Create( );
  Result := _Default;
end;

class destructor TIdleWorker.Destroy;
begin
  FreeAndNil( _Default );
end;

destructor TIdleWorker.Destroy;
begin
  TMessageManager.DefaultManager.Unsubscribe( TIdleMessage, HandleIdleMessage );
  FTasks.Free;
  inherited;
end;

procedure TIdleWorker.Execute( Action: TProc; ADelay: TTimeSpan );
begin
  Execute( Action, Now + ADelay );
end;

procedure TIdleWorker.Execute( Action: TProc );
begin
  Execute( Action, Now );
end;

procedure TIdleWorker.Execute( Action: TProc; AExecuteAfter: TDateTime );
var
  LTask: TTask;
begin
  LTask.Action := Action;
  LTask.ExecuteAfter := AExecuteAfter;
  FTasks.Add( LTask );
  FTasks.Sort( );
end;

procedure TIdleWorker.HandleIdleMessage( const Sender: TObject; const m: TMessage );
var
  LTask: TTask;
  LSW: TStopwatch;
begin
  LSW := TStopwatch.StartNew( );
  while ( LSW.ElapsedMilliseconds < FWorkingTime ) do
  begin
    if ( FTasks.Count > 0 ) and ( FTasks.Last.ExecuteAfter <= Now ) then
    begin
      LTask := FTasks.Extract( FTasks.Last );
      LTask.Action( );
    end
    else
      Break;
  end;
end;

procedure TIdleWorker.SetWorkingTime( const Value: Cardinal );
begin
  if Value >= MinWorkingTime then
    FWorkingTime := Value;
end;

procedure TIdleWorker.Execute( Action: TProc; ADelay: Cardinal );
begin
  Execute( Action, IncMilliSecond( Now, ADelay ) );
end;

end.

und ein kleiner Testaufruf:

Delphi-Quellcode:

unit Form.Main;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListBox;

type
  TForm1 = class( TForm )
    ListBox1: TListBox;
    Button1: TButton;
    procedure Button1Click( Sender: TObject );
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  System.TimeSpan, IdleWorker;

procedure TForm1.Button1Click( Sender: TObject );
begin
  TIdleWorker.Default.Execute(
    procedure
    begin
      ListBox1.Items.Add( 'Sofort' );
    end );

  TIdleWorker.Default.Execute(
    procedure
    begin
      ListBox1.Items.Add( 'nach 750 Millisekunden' );
    end, 750 );

  TIdleWorker.Default.Execute(
    procedure
    begin
      ListBox1.Items.Add( 'nach 3 Sekunden' );
    end, TTimeSpan.FromSeconds( 3 ) );
end;

end.

Nachtrag
Das ist die Unit, damit die IdleWorker auch unter VCL läuft

Delphi-Quellcode:

unit IdleWorker.VclBroker;

interface

implementation

uses
  FMX.Types,
  System.Classes, System.Messaging,
  Vcl.Forms, Vcl.AppEvnts;

type
  TVclIdleMessageBroker = class( TComponent )
  private
    FAppEvents: TApplicationEvents;
    procedure AppEventsOnIdle( Sender: TObject; var Done: Boolean );
  public
    procedure AfterConstruction; override;
  end;

  { TVclIdleMessageBroker }

procedure TVclIdleMessageBroker.AfterConstruction;
begin
  inherited;
  FAppEvents := TApplicationEvents.Create( Self );
  FAppEvents.OnIdle := AppEventsOnIdle;
end;

procedure TVclIdleMessageBroker.AppEventsOnIdle( Sender: TObject; var Done: Boolean );
begin
  TMessageManager.DefaultManager.SendMessage( Self, TIdleMessage.Create( ) );
end;

initialization

TVclIdleMessageBroker.Create( Application );

end.

Mit der VCL sieht das Beispiel dann so aus:

Delphi-Quellcode:

unit Form.Main;

interface

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

type
  TMainForm = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  System.TimeSpan,
  IdleWorker, 
  IdleWorker.VclBroker {<- den hier nicht vergessen};

procedure TMainForm.Button1Click(Sender: TObject);
begin
  TIdleWorker.Default.Execute(
    procedure
    begin
      ListBox1.Items.Add( 'Sofort' );
    end );

  TIdleWorker.Default.Execute(
    procedure
    begin
      ListBox1.Items.Add( 'nach 750 Millisekunden' );
    end, 750 );

  TIdleWorker.Default.Execute(
    procedure
    begin
      ListBox1.Items.Add( 'nach 3 Sekunden' );
    end, TTimeSpan.FromSeconds( 3 ) );
end;

end.