画面に多数のコントロールがある場合のFireMonkeyの深刻なパフォーマンス問題

Question

私たちがオフィスでFireMonkeyを使用しているのは、もうしばらくです。しばらくして、Embarcaderoによると、GPUアクセラレーションのせいでそれほど高速ではないことに気づきました。

そこで、FireMonkeyのパフォーマンスをテストするためだけに基本的なアプリケーションを作成しました。基本的には、ステータスバーとして機能するパネル（alBottom）とすべてのクライアント（alClient）パネルを持つフォームです。下部のパネルには、プログレスバーとアニメーションがあります。

すべてのクライアントパネルに存在するすべてのコントロールを解放し、カスタムタイプのセルと「マウスオーバー」スタイルでそれを実行し、アニメーション、進行状況バー、フォームのキャプションを更新するメソッドをフォームに追加しました。充実した進歩。最も重要な情報は必要な時間です。

最後に、そのようなメソッドをフォームのOnResizeに追加し、アプリケーションを実行して、フォームを最大化しました（1280x1024）。

XE2での結果は本当に遅いものでした。約11秒かかりました。さらに、アプリケーションがユーザー入力を受け取る準備ができるまでパネルが実行されるため、約10秒の追加の遅延（凍結など）があります。全体で21秒間。

XE3では状況が最悪になりました。同じ操作で、全体で25秒かかりました（14 + 11凍結）。

そして噂によると、XE4はXE3の中で最悪になるとのことです。

FireMonkeyの代わりにVCLを使用し、同じ「マウスオーバー効果」を実現するためにSpeedButtonsを使用すると、まったく同じアプリケーションを考えると、これは非常に恐ろしいです。したがって、問題は明らかにFireMonkeyエンジンの内部的な問題にあります。

エンバカデロサポートへのQC（＃113795）と（有料）チケットをオープンしましたが、彼らはそれを解決しません。

私は彼らがそのような重い問題をどうやって無視できるのかを真剣に理解していません。私たちの企業にとって、ショーストッパーと取引ブレーカーです。このようなパフォーマンスの低いお客様に商用ソフトウェアを提供することはできません。遅かれ早かれ、別のプラットフォームへの移行を余儀なくされます（BTW：WPFを使用した同じコードDelphi Prismは、VCLと同じ1.5秒です）。

誰かが問題を解決する方法についてこのアイデアを持っているか、このテストのパフォーマンスを改善しようと試みて助けたいと思っているなら、私は本当にうれしく思います。

前もって感謝します。

ブルーノ・フラティーニ

アプリケーションは次のとおりです。

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

私はあなたのコードを試しました、XE3上の私のPCで画面をセルで埋めるのに00：10：439かかります。これらの行を無効にすることにより：

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

これは00：00：106（！）まで下がります。

ビジュアルコントロール（ProgressBarやForm.Captionなど）の更新は非常にコストがかかります。本当にそれが必要だと思う場合は、100回ごと、またはそれ以上、つまり250プロセッサティックごとにのみ実行してください。

それでもパフォーマンスが改善されない場合は、これらの行を無効にしてコードを実行し、質問を更新してください。

さらに、再描画時間をテストするコードを追加しました。

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

初めて実行する場合、すべてのコントロールの作成には00：00：072、再描画には00：03：089がかかります。したがって、それはオブジェクト管理ではなく、遅い再描画です。

2回目の再描画はかなり高速です。

コメントでの議論があるので、進行状況の更新を行う方法は次のとおりです。

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 2

私はXE2しか持っておらず、コードは完全に同じではありませんが、他の人が言っているように、pbは

Application.ProcessMessages;

ライン。だから私は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;

私のPCでは、210セル画面が元のコードで3.7秒ではなく0.150秒で生成され、環境でテストされます...

Answer 3

テストする理由

「Repaint」、「InvalidateRect」、「Scene.EndUpdate」

あなたのコードから、最も高価な操作はコントロールの再作成であることがわかります。そして、なぜあなたはOnResizeイベントでそれをしているのですか（コントロールを再作成するためのボタンを置くかもしれません）

このループだけで、実行時間の30％程度を消費できます

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

それは次のようになります：（解放されるたびにメモリのリストをコピーしないでください）

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

ループ内でProcessMessagesを実行しない（または、少なくとも10回おきの反復でのみ実行する）

AQTimeを使用してコードをプロファイリングします（何がその問題を解決しているかを示します）