Remove unknown fonts of document and set charset

This code can be used to remove fonts are not available. It also removes any character sets the font may have used.

var i,j : Integer;
    s : String;
    ca : TWPCHarAttr;
begin
     for i:=0 to WPRichText1.RTFData.RTFProps.FontMaxAnz-1 do
     begin
       s := WPRichText1.RTFData.RTFProps.Fontname[i];
       if Screen.Fonts.IndexOf( s )<0 then
       begin
         WPRichText1.RTFData.RTFProps.Fontname[i] := 'Arial';

         for j:=0 to WPRichText1.RTFData.RTFProps.Attributes.CharAttrCount-1 do
         begin
            WPRichText1.RTFData.RTFProps.Attributes.GetCharAttr(j, ca);
            if ((ca.MaskHash and BitMask[WPAT_CharFont])<>0) and
               (ca.Values[WPAT_CharFont]=i) then
               begin
                 ca.MaskHash := ca.MaskHash and not BitMask[WPAT_CharCharset];
                 ca.Values[WPAT_CharCharset] := 0;
                 WPRichText1.RTFData.RTFProps.Attributes.OverrideCharAttr(j,ca);
               end;
         end;
       end;
     end;
     WPRichText1.ReformatAll(true, true);
exit;