FontToString and StringToFont
lazarus / 39-Graphics

----------------------------------------------------------------------
arneolav · 2020-04-13 19:25

As far as I can see, no functions for FontToString and StringToFont
exists in Lazarus.

From JvJVCLUtils.pas I got this:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Uses   ... 
 strutils   { ExtractSubstr} , Graphics   { TFont }    ;function
FontToString(Font: TFont): string;  function
FontStylesToString(Styles: TFontStyles): string;  begin    Result :=
'';    if fsBold in Styles then      Result := Result + 'B';    if
fsItalic in Styles then      Result := Result + 'I';    if fsUnderline
in Styles then      Result := Result + 'U';    if fsStrikeOut in
Styles then      Result := Result + 'S';  end;begin  with Font do   
Result := Format('%s,%d,%s,%d,%s,%d', [Name, Size,     
FontStylesToString(Style), Ord(Pitch), ColorToString(Color),
Charset]);end;   function StringToFont(const Str: string): TFont; 
function StringToFontStyles(const Styles: string): TFontStyles; 
begin    Result := [];    if Pos('B', UpperCase(Styles)) > 0 then    
Include(Result, fsBold);    if Pos('I', UpperCase(Styles)) > 0 then  
  Include(Result, fsItalic);    if Pos('U', UpperCase(Styles)) > 0
then      Include(Result, fsUnderline);    if Pos('S',
UpperCase(Styles)) > 0 then      Include(Result, fsStrikeOut); 
end; const  Delims = [',', ';'];var  Pos: Integer;  I: Byte;  S:
string;begin  Result := TFont.Create;  try    Pos := 1;    I := 0;   
while Pos <= Length(Str) do    begin      Inc(I);      S :=
Trim(ExtractSubstr(Str, Pos, Delims));      case I of        1:      
  Result.Name := S;        2:          Result.Size := StrToIntDef(S,
Result.Size);        3:          Result.Style :=
StringToFontStyles(S);        4:          Result.Pitch :=
TFontPitch(StrToIntDef(S, Ord(Result.Pitch)));        5:         
Result.Color := StringToColor(S);        6:          Result.Charset :=
TFontCharset(StrToIntDef(S, Result.Charset));      end;    end; 
finally  end;end;

Seems to work pretty well!

----------------------------------------------------------------------
arneolav · 2020-04-14 06:49

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?

----------------------------------------------------------------------
lucamar · 2020-04-14 10:33

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.

----------------------------------------------------------------------
arneolav · 2020-04-14 18:12

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.

----------------------------------------------------------------------
lucamar · 2020-04-14 20:00

Quote from: arneolav on April 14, 2020, 08:12:05 pmBy 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

QuoteEmpty 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.