我们已经有一段时间在办公室与FireMonkey合作了。经过一段时间后，我们发现由于GPU加速，它不是那么闪电，因为Embarcadero告诉我们。
因此，我们构建了一个基本应用程序，仅用于测试FireMonkey性能。基本上它是一个底部有一个面板（alBottom）的表单，它作为状态栏和一个所有客户端（alClient）面板。底部的面板有一个进度条和一个动画。
我们在表单中添加了一个方法，该方法释放了所有客户端面板中存在的任何控件，并使用自定义类型和“鼠标悬停”样式的单元格来实现它，并更新动画，进度条和表单的标题有关实现进展的信息。最重要的信息是所需的时间。
最后，我们将这种方法添加到表单的OnResize中，运行应用程序并最大化表单（1280x1024）。
XE2的结果非常慢。花了大约11秒钟。此外，由于面板完成直到应用程序准备好接收用户输入，因此存在大约10秒的额外延迟（如冷冻）。整体为21秒。
XE3的情况变得更糟。对于相同的操作，总共需要25秒（14 + 11冻结）。
谣言告诉XE4 XE3将是最糟糕的。
考虑到完全相同的应用程序，使用VCL代替FireMonkey并使用SpeedButtons以获得相同的“鼠标悬停效果”仅需1.5秒！所以问题显然存在于一些内部FireMonkey引擎问题中。
我开了一张QC（＃113795）和一张（付费）票给embarcadero支持，但没有什么他们不会解决它。
我真的不明白他们怎么能忽视这么重的问题。因为我们的企业是一个显示阻止和交易破坏者。我们不能以如此糟糕的表现向我们的客户提供商业软件。之前或之后我们将被迫转移到另一个平台（顺便说一下：与WPF相同的代码Delphi Prism需要1.5秒作为VCL）。
如果有人知道如何解决问题或尝试提高测试性能并希望提供帮助，我会非常高兴。
提前谢谢。
布鲁诺弗拉蒂尼
申请表如下：
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.
答案 0 :(得分：28)
我尝试了你的代码，在XE3上我的电脑上需要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。所以这不是对象管理，而是第一次重新绘制，这很慢。
第二次重新涂漆速度要快得多。
由于评论中有讨论，以下是进行更新的方法：
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;
答案 1 :(得分：5)
我只有XE2且代码并不完全相同，但正如其他人所说，pb似乎在
上Application.ProcessMessages;
线。 因此，我想通过重新调整来“刷新”您的组件：
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;
在我的电脑上，使用原始代码在0.150秒而不是3.7秒内生成210个电池屏幕，以便在您的环境中进行测试......
答案 2 :(得分：4)
你为什么要测试
“重绘”，“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对您的代码进行分析（它会显示正在解决的问题）