[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    From: jxidus@aol.com (JXidus)

    My solution: (to store the entire font, actually)

    --------------------------------------------------------------------------------

    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
         {encode all attributes of a TFont into a string}
         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;

    --------------------------------------------------------------------------------

    Note that you can keep stuff like this really handy by creating your own
    subclass of the TIniFile class, and adding routines like this.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]