Delphi FMX Bei Text in Listbox Videoausgabe im Keller...

[MAXON]

Ein Media Explorer in FMX sollte es werden, doch ich bin schier unglücklich warum die Textausgabe mit dem Text OnPaint Event die FPS so drastisch
einstürzen lässt.

https://www.manyplay.de/Bei_Text_in_..._im_Keller.mp4

FPS sichtbar in der Progressbar unterm Video...

Die OnPaint generiert die Balken und den Text über und unter den Listbox Items, aber selbst wenn die Abarbeitung meiner Routine einmalig länger
dauern sollte, die Elemente zeichnen sich doch wohl nicht ständig neu, wenn die Listbox einmal gerendert worden ist.

Delphi-Quellcode:

      with Canvas do
          if beginscene
          then
          begin
            font.Style := [ tfontstyle.fsBold ];
            font.Size := fx * 0.85;
            s := TListBoxItem( Sender ).Text;

            r := rectf( ARect.left + ( sx shr 2 ), ARect.top, ARect.Width - 1,
              ARect.Height - 1 );

            fill.Color := s1 - $00040404;
            fill.Gradient.Color := s1 + $00040404;
            fill.Kind := tbrushkind.Gradient;
            fill.Gradient.Style := tgradientstyle.Linear;

            fillrect( r, 3, 3, [ tcorner.TopLeft, tcorner.TopRight,
              tcorner.BottomLeft, tcorner.BottomRight ], 0.85 );

            r.top := ARect.top + 1;
            r.Height := ARect.Height * 0.5;

            fill.Color := s3;
            filltext( r, s, true, 0.95, [ ], ttextalign.Center,
              ttextalign.Center );

            if assigned( Sender ) and
              ( TListBoxItem( Sender ).ItemData.Detail <> '' )
            then
            begin

              if TListBoxItem( Sender ).Text.EndsWith( '\' )
              then
                t := TListBoxItem( Sender ).ItemData.Detail + ' ' +
                  TListBoxItem( Sender ).Hint
              else
              begin
                try
                  z := TListBoxItem( Sender ).ItemData.Detail.Split( [ ' ' ] );
                except
                  on e : exception do
                    doalert( er + #32 + ec + pt, ok );
                end;

                if ( length( z ) > 1 ) and not z[ 2 ].IsEmpty
                then
                  t := z[ 0 ] + ' ' + z[ 1 ] + ' ' +
                    sts( z[ 2 ].Replace( '.', '' ).ToInt64 ) + #13 +
                    TListBoxItem( Sender ).Hint
                else
                  t := er + #13 + TListBoxItem( Sender ).Hint
              end
            end;

            r := rectf( ARect.left + ( sx shr 2 ), ARect.top + ARect.Height *
              0.5 + 1, ARect.Width - 1, ARect.Height - 1 );

            fill.Color := s3;
            filltext( r, t, true, 0.95, [ ], ttextalign.Center,
              ttextalign.Center );

            endscene;
          end;

Mit Textfeldern geht es dauerhaft bei den FPS in den Keller...

Da ist doch irgendwie bei der Paint Ausführung der Listbox etwas sehr tragisch am verbaselt sein.

Extrem schlimmer wird es, wenn die Listboxitems dann selbst auch noch eine eigene Skalierung aufweisen...