AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein GUI-Design mit VCL / FireMonkey / Common Controls Delphi Controls sofort aktualisieren ohne ProcessMessages
Thema durchsuchen
Ansicht
Themen-Optionen

Controls sofort aktualisieren ohne ProcessMessages

Ein Thema von Photoner · begonnen am 6. Jul 2015 · letzter Beitrag vom 7. Jul 2015
Antwort Antwort
Seite 2 von 2     12   
Photoner

Registriert seit: 6. Dez 2012
Ort: Nürnberg
103 Beiträge
 
Delphi 10.1 Berlin Starter
 
#11

AW: Controls sofort aktualisieren ohne ProcessMessages

  Alt 7. Jul 2015, 09:00
Danke für die Antworten!
Chris
  Mit Zitat antworten Zitat
Photoner

Registriert seit: 6. Dez 2012
Ort: Nürnberg
103 Beiträge
 
Delphi 10.1 Berlin Starter
 
#12

AW: Controls sofort aktualisieren ohne ProcessMessages

  Alt 7. Jul 2015, 14:07
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?   TProc = reference to procedure; - habe ich -   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.
Chris
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

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

AW: Controls sofort aktualisieren ohne ProcessMessages

  Alt 7. Jul 2015, 14:48
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.
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
Antwort Antwort
Seite 2 von 2     12   

 

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 17:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz