[Decoding]

Вот еще один

Код:

 
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;