Performanceproblem mit Firemonkey

[Peter666]

Hi,

ich habe hier ein ziemliches Performanceproblem mit Canvas in Firemonkey. Für eine Anzeige erstelle ich ungefähr 20 eigene Tiles die aus 2 Bildern bestehen. Einmal, wenn die Komponente den Fokus hat und einmal, wenn sie keinen Fokus hat.
Die Erstellung der 40 Bilder dauert auf einem Androiden 10 Sekunden. Auch unter Windows ist das ganze schnarchend langsam. Der Code für die Darstellung befindet sich hier unten. Der komplette Beispielcode ist im Anhang. Ich glaube der Flaschenhals ist FillRect und die Textausgabe. Wie dem auch seih kann ich mir nicht vorstellen, dass man den DefaultRenderItem Code nicht irgendwie beschleunigen kann.In einem separaten Thread/Task kann ich das ganze nicht rendern.

Delphi-Quellcode:

procedure TForm3.DefaultRenderItem(const ACanvas: TCanvas; const ARect: TRectF;
  const AImage: TBitmap; const ASelected: Boolean);
var
  i: Integer;
  TH: single;
  ABoundsRect: TRectF;
  R: TRectF;
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);

      Font.Family := cGridFont;
      Font.Size := FScreenScale * 15;
      Font.Style := [TFontStyle.fsBold];
      Fill.Color := TAlphaColorRec.White;

      if FTitle <> '' then
        FillText(R, FTitle, false, 1, [], TTextAlign.Leading,
          TTextAlign.Center);

      if FDescription <> '' then
      begin
        R.Offset(0, R.Height);
        Font.Style := [];
        FillText(R, FDescription, false, 0.8, [], TTextAlign.Leading,
          TTextAlign.Leading);
      end;
    finally
      EndScene;
    end;
  end;
end;

[Rollo62]

Mir erschliesst sich nicht ganz was Du da machst.
Wozu die Schleife 1000 mal, und darin das Bitmal erzeugen löschen ?

Delphi-Quellcode:

    Image := TBitmap.Create;
    try
      Target.Free;

      ...


    finally
      Image.Free;
    end;

[Peter666]

Eigentlich wird das erstellen der Grafik in jeder Tcomponent Klasse gemacht. Das hab ich jetzt so nur erstellt, weil ich die ganze Komponente nicht mit dazupacken wollte.

[hoika]

Hallo,
ich würde so vorgehen.

1. Wie oft wird DefaultRenderItem aufgerufen, kann man die Aufrufe verringern?
2. Schrittweise Code aus DefaultRenderItem ausblenden und Testen.

0. Einen Profiler benutzen, um 1. rauszubekommen.

[Michael II]

Ich habe deinen Code runtergeladen und auf meinem alten Notebook (Prozessor Intel(R) Core(TM) i7-3632QM CPU @ 2.20GHz, 2201 MHz, 4 Kern(e), 8 logische(r) Prozessor(en)) unter Win10 18362, Delphi 10.3.2 gestartet.

Es dauert immer ziemlich genau zwei Sekunden, d.h. pro

Delphi-Quellcode:

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

rund 1 Millisekunde.

Welche Werte erwartest du?

[Mavarik]

Zitat:

Zitat von Michael II (Beitrag 1449732)

rund 1 Millisekunde.

Ohh gut, dann brauche ich es ja nicht zu testen. Hätte mich auch gewundert.

[Peter666]

Unter Android dauert es knapp 10 Sekunden für 30 Tiles. Das ist definitiv inakzeptabel. Die beiden Grafiken werden beim OnPaint Event erstellt.

Delphi-Quellcode:

TTileItem = class(TControl)
  protected
    FScreenScale: Single;
    FLastUpdate: Cardinal;
    FZoomFactor: Single;
    FBackgroundColor: TAlphaColor;
    FNeedUpdate: Boolean;

    FOldPositionX: Single;
{$IFDEF BACKBUFFER}
{$IFDEF USEGPU}
    FSelected: TTexture;
    FNormal: TTexture;
{$ELSE}
    FSelected: TBitmap;
    FNormal: TBitmap;
{$ENDIF}
{$ELSE}
    FImage: TBitmap;
{$ENDIF}
    FActive: Boolean;

    FOnBeforePaint: TNotifyEvent;

    FTitle: String;
    FDescription: String;

    FImageFile: String;
    FUpdateImage: Boolean;
    FLocalImage: String;

{$IFDEF USEZIP}
    FZipFile: TZipFile;
{$ENDIF}
    procedure DoOnDownloadComplete(AFileName: string; AAvailable: Boolean);
    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;

    procedure SetZoomFactor(AValue: Single);
    procedure SetBackgroundColor(AValue: TAlphaColor);
    procedure SetString(Aindex: Integer; AValue: String);

    procedure DefaultRenderItem(ACanvas: TCanvas; ARect: TRectF;
      AImage: TBitmap; ASelected: Boolean); virtual;
    procedure Resize; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function PerformUpdate: Boolean;
  published
    property BackgroundColor: TAlphaColor read FBackgroundColor
      write SetBackgroundColor;
    property ZoomFactor: Single read FZoomFactor write SetZoomFactor;
    property Title: String index 0 read FTitle write SetString;
    property Description: String index 1 read FDescription write SetString;
    property ImageFile: String index 2 read FImageFile write SetString;

{$IFDEF USEZIP}
    property ZipFile: TZipFile read FZipFile write FZipFile;
{$ENDIF}
    property OnBeforePaint: TNotifyEvent read FOnBeforePaint
      write FOnBeforePaint;
    property LastUpdate: Cardinal read FLastUpdate write FLastUpdate;
  end;
...
{ TTileItem }
constructor TTileItem.Create(AOwner: TComponent);
begin
  inherited;
  CanFocus := true;
  ZoomFactor := 0;
  FBackgroundColor := TAlphaColors.Gray;
{$IFDEF BACKBUFFER}
{$IFNDEF USEGPU}
  FSelected := TBitmap.Create;
  FNormal := TBitmap.Create;
{$ENDIF}
  FScreenScale := GetScreenScale;
{$ELSE}
  FScreenScale := 1;
{$ENDIF}
  FNeedUpdate := true;
end;

destructor TTileItem.Destroy;
begin
{$IFDEF BACKBUFFER}
  FreeAndNil(FSelected);
  FreeAndNil(FNormal);
{$ELSE}
  FreeAndNil(FImage);
{$ENDIF}
  inherited;
end;

procedure TTileItem.SetString(Aindex: Integer; AValue: String);
begin
  case Aindex of
    0:
      begin
        FNeedUpdate := FNeedUpdate or (FTitle <> AValue);
        FTitle := AValue;
      end;
    1:
      begin
        FNeedUpdate := FNeedUpdate or (FDescription <> AValue);
        FDescription := AValue;
      end;
    2:
      begin
        if FImageFile <> AValue then
        begin
          FUpdateImage := FImageFile <> AValue;
          FImageFile := AValue;
        end;
      end;
  end;
end;

procedure TTileItem.DoEnter;
var
  dx: Single;
begin
  inherited;
  FActive := true;
  BringToFront;

  dx := (Width - cZoomIn * Width) / 2;
  FOldPositionX := Position.X;
  TAnimator.AnimateFloat(self, 'ZoomFactor', cZoomOut, cZoomTime,
    TAnimationType.Out, TInterpolationType.Quadratic);

  TAnimator.AnimateFloat(self, 'Position.X', Position.X - dx, cZoomTime,
    TAnimationType.Out, TInterpolationType.Quadratic);

  if Owner is TTileRow then
    TTileRow(Owner).ScrollIntoView(self);
end;

procedure TTileItem.DoExit;
begin
  inherited;
  FActive := False;
  SendToBack;
  TAnimator.AnimateFloat(self, 'Position.X', FOldPositionX, cZoomTime,
    TAnimationType.Out, TInterpolationType.Quadratic);

  TAnimator.AnimateFloat(self, 'ZoomFactor', cZoomIn, cZoomTime, TAnimationType.
    In, TInterpolationType.Linear);
end;

procedure TTileItem.SetBackgroundColor(AValue: TAlphaColor);
begin
  if FBackgroundColor <> AValue then
  begin
    FBackgroundColor := AValue;
    repaint;
  end;
end;

procedure TTileItem.SetZoomFactor(AValue: Single);
begin
  if AValue < cZoomIn then
    AValue := cZoomIn;
  if AValue > cZoomOut then
    AValue := cZoomOut;

  if FZoomFactor <> AValue then
  begin
    FZoomFactor := AValue;
    repaint;
  end;
end;

procedure TTileItem.Resize;
begin
  inherited;
  FNeedUpdate := true;
end;

procedure TTileItem.DefaultRenderItem(ACanvas: TCanvas; ARect: TRectF;
  AImage: TBitmap; ASelected: Boolean);
var
  i: Integer;
  TH: Single;
  ABoundsRect: TRectF;
  R: TRectF;
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, 5, 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);

      Font.Family := cGridFont;
      Font.Size := FScreenScale * 15;
      Font.Style := [TFontStyle.fsBold];
      Fill.Color := TAlphaColorRec.White;

      if Title <> '' then
        FillText(R, Title, False, 1, [], TTextAlign.Leading, TTextAlign.Center);

      if Description <> '' then
      begin
        R.Offset(0, R.Height);
        Font.Style := [];
        FillText(R, Description, False, 0.8, [], TTextAlign.Leading,
          TTextAlign.Leading);
      end;
    finally
      EndScene;
    end;
  end;
end;

procedure TTileItem.DoOnDownloadComplete(AFileName: string;
  AAvailable: Boolean);
begin
  if AAvailable then
  begin
    FLocalImage := AFileName;
    FNeedUpdate := true;
    FUpdateImage := False;
    PerformUpdate;
  end;
end;

function TTileItem.PerformUpdate: Boolean;
var
  Image: TBitmap;
{$IFDEF USEGPU}
  Bitmap: TBitmap;
  //Bmp: TTexture;
{$ENDIF}
  ImgWidth, ImgHeight: Integer;
begin
  Result := (FUpdateImage) or (FNeedUpdate);

  if FUpdateImage then
  begin
    FUpdateImage := False;
    RetrieveImage(FImageFile, {$IFDEF USEZIP}FZipFile {$ELSE} nil
{$ENDIF}, DoOnDownloadComplete);
    Exit;
  end;

  if FNeedUpdate then
  begin
    FNeedUpdate := False;
{$IFDEF BACKBUFFER}
    if FileExists(FLocalImage) then
      Image := TBitmap.CreateFromFile(FLocalImage)
    else
      Image := nil;
    ImgWidth := Trunc(FScreenScale * Width);
    ImgHeight := Trunc(FScreenScale * Height);

{$IFDEF USEGPU}
    FreeAndNil(FNormal);
    FreeAndNil(FSelected);
    Bitmap := TBitmap.Create;
    Bitmap.SetSize(ImgWidth, ImgHeight);
    DefaultRenderItem(Bitmap.Canvas, Bitmap.BoundsF, Image, False);
    FNormal := ALTransformBitmaptoTexture(Bitmap);

    Bitmap := TBitmap.Create;
    Bitmap.SetSize(ImgWidth, ImgHeight);
    DefaultRenderItem(Bitmap.Canvas, Bitmap.BoundsF, Image, true);
    FSelected := ALTransformBitmaptoTexture(Bitmap);
{$ELSE}
    FNormal.SetSize(ImgWidth, ImgHeight);
    FSelected.SetSize(ImgWidth, ImgHeight);

    DefaultRenderItem(FNormal.Canvas, FNormal.BoundsF, Image, False);
    DefaultRenderItem(FSelected.Canvas, FSelected.BoundsF, Image, true);
{$ENDIF}
    FreeAndNil(Image);
{$ELSE}
    try
      FreeAndNil(FImage);
      if FileExists(FLocalImage) then
        FImage := TBitmap.CreateFromFile(FLocalImage)
    except
      FreeAndNil(FImage);
    end;
{$ENDIF}
  end;

end;

procedure TTileItem.Paint;
var
  w, h: Single;
  R: TRectF;
{$IFDEF USEGPU}
  Bmp: TTexture;
{$ELSE}
  Bmp: TBitmap;
{$ENDIF}
begin
  if Locked then
    Exit;

  if assigned(FOnBeforePaint) then
    FOnBeforePaint(self);

  PerformUpdate;

  w := Width * FZoomFactor;
  h := Height * FZoomFactor;
  R := RectF((Width - w) / 2, (Height - h) / 2, w, h);

{$IFDEF BACKBUFFER}
  if FActive then
    Bmp := FSelected
  else
    Bmp := FNormal;

  if Bmp <> nil then
  begin
{$IFDEF USEGPU}
    TCustomCanvasGpu(Canvas).DrawTexture(R, TRectF.Create(0, 0, Bmp.Width,
      Bmp.Height), ALPrepareColor(TCustomCanvasGpu.ModulateColor,
      AbsoluteOpacity), // https://quality.embarcadero.com/browse/RSP-15432
      Bmp);
{$ELSE}
    Canvas.DrawBitmap(Bmp, TRectF.Create(0, 0, Bmp.Width, Bmp.Height), R,
      AbsoluteOpacity, true);

{$ENDIF}
  end;
{$ELSE}
  DefaultRenderItem(Canvas, R, FImage, FActive);
{$ENDIF}
end;

[TiGü]

Delphi-Quellcode:

procedure TTileItem.Paint;
var
  w, h: Single;
  R: TRectF;
{$IFDEF USEGPU}
  Bmp: TTexture;
{$ELSE}
  Bmp: TBitmap;
{$ENDIF}
begin
  if Locked then
    Exit;

  if assigned(FOnBeforePaint) then
    FOnBeforePaint(self);

  PerformUpdate;

  w := Width * FZoomFactor;
  h := Height * FZoomFactor;
  R := RectF((Width - w) / 2, (Height - h) / 2, w, h);

{$IFDEF BACKBUFFER}
  if FActive then
    Bmp := FSelected
  else
    Bmp := FNormal;

  if Bmp <> nil then
  begin
{$IFDEF USEGPU}
    TCustomCanvasGpu(Canvas).DrawTexture(R, TRectF.Create(0, 0, Bmp.Width,
      Bmp.Height), ALPrepareColor(TCustomCanvasGpu.ModulateColor,
      AbsoluteOpacity), // https://quality.embarcadero.com/browse/RSP-15432
      Bmp);
{$ELSE}
    Canvas.DrawBitmap(Bmp, TRectF.Create(0, 0, Bmp.Width, Bmp.Height), R,
      AbsoluteOpacity, true);

{$ENDIF}
  end;
{$ELSE}

// Ich nehme an, dass hier wird dann zu oft aufgerufen, so dass du ein das Gefühl der Langsamkeit hast?! Wäre es nicht schlauer DefaultRenderItem(...) nur dann aufzurufen, wenn R oder FActive sich im Vergleich zum Letzten Paint-Aufruf geändert haben und ansonsten ein Offscreen-Bitmap/Backbuffer zu verwenden. So wie du es ein paar Zeilen höher machst, wenn BACKBUFFER definiert wäre?
  DefaultRenderItem(Canvas, R, FImage, FActive);
{$ENDIF}
end;

[Peter666]

Das wird nur aufgerufen, wenn Backbuffer als Conditional Define nicht aktiv ist. Aber ja, wenn du das direkt in die Canvas zeichnest wird es furchbar hakelig. Deswegen zeichne ich die beiden Modi ja in ein Bild das dann via Drawbitmap gezeichnet wird.

[TiGü]

Falls es dir eine Hilfe ist: Hier 10 mal auf den Button geklickt und AQtime dabei laufen lassen:

[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