Performanceproblem mit Firemonkey

[TiGü]

Probiere es doch mal so:

Delphi-Quellcode:

unit Unit3;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.TextLayout;

type
  TForm3 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    FScreenScale: single;
    FTitle: String;
    FDescription: String;
    FTitleTextLayout: TTextLayout;
    FDescTextLayout: TTextLayout;
    procedure DefaultRenderItem(const ACanvas: TCanvas; const ARect: TRectF; const AImage: TBitmap; const ASelected: Boolean);
  public
    { Public-Deklarationen }
  end;

  TCanvasHelper = class helper for TCanvas
  public
    procedure PetersFillText(const ATextLayout: TTextLayout; const ARect: TRectF; const AText: string; const WordWrap: Boolean;
      const AOpacity: single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);
  end;

var
  Form3: TForm3;

implementation

{$R *.fmx}

const
  cCardBackgroundColor = $FF3D3D3D;
  cCardDescription = $FF0096A6;
  cCardDescriptionFocus = $FF37474F;
  cGridFont = 'Roboto';

procedure TForm3.Button1Click(Sender: TObject);
var
  tick: Cardinal;
  i: Integer;
  Target: TBitmap;
  Image: TBitmap;
begin
  FTitle := 'Tile 1';
  FDescription := 'Panel 1, lorem ipsum';
  tick := TThread.GetTickCount;
  FScreenScale := 1;
  for i := 1 to 1000 do
  begin
    Image := TBitmap.Create;
    try
      // Image.Assign(Image1.Bitmap);

      Target := TBitmap.Create(180, 144);
      DefaultRenderItem(Target.Canvas, Target.BoundsF, Image, false);
      Target.Free;

      Target := TBitmap.Create(180, 144);
      DefaultRenderItem(Target.Canvas, Target.BoundsF, Image, true);

      if i = 1000 then // zu Debugzwecken
        Image2.Bitmap.Assign(Target);

      Target.Free;

    finally
      Image.Free;
    end;
  end;
  Label1.Text := IntToStr(TThread.GetTickCount - tick);
end;

procedure TForm3.DefaultRenderItem(const ACanvas: TCanvas; const ARect: TRectF; const AImage: TBitmap; const ASelected: Boolean);
var
  i: Integer;
  TH: single;
  ABoundsRect: TRectF;
  R: TRectF;
  TextLayout: TTextLayout;
begin
  ABoundsRect := ARect;
  with ACanvas do
  begin
    BeginScene(nil);
    try
      // Shadow - there are much nicer ways to draw a shadow
      ClearRect(ARect);

      Stroke.Kind := TBrushkind.Solid;
      Stroke.Color := TAlphaColorRec.Black;
      for i := 0 to 5 do
      begin
        DrawRect(ABoundsRect, 5, 5, AllCorners, i / 100);;
        ABoundsRect := RectF(ABoundsRect.Left + 1, ABoundsRect.Top + 1, ABoundsRect.Right - 1, ABoundsRect.Bottom - 1);
      end;
      Stroke.Kind := TBrushkind.None;
      Fill.Kind := TBrushkind.Solid;
      Fill.Color := cCardBackgroundColor;
      FillRect(ABoundsRect, 0 * 5, 0 * 5, AllCorners, 1);

      TH := ABoundsRect.Height / 3;
      if Assigned(AImage) then
      begin
        R := RectF(ABoundsRect.Left, 0, ABoundsRect.Right, ABoundsRect.Bottom - TH);

        Fill.Bitmap.Bitmap.Assign(AImage);
        Fill.Bitmap.WrapMode := TWrapMode.TileStretch;
        Fill.Kind := TBrushkind.Bitmap;
        FillRect(R, 5, 5, [TCorner.TopLeft, TCorner.TopRight], 1);
      end;

      R := RectF(ABoundsRect.Left, ABoundsRect.Bottom - TH, ABoundsRect.Right, ABoundsRect.Bottom);

      Fill.Kind := TBrushkind.Solid;
      if ASelected then
        Fill.Color := cCardDescription
      else
        Fill.Color := cCardDescriptionFocus;

      FillRect(R, 5, 5, [TCorner.BottomLeft, TCorner.BottomRight], 1);

      R := RectF(R.Left + 10, R.Top, R.Right - 10, R.Top + (R.Bottom - R.Top) / 2);

      Fill.Color := TAlphaColorRec.White;

      if FTitle <> '' then
      begin
        if FTitleTextLayout = nil then
        begin
          Font.Family := cGridFont;
          Font.Size := FScreenScale * 15;
          Font.Style := [TFontStyle.fsBold];

          FTitleTextLayout := TTextLayoutManager.TextLayoutByCanvas(ACanvas.ClassType).Create(ACanvas);
          PetersFillText(FTitleTextLayout, R, FTitle, false, 1, [], TTextAlign.Leading, TTextAlign.Center);
        end;
        FTitleTextLayout.RenderLayout(ACanvas);
      end;

      if FDescription <> '' then
      begin
        if FDescTextLayout = nil then
        begin
          R.Offset(0, R.Height);
          Font.Style := [];

          FDescTextLayout := TTextLayoutManager.TextLayoutByCanvas(ACanvas.ClassType).Create(ACanvas);
          PetersFillText(FDescTextLayout, R, FDescription, false, 0.8, [], TTextAlign.Leading, TTextAlign.Leading);
        end;
        FDescTextLayout.RenderLayout(ACanvas);
      end;
    finally
      EndScene;
    end;
  end;
end;

{ TCanvasHelper }

procedure TCanvasHelper.PetersFillText(const ATextLayout: TTextLayout; const ARect: TRectF; const AText: string;
  const WordWrap: Boolean; const AOpacity: single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);

begin
  ATextLayout.BeginUpdate;
  ATextLayout.TopLeft := ARect.TopLeft;
  ATextLayout.MaxSize := PointF(ARect.Width, ARect.Height);
  ATextLayout.Text := AText;
  ATextLayout.WordWrap := WordWrap;
  ATextLayout.Opacity := AOpacity;
  ATextLayout.HorizontalAlign := ATextAlign;
  ATextLayout.VerticalAlign := AVTextAlign;
  ATextLayout.Font := Self.Font;
  ATextLayout.Color := Self.Fill.Color;
  ATextLayout.RightToLeft := TFillTextFlag.RightToLeft in Flags;
  ATextLayout.EndUpdate;
end;

end.

[Sherlock]

Nur mal nebenbei: Unter Windows nutzt FMX DirectX unter Android/iOS OpenGL. OpenGL ist einfach langsamer. Und sei froh, daß Du das nicht unter iOS testest, da wäre Dein Code sicherlich noch ein Stück lahmer.

Sherlock

[jsp]

OpenGL ist einfach langsamer? Referenzen?
:roll:

[Michael II]

Hallo Peter666

du hast in #1 Code gepostet und geschrieben die Sache laufe unter Windows "schnarchend langsam". Wie weiter oben erwähnt: Ich messe 1ms pro

Delphi-Quellcode:

 Target := TBitmap.Create(180, 144);
      DefaultRenderItem(Target.Canvas, Target.BoundsF, Image, false);
      Target.Free;

und finde den Schnarch nicht ;-).

Nun habe ich noch mit einem Uralt Tablet Nexus 10 (Android 5.1.1) getestet.
Ich messe 33Sekunden für die 1000er Schleife; also rund 15ms für obigen Codeteil.

[Peter666]

Vielen lieben Dank für die Hilfe. Das mit dem TTextLayout war einen Versuch Wert, aber es hat leider auch nichts gebracht.

Unter Windows messen bringt nicht viel, das Problem ist dass es auf dem Android halt extrem langsam ist.

Peter

[Michael II]

Windows habe ich nur gemessen, weil du es als schnarchend langsam empfunden hattest und ich das irgendwie nicht glauben konnte bei dem wenigen Code.

Und mit meinem Uraltandroiden messe ich 15ms pro Bild, also insgesamt 0.6 Sekunden für deine 40 Bilder. Du misst hingegen 10 Sekunden.

Da muss doch irgendwo auf deinen Systemen eine Bremse eingebaut sein (?).

[Peter666]

Ist nicht schlimm,

ich habe mal das ganze Projekt an die Mail gehängt. Teile von dem Code stammen aus einem anderen Thread, ich denke aber das geht in Ordnung. Neben der Rendergeschwindigkeit gibt es noch einen anderen Flaschenhals.

Für jedes Element nutze ich eine eigene TComponent mit Owner=nil. Das Befüllen des Grids dauert auf dem Android 9 Sekunden, unter Windows ist das ganze mit 200ms recht vernünftig. Vielleicht hat ja jemand dazu eine Idee. Den Code stelle ich mal als PD zur Verfügung, vielleicht mag ja jemand diesen ebenfalls benutzen. 11000 Einträge sind sicherlich der Overkill, aber theoretisch dürfte ja zumindest das erstellen nicht so furchtbar lange dauern.

Peter

[Michael II]

Hab's geladen, sieht cool aus - ungefähr so wie die Filmauswahl bei meinem TV-Anbieter ;-).

Nebenbemerkung: Ich kann in Windows (ohne Touch) bis Titel10 runter fahren, aber dann nicht mehr hoch zu Titel 0 (da keine Scrollbalken (wohl mit Absicht) und raufscrollen mit MauseDown und Ziehen wird wohl nicht unterstützt (?)).

Zeitaufwand: Wäre es nicht möglich (ähnlich OwnerDraw bei ListBoxen) immer nur jene Elemente zu erzeugen, welche im momentan sichtbaren Anzeigebereich liegen? Dann wärst du punkto Malerei bei einem Aufwand nahe 0. Oder wird die Sache dann sonstwo langsam (?).

[Peter666]

Danke,

das ganze ist nicht optimal. Im Prinzip müsste man TTileItem zu einer einfachen TObject-Klasse ändern, TTileRow durch TTileRow = class(THorzScrollBox) ersetzen und die Items in dem OnPaint Ereignis zeichnen.
Die Steuerung habe ich bis jetzt nur im Ansatz drin.

Delphi-Quellcode:

case Key of
    vkOk, vkReturn:
      begin
        if FGrid.ItemIndex <> -1 then
          with FGrid.Items[FGrid.ItemIndex] do
            if assigned(Items[ItemIndex].OnClick) then
              Items[ItemIndex].OnClick(Items[ItemIndex]);
      end;
    vkUp:
      begin
        FGrid.ItemIndex := FGrid.ItemIndex - 1;
        if FGrid.Items[FGrid.ItemIndex].Count = 0 then
          FGrid.ItemIndex := FGrid.ItemIndex - 1;
      end;
    vkDown:
      begin
        FGrid.ItemIndex := FGrid.ItemIndex + 1;
        if FGrid.Items[FGrid.ItemIndex].Count = 0 then
          FGrid.ItemIndex := FGrid.ItemIndex + 1;
      end;
    vkRight:
      if FGrid.ItemIndex <> -1 then
        FGrid.Items[FGrid.ItemIndex].ItemIndex := FGrid.Items[FGrid.ItemIndex]
          .ItemIndex + 1;
    vkLeft:
      if FGrid.ItemIndex <> -1 then
        FGrid.Items[FGrid.ItemIndex].ItemIndex := FGrid.Items[FGrid.ItemIndex]
          .ItemIndex - 1;

Schöner wäre das natürlich in der Komponente.

Das ganze funktioniert genauso wie bei den Android TV Geräten. Die Tiles stellen Sender, Videolinks oder was auch immer dar und man kann diese wählen. Vielleicht hat ja jemand eine Idee das als "saubere" Klasse umzuwandeln. Ich bin mir sicher hier im Forum gibt es mehr als einen (@Mavarick) der mit so etwas Erfahrung hat :)

Peter