Controls sofort aktualisieren ohne ProcessMessages

[Photoner]

Delphi XE 5 ; FireMonkey HD Anwendung ; Exklusiv für Windows

Ich hätte gerne ein paar Controls, die eine Rückmeldung an den User geben sollen, sofort aktualisiert. Ich habe das bisher nur mit einem

Delphi-Quellcode:

 Application.ProcessMessages

hinbekommen. Geht das auch ohne?

Ich habe ein Minimalbeispiel dazu gestrickt:

Delphi-Quellcode:

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Objects, FMX.Edit;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Circle1: TCircle;
    procedure Edit1Change(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

procedure TForm2.Edit1Change(Sender: TObject);
begin

  // Anzeige das etwas geschieht und etwas Zeit dauert
  Circle1.Fill  :=  TBrush.Create(TBrushKind.bkSolid,TAlphaColorRec.Black);
  Label1.Text   :=  'Schwarz';

  // gibt es eine Möglichkeit das ProcessMessages zu umgehen?
  FMX.Forms.Application.ProcessMessages;

  // sleep als Ersatz für eine etwas länger dauernde Prozedur
  sleep(2500);

  // fertig
  Circle1.Fill  :=  TBrush.Create(TBrushKind.bkSolid,TAlphaColorRec.White);
  Label1.Text   :=  'Weiß';

end;

end.

[stahli]

Da FMX die GUI im Mainthread zeichnet wird es ohne Application.ProcessMessages nicht gehen.

Ich hatte zu dem Themenbereich mal einen Beitrag gestartet: http://www.delphipraxis.net/175033-f...-schlecht.html
Dort ist auch ein kleines Testprojekt, das mal eine "eigene primitive GUI" (zumindest ein paar sehr spartanische Controls) unabhängig vom Mainthread versucht.
Zumindest ich hatte aus den Demovideos zu FMX anfänglich herausgelesen, dass FMX offenbar unabhängig vom Mainthread gerendert wird (wegen animierten Effekten und dem AniIndicator, "der ja augenscheinlich völlig autark lief"), was aber leider so doch nicht zutraf.

[Dalai]

Ich hab keine Ahnung von FMX, aber vielleicht genügt ein T(Win)Control.Update bzw. Refresh, Repaint etc? Sofern diese Methoden dort existieren.

MfG Dalai

[Sir Rufo]

Die Antwort steht im Tutorial http://www.delphipraxis.net/185749-f...-callback.html

[Uwe Raabe]

Ich kann jetzt gerade nicht probieren, ob es auch unter XE5 funktioniert, aber in XE8 tut es ein simples

Delphi-Quellcode:

PaintTo(Canvas);

um das Form komplett zu aktualisieren.

[Harry Stahl]

Unter XE5 funktioniert PaintTo (canvas) ebenfalls.

[Sir Rufo]

Auch wenn das funktioniert, friert die Anwendung trotzdem für 2,5 Sekunden ein.

Das ist nicht so im Sinne des UIThread-Erfinders, gelle?

[Mavarik]

Das Stichwort heißt : TIdleWorker

Mavarik

[Sir Rufo]

Zitat:

Zitat von Mavarik (Beitrag 1307874)

Das Stichwort heißt : TIdleWorker

Mavarik

Nein, eine Aktion, die 2,5 Sekunden dauert gehört in einen Thread und nicht in den UIThread

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1307877)

Nein, eine Aktion, die 2,5 Sekunden dauert gehört in einen Thread und nicht in den UIThread

Ja und nein...

Leider ist es so, dass auf einem "schlappen" 1-CPU-1-Core-Device ein Thread die Performance des UIThread's so schmälert, dass z.B. die Timer-Animationen von Firemonkey nicht mehr "schön" laufen...

Daher die Devise: UIAktion's Event entgegen nehmen (z.b. ein OnClick) dann kurz den IdleWorker initialisieren und so schnell wie möglich die komplette CPU Zeit an die UIThread abgeben...

Wenn das OnIdle dann aufgerufen wird, kann "Deine" 2,5 Sekunden Aktion gerne in einem "richtigen" Thread gestartet werden... Aber erst dann...

Wahrscheinlich wird man sowieso vorher ein "processing" an zeigen...

[Photoner]

Danke für die Antworten!

[Photoner]

Noch mal ich :)

Ich bin nicht der fleißigste Schreiber aber ich lese viel und versuche das dann auch zu verstehen und anzuwenden. Also noch mal vielen Dank für all die Antworten. Könntet Ihr mir aber noch Tips geben was ich in der folgenden Lösung ( Stichwort Konstruktorinjektion und die Parameter der Konstruktoren) noch alles besser machen kann?
Und wie kriege ich die Synchronize Aufrufe schöner hin?

Delphi-Quellcode:

  TProc = reference to procedure;

- habe ich -

Delphi-Quellcode:

  TThreadProcedure = reference to procedure;

brauche ich für Synchronize.

Delphi-Quellcode:

unit AnonThreadCallback;

interface

uses
  System.Classes,
  System.SysUtils,
  System.SyncObjs;
type
  TAnonThreadCallback = class(TThread)
    private
      FAction         : TProc;
      FCallback       : TProc;
      FSyncedAction   : Boolean;
      FSyncedCallback : Boolean;
      FWorkEvent      : TEvent;
    protected
      procedure Execute; override;
      procedure TerminatedSet; override;
    public
      constructor Create(AProc  : TProc;  Suspended  : Boolean = False); overload;
      constructor Create(AProc  : TProc;  ACallBack  : TProc; Suspended : Boolean = False) overload;
      constructor Create(AProc  : TProc;  ACallBack  : TProc; SyncedCallback  : Boolean;  Suspended : Boolean = False) overload;
      constructor Create(AProc  : TProc;  SyncedProc  : Boolean;  Suspended  : Boolean = False); overload;
      constructor Create(AProc  : TProc;  SyncedProc  : Boolean;  ACallBack : TProc;  Suspended  : Boolean = False); overload;
      constructor Create(AProc  : TProc;  SyncedProc  : Boolean;  ACallBack : TProc;  SyncedCallback  : Boolean; Suspended  : Boolean = False); overload;
      destructor Destroy; override;
      procedure   Start();
  end;

implementation

{ TAnonThreadCallback }

constructor TAnonThreadCallback.Create(AProc: TProc; SyncedProc: Boolean;
  ACallBack: TProc; SyncedCallback  : Boolean;  Suspended : Boolean);
begin
  FWorkEvent := TEvent.Create( nil, True, False, '' );
  FreeOnTerminate :=  True;
  FAction         :=  AProc;
  FSyncedAction   :=  SyncedProc;
  FCallback       :=  ACallBack;
  FSyncedCallback :=  SyncedCallback;
  inherited Create();
  if not Suspended then Start();
end;

destructor TAnonThreadCallback.Destroy;
begin
  FreeAndNil(FWorkEvent);
  inherited;
end;

constructor TAnonThreadCallback.Create(AProc, ACallBack: TProc; SyncedCallback,
  Suspended: Boolean);
begin
  Create(AProc,False,ACallBack,SyncedCallback,Suspended);
end;

constructor TAnonThreadCallback.Create(AProc, ACallBack: TProc;
  Suspended: Boolean);
begin
  Create(AProc,False,ACallBack,False,Suspended);
end;

constructor TAnonThreadCallback.Create(AProc: TProc; Suspended: Boolean);
begin
  Create(AProc,False,nil,False,Suspended);
end;

constructor TAnonThreadCallback.Create(AProc: TProc; SyncedProc,
  Suspended: Boolean);
begin
  Create(AProc,SyncedProc,nil,False,Suspended);
end;

constructor TAnonThreadCallback.Create(AProc: TProc; SyncedProc: Boolean;
  ACallBack: TProc; Suspended: Boolean);
begin
  Create(AProc,SyncedProc,ACallBack,False,Suspended);
end;

procedure TAnonThreadCallback.Execute;
begin
  inherited;
  if FWorkEvent.WaitFor()=wrSignaled then
    if not Terminated then begin
      if FSyncedAction then TThread.Synchronize(nil,procedure begin FAction() end)
      else FAction();
      if Assigned(FCallback) then
        if FSyncedCallback then TThread.Synchronize(nil,procedure begin FCallback() end)
        else FCallback();
    end;
end;


procedure TAnonThreadCallback.Start;
begin
  FWorkEvent.SetEvent;
end;



procedure TAnonThreadCallback.TerminatedSet;
begin
  inherited;
  Start();
end;

end.

Um das Beispiel noch mal aufzugreifen:

Delphi-Quellcode:

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Objects, FMX.Edit,AnonThreadCallback;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Circle1: TCircle;
    procedure Edit1Change(Sender: TObject);
    procedure Fertig;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

procedure TForm2.Edit1Change(Sender: TObject);
begin

  // Anzeige das etwas geschieht und etwas Zeit dauert
  Circle1.Fill := TBrush.Create(TBrushKind.bkSolid,TAlphaColorRec.Black);
  Label1.Text := 'Schwarz';

  // gibt es eine Möglichkeit das ProcessMessages zu umgehen?
  //FMX.Forms.Application.ProcessMessages;

  // sleep als Ersatz für eine etwas länger dauernde Prozedur
  //sleep(2500);
  TAnonThreadCallback.Create(procedure
                             begin
                              sleep(2500);
                             end,
                             procedure
                             begin
                              Fertig();
                             end,
                             True,
                             False);
  // fertig
  //Circle1.Fill := TBrush.Create(TBrushKind.bkSolid,TAlphaColorRec.White);
  //Label1.Text := 'Weiß';

end;

procedure TForm2.Fertig;
begin
  // fertig
  Circle1.Fill := TBrush.Create(TBrushKind.bkSolid,TAlphaColorRec.White);
  Label1.Text := 'Weiß';
end;

end.

[Sir Rufo]

Du solltest so ein Konstrukt niemals direkt aufrufen, weil du dich dann einfach nur abhängig machst und schon zu schnell konkret werden musst.

Besser ist es, die konkrete Aktion zu verstecken und dann aufzurufen.

Delphi-Quellcode:

type
  IWorkerService = interface
    [{GUID}]
    // Macht irgendwas und ruft am Ende den callback auf
    procedure DoSomething( callback : TProc<Exception> );
  end;

In der Form wird das Interface dann wie folgt verwendet

Delphi-Quellcode:

procedure TMyForm.ButtonSomethingClick(Sender: TObject);
begin
  // Vor der Ausführung
  ButtonSomething.Enabled := False;

  // Ausführung starten
  FWorkerService.DoSomething(
    procedure( AException: Exception )
    begin

      // nach der Ausführung
      ButtonSomething.Enabled := True;
    end;
end;

So jetzt bauen wir uns mal einen konkreten Service, der auf ganz billige Art und Weise diese 2,5 Sekunden wartet:

Delphi-Quellcode:

TSimpleService = class( TInterfacedObject, IWorkerService )
  procedure DoSomething( callback : TProc<Exception> );
end;

procedure TSimpleService.DoSomething( callback : TProc<Exception> );
var
  LStart : TDateTime;
begin
  LStart := Now;
  while MillisecondsBetween( LNow, LThen ) < 2500 do
  begin
    Sleep(10);
    Application.ProcessMessages; // völlig egal erstmal, wir wollen Ergebnisse sehen
  end;
  callback( nil );
end;

Nun sehen wir schon die ersten Erfolge, der Button ist für 2,5 Sekunden ausser Gefecht gesetzt.

Jetzt setzen wir uns daran, dass Geraffel in einen Thread zu packen, was jetzt völlig losgelöst von der Oberfläche erfolgen kann.