function FontToStr(font: TFont): string;
procedure yes(var str: string);
begin
str := str + "y";
end;
procedure no(var str: string);
begin
str := str + "n";
end;
begin
{кодируем все атрибуты TFont в строку}
Result := "";
Result := Result + IntToStr(font.Color) + "|";
Result := Result + IntToStr(font.Height) + "|";
Result := Result + font.Name + "|";
Result := Result + IntToStr(Ord(font.Pitch)) + "|";
Result := Result + IntToStr(font.PixelsPerInch) + "|";
Result := Result + IntToStr(font.size) + "|";
if fsBold in font.style then
yes(Result)
else
no(Result);
if fsItalic in font.style then
yes(Result)
else
no(Result);
if fsUnderline in font.style then
yes(Result)
else
no(Result);
if fsStrikeout in font.style then
yes(Result)
else
no(Result);
end;
procedure StrToFont(str: string; font: TFont);
begin
if str = "" then
Exit;
font.Color := StrToInt(tok("|", str));
font.Height := StrToInt(tok("|", str));
font.Name := tok("|", str);
font.Pitch := TFontPitch(StrToInt(tok("|", str)));
font.PixelsPerInch := StrToInt(tok("|", str));
font.Size := StrToInt(tok("|", str));
font.Style := [];
if str[0] = "y" then
font.Style := font.Style + [fsBold];
if str[1] = "y" then
font.Style := font.Style + [fsItalic];
if str[2] = "y" then
font.Style := font.Style + [fsUnderline];
if str[3] = "y" then
font.Style := font.Style + [fsStrikeout];
end;
function tok(sep: string; var s: string): string;
function isoneof(c, s: string): Boolean;
var
iTmp: integer;
begin
Result := False;
for iTmp := 1 to Length(s) do
begin
if c = Copy(s, iTmp, 1) then
begin
Result := True;
Exit;
end;
end;
end;
var
c, t: string;
begin
if s = "" then
begin
Result := s;
Exit;
end;
c := Copy(s, 1, 1);
while isoneof(c, sep) do
begin
s := Copy(s, 2, Length(s) - 1);
c := Copy(s, 1, 1);
end;
t := "";
while (not isoneof(c, sep)) and (s <> "") do
begin
t := t + c;
s := Copy(s, 2, length(s) - 1);
c := Copy(s, 1, 1);
end;
Result := t;
end;
|