![]() |
AW: Controls sofort aktualisieren ohne ProcessMessages
Danke für die Antworten!
|
AW: Controls sofort aktualisieren ohne ProcessMessages
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:
- habe ich -
TProc = reference to procedure;
Delphi-Quellcode:
brauche ich für Synchronize.
TThreadProcedure = reference to procedure;
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. |
AW: Controls sofort aktualisieren ohne ProcessMessages
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:
In der Form wird das Interface dann wie folgt verwendet
type
IWorkerService = interface [{GUID}] // Macht irgendwas und ruft am Ende den callback auf procedure DoSomething( callback : TProc<Exception> ); end;
Delphi-Quellcode:
So jetzt bauen wir uns mal einen konkreten Service, der auf ganz billige Art und Weise diese 2,5 Sekunden wartet:
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;
Delphi-Quellcode:
Nun sehen wir schon die ersten Erfolge, der Button ist für 2,5 Sekunden ausser Gefecht gesetzt.
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; Jetzt setzen wir uns daran, dass Geraffel in einen Thread zu packen, was jetzt völlig losgelöst von der Oberfläche erfolgen kann. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:59 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