オフィスで FireMonkey を使って作業するのは、もうしばらく前のことです。しばらくすると、Embarcadero が語っているように、GPU アクセラレーションのせいでそれほど高速ではないことに気付きました。
そこで、FireMonkey のパフォーマンスをテストするためだけに基本的なアプリケーションを作成しました。基本的には、ステータス バーとすべてのクライアント (alClient) パネルとして機能する下部 (alBottom) にパネルを持つフォームです。下部のパネルには、進行状況バーとアニメーションがあります。
すべてのクライアント パネルに存在するすべてのコントロールを解放し、カスタム タイプのセルと「マウス オーバー」スタイルでそれを実現し、アニメーション、プログレス バー、フォームのキャプションを更新するメソッドをフォームに追加しました。充実の進歩。最も重要な情報は所要時間です。
最後に、このようなメソッドをフォームの OnResize に追加し、アプリケーションを実行してフォームを最大化 (1280x1024) しました。
XE2 での結果は本当に遅かったです。約11秒かかりました。さらに、アプリケーションがユーザー入力を受け取る準備ができるまでパネルがフルフィルメントされるため、さらに約 10 秒の遅延が発生します (フリーズなど)。全体で21秒。
XE3 で状況は最悪になりました。同じ操作で、全体で 25 秒かかりました (14 + 11 フリーズ)。
そして、噂によると、XE4 は XE3 よりもずっと悪いものになるということです。
FireMonkey の代わりに VCL を使用し、SpeedButtons を使用して同じ「マウス オーバー効果」を得るのに、わずか 1.5 秒しかかからない、まったく同じアプリケーションを考えると、これは非常に恐ろしいことです!!! したがって、この問題は明らかに FireMonkey エンジンの内部の問題に起因しています。
QC (#113795) とエンバカデロ サポートへの (有料) チケットを開きましたが、何も解決しません。
こんな重い問題をどうして無視できるのか、私には本当に理解できません。私たちの企業にとっては、ショーストッパーであり、取引の破り手です。このような性能の悪い商用ソフトウェアをお客様に提供することはできません。遅かれ早かれ、別のプラットフォームへの移行を余儀なくされます (ところで、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.