在屏幕上有很多控件时，严重的FireMonkey性能问题

我们已经在办公室与FireMonkey合作了。 过了一段时间，我们注意到，由于Embarcadero告诉我们，GPU加速并不是那么快。

所以我们build立了一个基本的应用程序来testingFireMonkey的性能。 基本上它是一个窗体底部（alBottom）作为状态栏和所有客户端（alClient）面板。 底部的面板有一个进度条和一个animation。

我们在表单中添加了一个方法，释放所有客户端面板中存在的任何控件，并使用自定义types和“鼠标hover”样式的单元格来完成此操作，并使用有关信息的信息更新animation，进度条和表单标题实现进展。 最重要的信息是所需的时间。

最后，我们将这种方法添加到窗体的OnResize中，运行应用程序并最大化窗体（1280×1024）。

XE2的结果真的很慢。 花了大约11秒。 此外，由于面板被满足，直到应用准备好接收用户input，所以还有约10秒的延迟（如冻结）。 总共21秒。

XE3的情况最糟糕。 对于同样的操作，总共需要25秒（14 + 11秒）。

而传言说XE4将会是XE3中最糟糕的一个。

考虑到应用程序完全相同，使用VCL代替FireMonkey并使用SpeedButtons以获得相同的“鼠标hover效果”仅需1.5秒！ 所以这个问题显然存在于一些内部的FireMonkey引擎问题中。

我开了一个QC（＃113795）和一张支付embarcadero（支付）的票，但没有任何解决办法。

我真的不明白他们怎么能忽略这么重的问题。 因为我们的企业正在成为一个制表者和一个交易断路器。 我们不能向客户提供性能差的商业软件。 早些时候或之后，我们将被迫移动到另一个平台（顺便说一句：相同的代码delphi棱镜与WPF需要1.5秒作为VCL之一）。

如果有人对如何解决这个问题有任何想法，或试图提高这个testing性能，并想帮助，我会真的很高兴。

先谢谢你。

布鲁诺·弗拉蒂尼

该应用程序是以下一个：

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

我试了你的代码，在我的PC上用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次处理器就会有一次。

如果这对性能没有帮助，请在禁用这些行的情况下运行您的代码并更新问题。

此外，我添加了代码来testing重绘时间：

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

第一次运行时，创build所有控件需要00：00：072，重新绘制需要00：03：089。 所以这不是对象pipe理，而是第一次重新绘制速度很慢。

第二次重新粉刷相当快。

由于评论中有讨论，所以下面介绍如何进行更新：

 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;

线。 所以我要求重新整理你的组件：

  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; 

在我的电脑上，一个210单元的屏幕是0.150秒而不是3.7秒的原始代码生成的，要在你的环境中testing…

Answer 3

你为什么要testing

“Repaint”，“InvalidateRect”，“Scene.EndUpdate”

我可以从您的代码中看到，最昂贵的操作是重新创build控件。 你为什么要在OnResize事件中做（也许把一些button来重新创build控件）

这个循环本身就可以吃到30％的执行时间

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

它应该是这样的:(避免每个空闲后列表内存拷贝）

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

并且不要在循环中运行ProcessMessages（或者至less每10次迭代运行一次）

使用AQTime来分析你的代码 （它会显示什么东西这么久）