unit UScrollLabel;
interface
uses System.SysUtils, System.Classes, System.Types, System.UITypes,
FMX.Graphics, FMX.Types, FMX.Controls;
type
TScrollLabel =
class(TControl)
private
FXOffset: single;
FPausedTicks: Integer;
FMaxPause: Integer;
FStepSize: single;
FFontColor: TAlphaColor;
FTextSize: TSizeF;
FText:
String;
FFont: TFont;
protected
procedure Paint;
override;
procedure SetText(
const Value:
String);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property Text:
String read FText
write SetText;
property Font: TFont
read FFont;
property FontColor: TAlphaColor
read FFontColor
write FFontColor;
property MaxPause: Integer
read FMaxPause
write FMaxPause;
property Align;
property Anchors;
property ClipChildren
default false;
property ClipParent
default false;
property DesignVisible
default True;
property Enabled
default True;
property Locked
default false;
property Height;
property HitTest
default True;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property position;
property RotationAngle;
property RotationCenter;
property Scale;
property Visible
default True;
property Width;
{ Mouse events }
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseEnter;
property OnMouseLeave;
property OnPainting;
property OnPaint;
property OnResize;
end;
implementation
uses System.Math, FMX.TextLayout;
constructor TScrollLabel.Create(AOwner: TComponent);
begin
inherited;
FFont := TFont.Create;
FFontColor := $FFFFFFFF;
FMaxPause := 100;
FStepSize := 4;
end;
destructor TScrollLabel.Destroy;
begin
FreeAndNil(FFont);
inherited;
end;
procedure TScrollLabel.SetText(
const Value:
String);
begin
FText := Value;
Fillchar(FTextSize,sizeof(FTextSize),0);
end;
procedure TScrollLabel.Paint;
var
Layout: TTextLayout;
R: TRectF;
begin
if FTextSize.IsZero
then
begin
Canvas.Font.Assign(Font);
R := RectF(0, 0, 10000, 10000);
Canvas.MeasureText(R, Text, false, [], TTextAlign.taLeading,
TTextAlign.taLeading);
FTextSize := R.Size;
FPausedTicks := FMaxPause;
end;
if FTextSize.Width > Width
then
begin
if FPausedTicks > 0
then
dec(FPausedTicks)
else
begin
if (FXOffset > 0)
or (FXOffset + FTextSize.Width < Width)
then
begin
FStepSize := -FStepSize;
if (FXOffset > 0)
then
FPausedTicks := FMaxPause;
end;
FXOffset := FXOffset - FStepSize;
end;
end;
Layout := TTextLayoutManager.TextLayoutByCanvas(Canvas.ClassType)
.Create(Canvas);
try
Layout.BeginUpdate;
Layout.TopLeft := PointF(FXOffset + 8, 0);
Layout.MaxSize := PointF(Width - FXOffset - 8, Height);
Layout.Text := FText;
Layout.WordWrap := false;
Layout.Opacity := 1;
Layout.HorizontalAlign := TTextAlign.taLeading;
Layout.VerticalAlign := TTextAlign.taCenter;
Layout.Font := Font;
Layout.Color := FFontColor;
Layout.RightToLeft := false;
// TFillTextFlag.ftRightToLeft in Flags;
Layout.EndUpdate;
Layout.RenderLayout(Canvas);
finally
FreeAndNil(Layout);
end;
end;
end.