performance - ottimizzare - Gravi problemi di prestazioni di FireMonkey quando ci sono molti controlli sullo schermo




windows 7 lento (2)

È già da un po 'che stiamo lavorando con FireMonkey in ufficio. Dopo un po 'abbiamo notato che non era esattamente così fulmineo a causa dell'accelerazione GPU come ci dice Embarcadero.

Quindi abbiamo creato un'applicazione di base solo per testare le prestazioni di FireMonkey. Fondamentalmente si tratta di un modulo con un pannello in basso (alBottom) che funziona come barra di stato e un pannello di tutti i client (alClient). Il pannello in basso ha una barra di avanzamento e un'animazione.

Abbiamo aggiunto un metodo al form che libera qualsiasi controllo presente nel pannello di tutti i client e lo completa con celle di un tipo personalizzato e uno stile "mouse over" e aggiorna l'animazione, la barra di avanzamento e la didascalia del modulo con informazioni sul compiere progressi. Le informazioni più importanti sono il tempo richiesto.

Infine abbiamo aggiunto un metodo simile a OnResize del modulo, eseguito l'applicazione e ingrandito il modulo (1280x1024).

Il risultato con XE2 è stato molto lento. Ci sono voluti circa 11 secondi. Inoltre, poiché il pannello è soddisfatto fino a quando l'applicazione è pronta a ricevere input dell'utente, vi è un ulteriore ritardo di circa 10 secondi (come il congelamento). Per un totale di 21 secondi.

Con XE3 la situazione peggiora. Per la stessa operazione sono occorsi complessivamente 25 secondi (14 + 11 di congelamento).

E le voci dicono che XE4 sarà molto peggio di XE3.

Questo è abbastanza spaventoso considerando esattamente la stessa applicazione, usando VCL al posto di FireMonkey e usando SpeedButtons per avere lo stesso "effetto mouse over" in soli 1,5 secondi !!! Quindi il problema risiede chiaramente in alcuni problemi interni del motore FireMonkey.

Ho aperto un QC (n. 113795) e un biglietto (a pagamento) al supporto di embarcadero ma nulla non lo risolveranno.

Sinceramente non capisco come possano ignorare una questione così pesante. Per la nostra impresa è essere uno show-stopper e un deal breaker. Non possiamo offrire software commerciale ai nostri clienti con prestazioni così scadenti. Prima o poi saremo costretti a spostarci su un'altra piattaforma (a proposito: lo stesso codice Delphi Prism con WPF impiega 1,5 secondi come quello VCL).

Se qualcuno ha qualche idea su come risolvere il problema o cercare di migliorare le prestazioni di questo test e vuole aiutarmi, ne sarei davvero felice.

Grazie in anticipo.

Bruno Fratini

L'applicazione è la seguente:

unit Performance01Main;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;

const
  cstCellWidth = 45;
  cstCellHeight = 21;

type

  TCell = class(TStyledControl)
  private
    function GetText: String;
    procedure SetText(const Value: String);
    function GetIsFocusCell: Boolean;
  protected
    FSelected: Boolean;
    FMouseOver: Boolean;
    FText: TText;
    FValue: String;
    procedure ApplyStyle; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
    procedure ApplyTrigger(TriggerName: string);
  published
    property IsSelected: Boolean read FSelected;
    property IsFocusCell: Boolean read GetIsFocusCell;
    property IsMouseOver: Boolean read FMouseOver;
    property Text: String read GetText write SetText;
  end;

  TFormFireMonkey = class(TForm)
    StyleBook: TStyleBook;
    BottomPanel: TPanel;
    AniIndicator: TAniIndicator;
    ProgressBar: TProgressBar;
    CellPanel: TPanel;
    procedure FormResize(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  protected
    FFocused: TCell;
    FEntered: Boolean;
  public
    procedure CreateCells;
  end;

var
  FormFireMonkey: TFormFireMonkey;

implementation

uses
  System.Diagnostics;

{$R *.fmx}

{ TCell }

procedure TCell.ApplyStyle;
begin
  inherited;
  ApplyTrigger('IsMouseOver');
  ApplyTrigger('IsFocusCell');
  ApplyTrigger('IsSelected');
  FText:= (FindStyleResource('Text') as TText);
  if (FText <> Nil) then
    FText.Text := FValue;
end;

procedure TCell.ApplyTrigger(TriggerName: string);
begin
  StartTriggerAnimation(Self, TriggerName);
  ApplyTriggerEffect(Self, TriggerName);
end;

procedure TCell.DoMouseEnter;
begin
  inherited;
  FMouseOver:= True;
  ApplyTrigger('IsMouseOver');
end;

procedure TCell.DoMouseLeave;
begin
  inherited;
  FMouseOver:= False;
  ApplyTrigger('IsMouseOver');
end;

function TCell.GetIsFocusCell: Boolean;
begin
  Result:= (Self = FormFireMonkey.FFocused);
end;

function TCell.GetText: String;
begin
  Result:= FValue;
end;

procedure TCell.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  OldFocused: TCell;
begin
  inherited;
  FSelected:= not(FSelected);
  OldFocused:= FormFireMonkey.FFocused;
  FormFireMonkey.FFocused:= Self;
  ApplyTrigger('IsFocusCell');
  ApplyTrigger('IsSelected');
  if (OldFocused <> Nil) then
    OldFocused.ApplyTrigger('IsFocusCell');
end;

procedure TCell.SetText(const Value: String);
begin
  FValue := Value;
  if Assigned(FText) then
    FText.Text:= Value;
end;

{ TForm1 }

procedure TFormFireMonkey.CreateCells;
var
  X, Y: Double;
  Row, Col: Integer;
  Cell: TCell;
  T: TTime;
  // Workaround suggested by Himself 1
  // Force update only after a certain amount of iterations
  // LP: Single;

  // Workaround suggested by Himself 2
  // Force update only after a certain amount of milliseconds
  // Used cross-platform TStopwatch as suggested by LU RD
  // Anyway the same logic was tested with TTime and GetTickCount
  // SW: TStopWatch;

begin
  T:= Time;
  Caption:= 'Creating cells...';

  {$REGION 'Issue 2 workaround: Update form size and background'}
  // Bruno Fratini:
  // Without (all) this code the form background and area is not updated till the
  // cells calculation is finished
  BeginUpdate;
  Invalidate;
  EndUpdate;
  // Workaround suggested by Philnext
  // replacing ProcessMessages with HandleMessage
  // Application.HandleMessage;
  Application.ProcessMessages;
  {$ENDREGION}

  // Bruno Fratini:
  // Update starting point step 1
  // Improving performance
  CellPanel.BeginUpdate;

  // Bruno Fratini:
  // Freeing the previous cells (if any)
  while (CellPanel.ControlsCount > 0) do
    CellPanel.Controls[0].Free;

  // Bruno Fratini:
  // Calculating how many rows and columns can contain the CellPanel
  Col:= Trunc(CellPanel.Width / cstCellWidth);
  if (Frac(CellPanel.Width / cstCellWidth) > 0) then
    Col:= Col + 1;
  Row:= Trunc(CellPanel.Height / cstCellHeight);
  if (Frac(CellPanel.Height / cstCellHeight) > 0) then
    Row:= Row + 1;

  // Bruno Fratini:
  // Loop variables initialization
  ProgressBar.Value:= 0;
  ProgressBar.Max:= Row * Col;
  AniIndicator.Enabled:= True;
  X:= 0;
  Col:= 0;

  // Workaround suggested by Himself 2
  // Force update only after a certain amount of milliseconds
  // Used cross-platform TStopwatch as suggested by LU RD
  // Anyway the same logic was tested with TTime and GetTickCount
  // SW:= TStopwatch.StartNew;

  // Workaround suggested by Himself 1
  // Force update only after a certain amount of iterations
  // LP:= 0;

  // Bruno Fratini:
  // Loop for fulfill the Width
  while (X < CellPanel.Width) do
  begin
    Y:= 0;
    Row:= 0;
    // Bruno Fratini:
    // Loop for fulfill the Height
    while (Y < CellPanel.Height) do
    begin
      // Bruno Fratini:
      // Cell creation and bounding into the CellPanel
      Cell:= TCell.Create(CellPanel);
      Cell.Position.X:= X;
      Cell.Position.Y:= Y;
      Cell.Width:= cstCellWidth;
      Cell.Height:= cstCellHeight;
      Cell.Parent:= CellPanel;

      // Bruno Fratini:
      // Assigning the style that gives something like Windows 7 effect
      // on mouse move into the cell
      Cell.StyleLookup:= 'CellStyle';

      // Bruno Fratini:
      // Updating loop variables and visual controls for feedback
      Y:= Y + cstCellHeight;
      Row:= Row + 1;
      ProgressBar.Value:= ProgressBar.Value + 1;
      // Workaround suggested by Himself 1
      // Force update only after a certain amount of iterations
      // if ((ProgressBar.Value - LP) >= 100) then

      // Workaround suggested by Himself 2
      // Force update only after a certain amount of milliseconds
      // Used cross-platform TStopwatch as suggested by LU RD
      // Anyway the same logic was tested with TTime and GetTickCount
      // if (SW.ElapsedMilliseconds >= 30) then

      // Workaround suggested by Philnext with Bruno Fratini's enhanchment
      // Skip forcing refresh when the form is not focused for the first time
      // This avoid the strange side effect of overlong delay on form open
      // if FEntered then
      begin
        Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
                  ' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));

        {$REGION 'Issue 4 workaround: Forcing progress and animation visual update'}
        // Bruno Fratini:
        // Without the ProcessMessages call both the ProgressBar and the
        // Animation controls are not updated so no feedback to the user is given
        // that is not acceptable. By the other side this introduces a further
        // huge delay on filling the grid to a not acceptable extent
        // (around 20 minutes on our machines between form maximization starts and
        // it arrives to a ready state)

        // Workaround suggested by Philnext
        // replacing ProcessMessages with HandleMessage
        // Application.HandleMessage;
        Application.ProcessMessages;
        {$ENDREGION}

        // Workaround suggested by Himself 1
        // Force update only after a certain amount of iterations
        // LP:= ProgressBar.Value;

        // Workaround suggested by Himself 2
        // Force update only after a certain amount of milliseconds
        // Used cross-platform TStopwatch as suggested by LU RD
        // Anyway the same logic was tested with TTime and GetTickCount
        // SW.Reset;
        // SW.Start;
      end;
    end;
    X:= X + cstCellWidth;
    Col:= Col + 1;
  end;

  // Bruno Fratini:
  // Update starting point step 2
  // Improving performance
  CellPanel.EndUpdate;

  AniIndicator.Enabled:= False;
  ProgressBar.Value:= ProgressBar.Max;
  Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
            ' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));

  // Bruno Fratini:
  // The following lines are required
  // otherwise the cells won't be properly paint after maximizing
  BeginUpdate;
  Invalidate;
  EndUpdate;
  // Workaround suggested by Philnext
  // replacing ProcessMessages with HandleMessage
  // Application.HandleMessage;
  Application.ProcessMessages;
end;

procedure TFormFireMonkey.FormActivate(Sender: TObject);
begin
  // Workaround suggested by Philnext with Bruno Fratini's enhanchment
  // Skip forcing refresh when the form is not focused for the first time
  // This avoid the strange side effect of overlong delay on form open
  FEntered:= True;
end;

procedure TFormFireMonkey.FormResize(Sender: TObject);
begin
  CreateCells;
end;

end.

Ho provato il tuo codice, ci vuole 00: 10: 439 sul mio PC su XE3 per riempire lo schermo con le celle. Disabilitando queste linee:

  //ProgressBar.Value:= ProgressBar.Value + 1;
  //Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
  //          ' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));
  ...
  //Application.ProcessMessages;

Questo va giù a 00: 00: 106 (!).

L'aggiornamento dei controlli visivi (come ProgressBar o Form.Caption) è molto costoso. Se pensi davvero di averne bisogno, fallo solo ogni 100 volte, o meglio, solo ogni 250 tick del processore.

Se questo non aiuta con le prestazioni, si prega di eseguire il codice con queste linee disabilitate e aggiornare la domanda.

Inoltre, ho aggiunto il codice per testare il tempo di riverniciatura:

T:= Time;
// Bruno Fratini:
// The following lines are required
// otherwise the cells won't be properly paint after maximizing
//BeginUpdate;
Invalidate;
//EndUpdate;
Application.ProcessMessages;
Caption := Caption + ', Repaint time: '+FormatDateTime('nn:ss:zzz', Time - T);

Quando si esegue per la prima volta, la creazione di tutti i controlli richiede 00: 00: 072, il ridisegno richiede 00: 03: 089. Quindi non è la gestione degli oggetti, ma la prima volta che ridipingi è lento.

La seconda riverniciatura è considerevolmente più veloce.

Poiché c'è una discussione nei commenti, ecco come si fanno gli aggiornamenti di avanzamento:

var LastUpdateTime: cardinal;
begin
  LastUpdateTime := GetTickCount - 250;
  for i := 0 to WorkCount-1 do begin
    //...
    //Do a part of work here

    if GetTickCount-LastUpdateTime > 250 then begin
      ProgressBar.Position := i;
      Caption := IntToStr(i) + ' items done.';
      LastUpdateTime := GetTickCount;
      Application.ProcessMessages; //not always needed
    end;
  end;
end;

Ho solo XE2 e il codice non è esattamente lo stesso ma, come detto da alcuni altri ragazzi, il pb sembra essere sul

Application.ProcessMessages;

linea. Quindi suggerisco di "aggiornare" i componenti con un ex reale:

  ProgressBar.Value:= ProgressBar.Value + 1;
  Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
            ' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));

  // in comment : Application.ProcessMessages;
  // New lines : realign for all the components needed to be refreshes
  AniIndicator.Realign;
  ProgressBar.Realign;

Sul mio PC, uno schermo di 210 celle viene generato in 0,150 s invece di 3,7 s con il codice originale, da testare nel vostro ambiente ...