AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Performanceproblem mit Firemonkey

Ein Thema von Peter666 · begonnen am 15. Okt 2019 · letzter Beitrag vom 21. Okt 2019
Antwort Antwort
Seite 2 von 2     12
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
2.493 Beiträge
 
Delphi 10.2 Tokyo Enterprise
 
#11

AW: Performanceproblem mit Firemonkey

  Alt 16. Okt 2019, 12:40
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.
  Mit Zitat antworten Zitat
Benutzerbild von Sherlock
Sherlock

Registriert seit: 10. Jan 2006
Ort: Offenbach
3.549 Beiträge
 
Delphi 10.3 Rio
 
#12

AW: Performanceproblem mit Firemonkey

  Alt 16. Okt 2019, 13:47
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
Geändert von Sherlock (Morgen um 16:78 Uhr) Grund: Weil ich es kann
  Mit Zitat antworten Zitat
jsp

Registriert seit: 9. Aug 2003
50 Beiträge
 
#13

AW: Performanceproblem mit Firemonkey

  Alt 16. Okt 2019, 13:51
OpenGL ist einfach langsamer? Referenzen?
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: CH BE Eriswil
436 Beiträge
 
Delphi 10.4 Sydney
 
#14

AW: Performanceproblem mit Firemonkey

  Alt 16. Okt 2019, 16:12
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.
Michael Gasser
  Mit Zitat antworten Zitat
Peter666

Registriert seit: 11. Aug 2007
316 Beiträge
 
#15

AW: Performanceproblem mit Firemonkey

  Alt 17. Okt 2019, 16:11
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
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: CH BE Eriswil
436 Beiträge
 
Delphi 10.4 Sydney
 
#16

AW: Performanceproblem mit Firemonkey

  Alt 17. Okt 2019, 16:33
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 (?).
Michael Gasser
  Mit Zitat antworten Zitat
Peter666

Registriert seit: 11. Aug 2007
316 Beiträge
 
#17

AW: Performanceproblem mit Firemonkey

  Alt 21. Okt 2019, 12:53
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
Angehängte Dateien
Dateityp: zip grid.zip (6,6 KB, 9x aufgerufen)
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: CH BE Eriswil
436 Beiträge
 
Delphi 10.4 Sydney
 
#18

AW: Performanceproblem mit Firemonkey

  Alt 21. Okt 2019, 16:33
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 (?).
Michael Gasser
  Mit Zitat antworten Zitat
Peter666

Registriert seit: 11. Aug 2007
316 Beiträge
 
#19

AW: Performanceproblem mit Firemonkey

  Alt 21. Okt 2019, 19:05
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2020 by Daniel R. Wolf