Работа с атрибутами текста

[slav_z]

Как сделать текст с подобными атрибутами? Очень просто!

(Цвет текста не работает в XE8) Вот весь код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Text1: TText;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

type
  TTextAccess = class(TText);

procedure ClearTextAttribute(Text: TText);
begin
  TTextAccess(Text).Layout.ClearAttributes;
end;

procedure AddTextAttribute(Text: TText; Pos,Length: Integer; FontStyles: TFontStyles; FontColor: TAlphaColor);
var Font: TFont;
begin
  Font:=TFont.Create;
  Font.Assign(Text.Font);
  Font.Style:=FontStyles;
  TTextAccess(Text).Layout.AddAttribute(
    TTextRange.Create(Pos,Length),
    TTextAttribute.Create(Font,FontColor));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  AddTextAttribute(Text1,10,17,[TFontStyle.fsBold],claRed);
  AddTextAttribute(Text1,34,8,[TFontStyle.fsUnderline],claBlue);
  AddTextAttribute(Text1,47,8,[TFontStyle.fsStrikeOut],claGreen);

  Text1.Repaint;

end;

end.

 

[Евгений Корепов]

Век живи, век учись. Спасибо, не знал о такой возможности. Поигрался в тестовом проекте - все действительно работает.

[slav_z]

procedure ClearTextAttribute(Text: TText);
begin
  for var I:=0 to TTextAccess(Text).Layout.AttributesCount-1 do
  TTextAccess(Text).Layout.Attributes[I].Attribute.Font.Free;
  TTextAccess(Text).Layout.ClearAttributes;
end;

поправка... иначе созданные объекты TFont не разрушаются... так же необходимо вызвать ClearTextAttribute() при разрушении формы.

[Aleks133]

Классная штука, но в Berlin 10.1 up2 тоже не работает цвет.И при очистке вылетает ошибка "Invalid pointer operation".

Если кто-нибудь знает как исправить, буду очень благодарен.