TFont para String para TFont

unit FontToStr;

interface

uses

Graphics, SysUtils;

implementation

  function FTS(Font: TFont) : String;

  procedure STF(Str: String; Font: TFont);

function FTS(Font: TFont): String;

begin

  {Name, Size, Bold, Italic, Underline, Strikethrough, Color}

  Result := Format('%s,%d,%d%d%d%d,%s', [Font.Name, Font.Size,

  Integer(fsBold in Font.Style), Integer(fsItalic in Font.Style),

  Integer(fsUnderline in Font.Style), Integer(fsStrikeOut in Font.Style),

  ColorToString(Font.Color)]);

end;

procedure STF(Str: String; Font: TFont);

const

  SEP = ',';

  EXCEPT_MSG = 'Invalid string to font conversion';

var

  i: Integer;

begin

  {any exception/error we encounter will ultimately

  result in an EConvertError being raised}

  // name

  i := Pos(SEP, Str);

  if i = 0 then raise EConvertError.Create(EXCEPT_MSG);

  Font.Name := Copy(Str, 1, i-1);

  Delete(Str, 1, i);

  // size

  i := Pos(SEP, Str);

  if i = 0 then raise EConvertError.Create(EXCEPT_MSG);

  Font.Size := StrToInt(Copy(Str, 1, i-1));

  Delete(Str, 1, i);

  // bold, italic, underline, strikethrough

  if Pos(SEP, Str) <> 5 then raise EConvertError.Create(EXCEPT_MSG);

  Font.Style := [];

  if Str[1] = '1' then

    Font.Style := Font.Style + [fsBold];

  if Str[2] = '1' then

      Font.Style := Font.Style + [fsItalic];

  if Str[3] = '1' then

    Font.Style := Font.Style + [fsUnderline];

  if Str[4] = '1' then

    Font.Style := Font.Style + [fsStrikeOut];

  Delete(Str, 1, 5);

  // colour

  Font.Color := StringToColor(Str);

end;

end.