performance - Graves problemas de rendimiento de FireMonkey cuando hay muchos controles en la pantalla

delphi

Question

Ya hace un tiempo que estamos trabajando con FireMonkey en la oficina. Después de un tiempo notamos que no era exactamente tan rápido como el rayo debido a la aceleración de GPU como nos dice Embarcadero.

Así que creamos una aplicación básica solo para probar el rendimiento de FireMonkey. Básicamente es un formulario con un panel en la parte inferior (alBottom) que funciona como barra de estado y un panel de todos los clientes (alClient). El panel en la parte inferior tiene una barra de progreso y una animación.

Agregamos un método al formulario que libera el control que está presente en el panel de todos los clientes y lo completa con celdas de un tipo personalizado y un estilo "mouse over" y actualiza la animación, la barra de progreso y el título del formulario con información sobre el progreso satisfactorio La información más importante es el tiempo requerido.

Finalmente añadimos dicho método al OnResize del formulario, ejecutamos la aplicación y maximizamos el formulario (1280x1024).

El resultado con XE2 fue muy lento. Tardó alrededor de 11 segundos. Además, dado que el panel se cumple hasta que la aplicación esté lista para recibir la entrada del usuario, hay un retraso adicional de aproximadamente 10 segundos (como la congelación). Para un total de 21 segundos.

Con XE3 la situación empeoró. Para la misma operación, tomó un total de 25 segundos (14 + 11 de congelación).

Y los rumores dicen que XE4 va a ser mucho peor de XE3.

Esto es bastante aterrador considerando exactamente la misma aplicación, usar VCL en lugar de FireMonkey y usar SpeedButtons para tener el mismo "efecto de sobre-ratón" que toma solo 1.5 segundos. Entonces, el problema reside claramente en algunos problemas internos del motor FireMonkey.

Abrí un control de calidad (n. ° 113795) y un boleto (pagado) para el soporte de embarcadero, pero no hay nada que no lo resuelva.

En serio, no entiendo cómo pueden ignorar un tema tan pesado. Para nuestra empresa es ser un tapón de espectáculo y un factor decisivo. No podemos ofrecer software comercial a nuestros clientes con un rendimiento tan bajo. Antes o después nos veremos obligados a movernos a otra plataforma (por cierto: el mismo código Delphi Prism con WPF toma 1.5 segundos como el VCL).

Si alguien tiene alguna idea sobre cómo resolver el problema o si intenta mejorar el rendimiento de esta prueba y quiere ayudar, me alegraría muchísimo.

Gracias de antemano.

Bruno Fratini

La aplicación es la siguiente:

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.

Answer 1

¿Por qué estás probando

"Repaint", "InvalidateRect", "Scene.EndUpdate"

Puedo ver en su código que la operación más cara es la recreación de controles. ¿Y por qué lo haces en el evento OnResize (tal vez poner un botón para recrear los controles)

este bucle solo puede comer como el 30% del tiempo de ejecución

  while (CellPanel.ControlsCount > 0) do
    CellPanel.Controls[0].Free;

debería ser como: (evitar la lista de copia de la memoria después de cada libre)

for i := CellPanel.ControlsCount - 1 downto 0 do
   CellPanel.Controls[i].Free;

y no ejecute ProcessMessages en bucle (o al menos ejecute solo en cada décima iteración, más o menos)

usa AQTime para perfilar tu código (se mostrará lo que está pasando tan largo)

Answer 2

Probé tu código, lleva 00: 10: 439 en mi PC en XE3 para llenar la pantalla con celdas. Al deshabilitar estas líneas:

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

Esto baja a 00: 00: 106 (!).

La actualización de controles visuales (como ProgressBar o Form.Caption) es muy costosa. Si realmente crees que lo necesitas, hazlo solo cada 100º iteración, o mejor, solo cada 250 tics de procesador.

Si eso no ayuda con el rendimiento, ejecute su código con estas líneas deshabilitadas y actualice la pregunta.

Además, he agregado código para probar el tiempo de repintado:

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);

Cuando se ejecuta por primera vez, la creación de todos los controles requiere 00: 00: 072, el repintado toma 00: 03: 089. Por lo tanto, no es la gestión de objetos, sino la primera vez que se repinta, que es lenta.

El repintado por segunda vez es considerablemente más rápido.

Dado que hay una discusión en los comentarios, así es como se hacen las actualizaciones de progreso:

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;

Answer 3

Solo tengo XE2 y el código no es exactamente el mismo, pero, como dicen otros muchachos, el pb parece estar en el

Application.ProcessMessages;

línea. Así que sugiero que "actualices" tus componentes con realign ex:

  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;

En mi PC, se genera una pantalla de 210 celdas en 0.150 s en lugar de 3.7 s con el código original, para ser probado en su entorno ...