Recent

Author Topic: FontToString and StringToFont  (Read 557 times)

arneolav

  • Full Member
  • ***
  • Posts: 130
    • ElTranslador
FontToString and StringToFont
« on: April 13, 2020, 09:25:54 pm »
As far as I can see, no functions for FontToString and StringToFont exists in Lazarus.

From JvJVCLUtils.pas I got this:

Code: Pascal  [Select][+][-]
  1. Uses   ...
  2.    strutils   { ExtractSubstr}
  3.  , Graphics   { TFont }
  4.    ;
  5. function FontToString(Font: TFont): string;
  6.   function FontStylesToString(Styles: TFontStyles): string;
  7.   begin
  8.     Result := '';
  9.     if fsBold in Styles then
  10.       Result := Result + 'B';
  11.     if fsItalic in Styles then
  12.       Result := Result + 'I';
  13.     if fsUnderline in Styles then
  14.       Result := Result + 'U';
  15.     if fsStrikeOut in Styles then
  16.       Result := Result + 'S';
  17.   end;
  18. begin
  19.   with Font do
  20.     Result := Format('%s,%d,%s,%d,%s,%d', [Name, Size,
  21.       FontStylesToString(Style), Ord(Pitch), ColorToString(Color), Charset]);
  22. end;
  23.  
  24.  
  25.  
  26. function StringToFont(const Str: string): TFont;
  27.   function StringToFontStyles(const Styles: string): TFontStyles;
  28.   begin
  29.     Result := [];
  30.     if Pos('B', UpperCase(Styles)) > 0 then
  31.       Include(Result, fsBold);
  32.     if Pos('I', UpperCase(Styles)) > 0 then
  33.       Include(Result, fsItalic);
  34.     if Pos('U', UpperCase(Styles)) > 0 then
  35.       Include(Result, fsUnderline);
  36.     if Pos('S', UpperCase(Styles)) > 0 then
  37.       Include(Result, fsStrikeOut);
  38.   end;
  39.  
  40. const
  41.   Delims = [',', ';'];
  42. var
  43.   Pos: Integer;
  44.   I: Byte;
  45.   S: string;
  46. begin
  47.   Result := TFont.Create;
  48.   try
  49.     Pos := 1;
  50.     I := 0;
  51.     while Pos <= Length(Str) do
  52.     begin
  53.       Inc(I);
  54.       S := Trim(ExtractSubstr(Str, Pos, Delims));
  55.       case I of
  56.         1:
  57.           Result.Name := S;
  58.         2:
  59.           Result.Size := StrToIntDef(S, Result.Size);
  60.         3:
  61.           Result.Style := StringToFontStyles(S);
  62.         4:
  63.           Result.Pitch := TFontPitch(StrToIntDef(S, Ord(Result.Pitch)));
  64.         5:
  65.           Result.Color := StringToColor(S);
  66.         6:
  67.           Result.Charset := TFontCharset(StrToIntDef(S, Result.Charset));
  68.       end;
  69.     end;
  70.   finally
  71.   end;
  72. end;


Seems to work pretty well! ::)
Win XP, Win7, Win 10 win64 , Lazarus 2.0.10
Delphi/DevExpress

arneolav

  • Full Member
  • ***
  • Posts: 130
    • ElTranslador
Re: FontToString and StringToFont
« Reply #1 on: April 14, 2020, 08:49:22 am »
It did seem to work, but in a more heavy test something went wrong:

The function ExtractSubstr seems to miss on this string;  "default,0,,0,clLime,1"

Field 5 = clLime, should be returned on I=5
But field 5 is returned on I= 4

Field 1 and 2 are returned ok, but the empty string is not returned.

I can't look into function ExtractSubstr,

Some idea?
Win XP, Win7, Win 10 win64 , Lazarus 2.0.10
Delphi/DevExpress

lucamar

  • Hero Member
  • *****
  • Posts: 2962
Re: FontToString and StringToFont
« Reply #2 on: April 14, 2020, 12:33:27 pm »
Use String.Split and get the fields from the returned TStringArray. Look in the RTL help for TStringHelper.Split, in unit SysUtils.

Alternatively, you could use ExtractStrings, in StrUtils Classes, making sure to set AddEmptyStrings to True.

The problem with your code is that ExtractSubStr() updates the position to the next non-delimiter, which makes it skip over the two consecutive commas, as explained in the help:

Quote from: Reference for unit 'strutils'
ExtractSubStr returns all characters from S starting at position Pos till the first character in Delims, or till the end of S is reached. The delimiter character is not included in the result. Pos is then updated to point to the next first non-delimiter character in S. If Pos is larger than the Length of S, an empty string is returned.
« Last Edit: April 14, 2020, 10:00:42 pm by lucamar »
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.8/FPC 3.0.4 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

arneolav

  • Full Member
  • ***
  • Posts: 130
    • ElTranslador
Re: FontToString and StringToFont
« Reply #3 on: April 14, 2020, 08:12:05 pm »
Thanks!
It seems my test input did make the test error;
Empty fields should normally not occure.
But I'll have a look to make it "bull proof".

By the way, ExtractStrings is in Classes, not StrUtils.
Win XP, Win7, Win 10 win64 , Lazarus 2.0.10
Delphi/DevExpress

lucamar

  • Hero Member
  • *****
  • Posts: 2962
Re: FontToString and StringToFont
« Reply #4 on: April 14, 2020, 10:00:02 pm »
By the way, ExtractStrings is in Classes, not StrUtils.

Oops! You're right. I was hopping back and forth between ExtractStrings and ExtractSubStr in the help and failed to notice the different units :-[

Quote
Empty fields should normally not occure.

Note that the empty field corresponds to the font style and will happen everytime it is "normal", i.e. when it no "style" is set, which will be more often than not. That's why a more robust solution must be used.
« Last Edit: April 14, 2020, 10:05:59 pm by lucamar »
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.8/FPC 3.0.4 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

 

TinyPortal © 2005-2018