AGB  ·  Datenschutz  ·  Impressum  







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

Ansatz für Task-Queue Sequenz

Ein Thema von Rollo62 · begonnen am 17. Jun 2015 · letzter Beitrag vom 7. Jul 2015
 
Benutzerbild von Sir Rufo
Sir Rufo

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

AW: Ansatz für Task-Queue Sequenz

  Alt 17. Jun 2015, 12:43
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.
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 (17. Jun 2015 um 13:01 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 18:44 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