Содержание материала

 

Code:

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;

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить