Это уже какое-то время мы работаем с 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, но ничего не решит.
Я серьезно не понимаю, как они могут игнорировать такую тяжелую проблему. Для нашего предприятия есть шоу-стоппер и выключатель. Мы не можем предлагать коммерческое программное обеспечение нашему клиенту с такой низкой производительностью. Раньше или позже мы будем вынуждены перейти на другую платформу (BTW: тот же код Delphi Prism с WPF занимает 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 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 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.