开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 界面编程 > RichEdit > 查看源码
RVFuncs.pas
资源名称：TRichView.v1.9.10.2.rar　[点击查看]
上传用户：daoqigc
上传日期：2021-04-20
资源大小：2795k
文件大小：55k
源码类别：

RichEdit

开发平台：

Delphi

RVFuncs.pas：源码内容
  2. {*******************************************************}
  3. {                                                       }
  4. {       RichView                                        }
  5. {       Miscellaneous procedures.                       }
  6. {                                                       }
  7. {       Copyright (c) Sergey Tkachenko                  }
  8. {       svt@trichview.com                               }
  9. {       http://www.trichview.com                        }
  10. {                                                       }
  11. {*******************************************************}
  13. unit RVFuncs;
  15. interface
  17. {$I RV_Defs.inc}
  19. uses SysUtils, Windows, Classes, RVStyle, RVStr,
  20.      {$IFNDEF RVDONOTUSEJPEGIMAGE}
  21.      Jpeg,
  22.     {$ENDIF}
  23.      Graphics;
  25. const
  26.   { Number of pixels in the screen inch. If 0 (default) - use screen resolution.
  27.     Affects converting pixels to mm, inches, twips and vice versa:
  28.     printing, RTF.
  29.     Main possible values: 96 (small font mode), 120 (large font mode). }
  30.   RichViewPixelsPerInch : Integer = 0;
  32. {---------------------------  Text & Tags  ------------------------------------}
  34. function RV_CopyTag(SourceTag: Integer; TagsArePChars: Boolean): Integer;
  35. function RV_CompareTags(Tag1, Tag2: Integer; TagsArePChars: Boolean): Boolean;
  36. function RV_ReplaceTabsA(const s: String; SpacesInTab: Integer): String;
  37. function RV_ReplaceTabsW(const s: String; SpacesInTab: Integer): String;
  38. function RV_CharPos(const Str: PChar; Chr: Char; Length: Integer): Integer; assembler;
  39. procedure RV_ReplaceStr(var str: String; oldstr, newstr: String);
  40. function RV_GetHintStr(DocFormat: TRVSaveFormat; const Hint: String): String;
  42. {--------------------------  HTML functions  ----------------------------------}
  44. function RV_GetHTMLRGBStr(Color: TColor; Quotes: Boolean): String;
  45. function RV_GetCSSBkColor(Color: TColor): String;
  46. function RV_GetHTMLPath(const Path: String; SaveOptions: TRVSaveOptions; CodePage: TRVCodePage): String;
  47. function RV_GetHTMLFontCSS(Font: TFont; UseFontName: Boolean): String;
  48. function RV_HTMLGetFontSize(pts: Integer): Integer;
  49. function RV_HTMLOpenFontTag(ts, normalts: TFontInfo; Relative: Boolean;
  50.   SaveOptions: TRVSaveOptions): String;
  51. function RV_HTMLOpenFontTag2(fnt: TFont; normalts: TFontInfo; UseFontName: Boolean;
  52.   SaveOptions: TRVSaveOptions): String;
  53. function RV_HTMLCloseFontTag(ts: TFontInfo; normalts: TFontInfo; Relative: Boolean):String;
  54. function RV_HTMLCloseFontTag2(fnt: TFont; normalts: TFontInfo;
  55.   UseFontName: Boolean):String;
  56. {$IFNDEF RVDONOTUSEHTML}
  57. function RV_MakeHTMLSymbolStr(const s: String): String;
  58. function RV_MakeHTMLSymbolStrRaw(const s: String): String;
  59. function RV_MakeHTMLStr(const str:String; SpecialCode:Boolean): String;
  60. {$IFDEF RICHVIEWCBDEF3}
  61. function RV_CharSet2HTMLLang(CharSet: TFontCharset): String;
  62. {$ENDIF}
  63. {$ENDIF}
  64. function RV_DecodeURL(const s: String): String;
  65. function RV_HTMLGetEndingSlash(SaveOptions: TRVSaveOptions): String;
  66. function RV_HTMLGetNoValueAttribute(const Attr: String; SaveOptions: TRVSaveOptions): String;
  67. function RV_HTMLGetIntAttrVal(Value: Integer; SaveOptions: TRVSaveOptions): String;
  68. function RV_HTMLGetStrAttrVal(const Value: String; SaveOptions: TRVSaveOptions): String;
  70. {--------------------------  RTF functions  -----------------------------------}
  72. {$IFNDEF RVDONOTUSERTF}
  73. function RVMakeRTFStr(const s:String; SpecialCode, UseNamedEntities: Boolean): String;
  74. function RVMakeRTFFileNameStr(const s:String): String;
  75. function MakeRTFIdentifierStr(const s:String): String;
  76. function MakeRTFBookmarkNameStr(const s:String): String;
  77. procedure RVWriteUnicodeRTFStr(Stream: TStream; const s: String;
  78.   CodePage: TRVCodePage; SaveAnsi, SpecialCode: Boolean);
  79. {$ENDIF}
  81. {-------------------------- URL Detection -------------------------------------}
  83. function RVIsURL(const s: String): Boolean;
  84. function RVIsEmail(const s: String): Boolean;
  86. {----------------------  Conversion of coordinates  ---------------------------}
  88. function RV_XToDevice(X: Integer; const sad: TRVScreenAndDevice): Integer;
  89. function RV_YToDevice(Y: Integer; const sad: TRVScreenAndDevice): Integer;
  90. function RV_XToScreen(X: Integer; const sad: TRVScreenAndDevice): Integer;
  91. function RV_YToScreen(Y: Integer; const sad: TRVScreenAndDevice): Integer;
  92. procedure RV_RectToScreen(var R: TRect; const sad: TRVScreenAndDevice);
  93. procedure RV_InfoAboutSaD(var sad:TRVScreenAndDevice; Canvas: TCanvas);
  94. function RV_GetPixelsPerInch: Integer;
  95. function RV_PointInRect(X,Y: Integer; Left,Top,Width,Height: Integer): Boolean;
  97. {------------------------  Graphics & Colors  ---------------------------------}
  99. function RV_CreateGraphicsDefault(GraphicClass: TGraphicClass): TGraphic;
  100. procedure RV_AfterImportGraphicDefault(Graphic: TGraphic);
  101. function RV_GetLuminance(Color: TColor): Integer;
  102. function RV_GetGray(Color: TColor): TColor;
  103. function RV_GetPrnColor(Color: TColor): TColor;
  104. function RV_GetColor(Color: TColor; ColorMode: TRVColorMode): TColor;
  105. function RV_GetBackColor(Color: TColor; ColorMode: TRVColorMode): TColor;
  106. function RV_IsGraphicTransparent(gr: TGraphic): Boolean;
  107. procedure RV_SetPaletteToPicture(gr: TGraphic; PLogPal: PLogPalette);
  108. procedure RV_PictureToDevice(Canvas: TCanvas; x,y, width, height: Integer;
  109.   sad:TRVScreenAndDevice; gr: TGraphic; ToScreen: Boolean);
  111. { ---------------------------- Others -----------------------------------------}
  112. {$IFNDEF RICHVIEWCBDEF3}
  113. function ExtractRelativePath(const BaseName, DestName: string): string;
  114. {$ENDIF}
  115. procedure RV_AddStr(var s1: String; const s2: String);
  117. type
  118.   TRV_CreateGraphicsFunction = function (GraphicClass: TGraphicClass): TGraphic;
  119.   TRV_AfterImportGraphicsProc = procedure(Graphic: TGraphic);
  120. var
  121.   { Procedure for creating graphic object by graphic class
  122.     used as a workaround for D2-D5, CB1-CB5 bug (private constructor in
  123.     TGraphic). Assign your own procedure if you use third-party graphic
  124.     classes }
  125.   RV_CreateGraphics: TRV_CreateGraphicsFunction;
  126.   { Procedure for calling after importing external graphics from RTF documents }
  127.   RV_AfterImportGraphic: TRV_AfterImportGraphicsProc;
  129. implementation
  131. uses RVFMisc, RVUni, CRVData;
  133. type SetOfChar = set of Char;
  136. procedure ReplaceChars(var str: String; Replacer: Char; Replaced: SetOfChar); forward;
  138. {===========================  Text & Tags  ====================================}
  139. { Returns a copy of SourceTag. If TagsArePChars, it assumes that SourceTag is
  140.   a pointer to ANSIZ string, creates a copy of this string and returns it      }
  141. function RV_CopyTag(SourceTag: Integer; TagsArePChars: Boolean): Integer;
  142. begin
  143.   if (SourceTag<>0) and TagsArePChars then
  144.     Result := Integer(StrNew(PChar(SourceTag)))
  145.   else
  146.     Result := SourceTag;
  147. end;
  148. {------------------------------------------------------------------------------}
  149. { Returns true if Tag1 is equal to Tag2. If TagsArePChars, tags are compared
  150.   as strings, otherwise as integers                                            }
  151. function RV_CompareTags(Tag1, Tag2: Integer; TagsArePChars: Boolean): Boolean;
  152. begin
  153.   if TagsArePChars then
  154.     if (Tag1=0) then
  155.       if (Tag2=0) then
  156.         Result := True
  157.       else
  158.         Result := False
  159.     else
  160.       if (Tag2=0) then
  161.         Result := False
  162.       else
  163.         Result := StrComp(PChar(Tag1),PChar(Tag2))=0
  164.   else
  165.     Result := Tag1=Tag2;
  166. end;
  167. {------------------------------------------------------------------------------}
  168. { Replaces all tabs (#9) with a sequence of SpacesInTab space characters       }
  169. function RV_ReplaceTabsA(const s: String; SpacesInTab: Integer): String;
  170. var p: Integer;
  171.     spaces: String;
  172. begin
  173.   Result := s;
  174.   p := Pos(#9,Result);
  175.   if p<>0 then begin
  176.     SetLength(spaces,SpacesInTab);
  177.     FillChar(PChar(spaces)^, SpacesInTab, ' ');
  178.   end;
  179.   while p<>0 do begin
  180.     Delete(Result,p,1);
  181.     Insert(spaces,Result,p);
  182.     p := Pos(#9,Result);
  183.   end;
  184. end;
  185. {------------------------------------------------------------------------------}
  186. { The same for unicode string (represented as "raw unicode")                   }
  187. function RV_ReplaceTabsW(const s: String; SpacesInTab: Integer): String;
  188. var i,p: Integer;
  189.     spaces: String;
  190. begin
  191.   Result := s;
  192.   p := Pos(#9#0,Result);
  193.   if p<>0 then begin
  194.     SetLength(spaces,SpacesInTab*2);
  195.     FillChar(PChar(spaces)^, SpacesInTab*2, 0);
  196.     for i := 1 to SpacesInTab do
  197.       spaces[(i-1)*2+1] := ' ';
  198.   end;
  199.   while p<>0 do begin
  200.     Delete(Result,p,2);
  201.     Insert(spaces,Result,p);
  202.     p := Pos(#9#0,Result);
  203.   end;
  204. end;
  205. {------------------------------------------------------------------------------}
  206. { Returns index of character (Chr) in string (Str) having length Length.
  207.   Returns 0 if not found. Otherwise index of the first occurence of the character
  208.   (1-based).                                                                   }
  209. function RV_CharPos(const Str: PChar {EAX}; Chr: Char {DL} ; Length: Integer {ECX}): Integer; assembler;
  210. asm
  211.         TEST    EAX,EAX
  212.         JE      @@2
  213.         PUSH    EDI
  214.         PUSH    EBX
  215.         MOV     EDI,Str
  216.         MOV     EBX,Str
  217.         MOV     AL,Chr
  218.         REPNE   SCASB
  219.         MOV     EAX,0
  220.         JNE     @@1
  221.         MOV     EAX,EDI
  222.         SUB     EAX,EBX
  223. @@1:    POP     EBX
  224.         POP     EDI
  225. @@2:
  226. end;
  227. {------------------------------------------------------------------------------}
  228. { Replaces in str all substrings oldstr with substring newstr.
  229.   Case insensitive. Newstr CANNOT contain oldstr as a substring.               }
  230. procedure RV_ReplaceStr(var str: String; oldstr, newstr: String);
  231. var p: Integer;
  232. begin
  233.    while true do begin
  234.      p := pos(oldstr, str);
  235.      if p=0 then break;
  236.      Delete(str,p, Length(oldstr));
  237.      Insert(newstr, str, p);
  238.    end;
  239. end;
  240. {------------------------------------------------------------------------------}
  241. { Replaces in str all substrings oldstr with substring newstr.
  242.   Case insensitive. Newstr can contain oldstr as a substring.                  }
  243. procedure RV_ReplaceStr2(var str: String; oldstr, newstr: String);
  244. var p,ptr: Integer;
  245.     s: String;
  246. begin
  247.    s := str;
  248.    ptr := 1;
  249.    while true do begin
  250.      p := pos(oldstr, s);
  251.      if p=0 then break;
  252.      inc(p, ptr-1);
  253.      Delete(str,p, Length(oldstr));
  254.      Insert(newstr, str, p);
  255.      ptr := p+Length(newstr);
  256.      s := Copy(str, ptr, Length(str)+1-ptr);
  257.    end;
  258. end;
  259. {------------------------------------------------------------------------------}
  260. { Returns code for inserting hint (tool tip) in HTML and RTF                   }
  261. function RV_GetHintStr(DocFormat: TRVSaveFormat; const Hint: String): String;
  262. begin
  263.   Result := Hint;
  264.   if Result='' then
  265.     exit;
  266.   case DocFormat of
  267.     rvsfHTML:
  268.       begin
  269.         {$IFNDEF RVDONOTUSEHTML}
  270.         ReplaceChars(Result , '''', ['"']);
  271.         Result := 'title="'+Result+'"';
  272.         {$ENDIF}
  273.       end;
  274.     rvsfRTF:
  275.       begin
  276.         {$IFNDEF RVDONOTUSERTF}
  277.         ReplaceChars(Result , '''', ['"']);
  278.         Result := MakeRTFIdentifierStr(Result);
  279.         Result := 'o "'+Result+'"';
  280.         {$ENDIF}
  281.       end;
  282.   end;
  283. end;
  284. {==========================  HTML functions  ==================================}
  285. { Returns HTML representation of color ('#RRGGBB' string).
  286.   For clNone, returns empty string.
  287.   Processes clWindowText as clBlack.                                           }
  288. function RV_GetHTMLRGBStr(Color: TColor; Quotes: Boolean): String;
  289. begin
  290.   if Color=clWindowText then
  291.     Color := clBlack;
  292.   if Color=clNone then
  293.     Result := ''
  294.   else begin
  295.     Result := LowerCase(IntToHex(ColorToRGB(Color),6));
  296.     Result := '#'+System.Copy(Result,5,2)+System.Copy(Result,3,2)+System.Copy(Result,1,2);
  297.     if Quotes then
  298.       Result := '"'+Result+'"';
  299.   end;
  300. end;
  301. {------------------------------------------------------------------------------}
  302. { The same as RV_GetHTMLRGBStr, but returns 'transparent' for clNone           }
  303. function RV_GetCSSBkColor(Color: TColor): String;
  304. begin
  305.   if Color=clNone then
  306.     Result := 'transparent'
  307.   else
  308.     Result := RV_GetHTMLRGBStr(Color, False);
  309. end;
  310. {------------------------------------------------------------------------------}
  311. { Replaces all '' with '/'                                                    }
  312. function RV_GetHTMLPath(const Path: String; SaveOptions: TRVSaveOptions;
  313.   CodePage: TRVCodePage): String;
  314. var i: Integer;
  315. begin
  316.   Result := Path;
  317.   for i := 1 to Length(Result) do
  318.     if Result[i]='' then
  319.       Result[i] := '/';
  320.   if rvsoUTF8 in SaveOptions then
  321.     Result := RVU_AnsiToUTF8(CodePage, Result);
  322. end;
  323. {------------------------------------------------------------------------------}
  324. { Special concatenation of two strings                                         }
  325. procedure RV_AddStr(var s1: String; const s2: String);
  326. begin
  327.   if s1<>'' then begin
  328.     if s2<>'' then
  329.       s1 := s1+' '+s2
  330.     end
  331.   else
  332.     s1 := s2;
  333. end;
  334. {------------------------------------------------------------------------------}
  335. { Returns string describing the given font in CSS format                       }
  336. function RV_GetHTMLFontCSS(Font: TFont; UseFontName: Boolean): String;
  337. var s: String;
  338. begin
  339.   Result := '';
  340.   if fsBold in Font.Style then
  341.     Result := 'font-weight: bold;';
  342.   if fsItalic in Font.Style then
  343.     RV_AddStr(Result, 'font-style: italic;');
  344.   if Font.Size>0 then
  345.     RV_AddStr(Result, Format('font-size: %dpt;',[Font.Size]))
  346.   else
  347.     RV_AddStr(Result, Format('font-size: %dpx;',[Font.Height]));
  348.   if UseFontName then begin
  349.     s := ''''+Font.Name+'''';
  350.     if (AnsiCompareText(Font.Name, RVFONT_SYMBOL)=0) or
  351.        (AnsiCompareText(Font.Name, RVFONT_WINGDINGS)=0) then
  352.       s := '''Arial Unicode MS'', ''Lucida Sans Unicode'', ''Arial''';
  353.     RV_AddStr(Result, Format('font-family: %s;',[s]));
  354.   end;
  355.   s := '';
  356.   if fsUnderline in Font.Style then
  357.     s := 'underline';
  358.   if fsStrikeOut in Font.Style then
  359.     RV_AddStr(s, 'line-through');
  360.   if s<>'' then
  361.     Result := Format('%s text-decoration: %s;',[Result,s]);
  362.   Result := Format('%s color: %s;',[Result,RV_GetHTMLRGBStr(Font.Color, False)]);
  363. end;
  364. {------------------------------------------------------------------------------}
  365. { Converts the font size in points to the font size for HTML (without CSS).
  366.   HTML uses 7 font sizes.                                                      }
  367. function RV_HTMLGetFontSize(pts: Integer): Integer;
  368. begin
  369.   if pts<=8 then
  370.     Result := 1
  371.   else
  372.     case pts of
  373.       9..10:  Result := 2;
  374.       11..12: Result := 3;
  375.       13..14: Result := 4;
  376.       15..18: Result := 5;
  377.       19..24: Result := 6;
  378.       else    Result := 7;
  379.     end;
  380. end;
  381. {------------------------------------------------------------------------------}
  382. { Returns opening HTML tags for formatting of text style ts.
  383.   If Relative, it returns a difference in formatting between ts and normalts   }
  384. function RV_HTMLOpenFontTag(ts, normalts: TFontInfo; Relative: Boolean;
  385.   SaveOptions: TRVSaveOptions): String;
  386. var s: String;
  387. begin
  388.   s := '';
  389.   if not Relative or (ts.Size<>normalts.Size) then
  390.     s := s+' size='+RV_HTMLGetIntAttrVal(RV_HTMLGetFontSize(ts.Size), SaveOptions);
  391.   if not Relative or (ts.Color<>normalts.Color) then
  392.     s := s+' color='+RV_GetHTMLRGBStr(ts.Color, True);
  393.   if not Relative or (AnsiCompareText(ts.FontName,normalts.FontName)<>0) then
  394.     s := s+' face="'+ts.FontName+'"';
  395.   if s<>'' then
  396.     s := '<font'+s+'>';
  397.   if Relative then begin
  398.     if not (fsStrikeOut in ts.Style) and (fsStrikeOut in normalts.Style) then s := s+'</s>';
  399.     if not (fsUnderline in ts.Style) and (fsUnderline in normalts.Style) then s := s+'</u>';
  400.     if not (fsItalic    in ts.Style) and (fsItalic    in normalts.Style) then s := s+'</i>';
  401.     if not (fsBold      in ts.Style) and (fsBold      in normalts.Style) then s := s+'</b>';
  402.     if (fsBold      in ts.Style) and not (fsBold      in normalts.Style) then s := s+'<b>';
  403.     if (fsItalic    in ts.Style) and not (fsItalic    in normalts.Style) then s := s+'<i>';
  404.     if (fsUnderline in ts.Style) and not (fsUnderline in normalts.Style) then s := s+'<u>';
  405.     if (fsStrikeOut in ts.Style) and not (fsStrikeOut in normalts.Style) then s := s+'<s>';
  406.     end
  407.   else begin
  408.     if (fsBold in ts.Style)      then s := s+'<b>';
  409.     if (fsItalic in ts.Style)    then s := s+'<i>';
  410.     if (fsUnderline in ts.Style) then s := s+'<u>';
  411.     if (fsStrikeOut in ts.Style) then s := s+'<s>';
  412.   end;
  413.   if ts.VShift < 0 then
  414.     s := s+'<sub>'
  415.   else if ts.VShift > 0 then
  416.     s := s+'<sup>';
  417.   Result := s;
  418. end;
  419. {------------------------------------------------------------------------------}
  420. { The same as RV_HTMLOpenFontTag(..., True), but formatting is defined by
  421.   fnt: TFont                                                                   }
  422. function RV_HTMLOpenFontTag2(fnt: TFont; normalts: TFontInfo;
  423.   UseFontName: Boolean; SaveOptions: TRVSaveOptions): String;
  424. var s: String;
  425. begin
  426.   s := '';
  427.   if (fnt.Size<>normalts.Size) then
  428.     s := s+' size='+RV_HTMLGetIntAttrVal(RV_HTMLGetFontSize(fnt.Size), SaveOptions);
  429.   if (fnt.Color<>normalts.Color) then
  430.     s := s+' color='+RV_GetHTMLRGBStr(fnt.Color, True);
  431.   if UseFontName and (AnsiCompareText(fnt.Name,normalts.FontName)<>0) then
  432.     s := s+' face="'+fnt.Name+'"';
  433.   if s<>'' then
  434.     s := '<font'+s+'>';
  435.   if not (fsStrikeOut in fnt.Style) and (fsStrikeOut in normalts.Style) then s := s+'</s>';
  436.   if not (fsUnderline in fnt.Style) and (fsUnderline in normalts.Style) then s := s+'</u>';
  437.   if not (fsItalic    in fnt.Style) and (fsItalic    in normalts.Style) then s := s+'</i>';
  438.   if not (fsBold      in fnt.Style) and (fsBold      in normalts.Style) then s := s+'</b>';
  439.   if (fsBold      in fnt.Style) and not (fsBold      in normalts.Style) then s := s+'<b>';
  440.   if (fsItalic    in fnt.Style) and not (fsItalic    in normalts.Style) then s := s+'<i>';
  441.   if (fsUnderline in fnt.Style) and not (fsUnderline in normalts.Style) then s := s+'<u>';
  442.   if (fsStrikeOut in fnt.Style) and not (fsStrikeOut in normalts.Style) then s := s+'<s>';
  443.   Result := s;
  444. end;
  445. {------------------------------------------------------------------------------}
  446. { Closes HTML tags opened in RV_HTMLOpenFontTag                                }
  447. function RV_HTMLCloseFontTag(ts: TFontInfo; normalts: TFontInfo; Relative: Boolean):String;
  448. var s: String;
  449. begin
  450.   if ts.VShift < 0 then
  451.     s := s+'</sub>'
  452.   else if ts.VShift > 0 then
  453.     s := s+'</sup>';
  454.   if Relative then begin
  455.     if (fsStrikeOut in ts.Style) and not (fsStrikeOut in normalts.Style) then s := s+'</s>';
  456.     if (fsUnderline in ts.Style) and not (fsUnderline in normalts.Style) then s := s+'</u>';
  457.     if (fsItalic    in ts.Style) and not (fsItalic    in normalts.Style) then s := s+'</i>';
  458.     if (fsBold      in ts.Style) and not (fsBold      in normalts.Style) then s := s+'</b>';
  459.     if not (fsBold      in ts.Style) and (fsBold      in normalts.Style) then s := s+'<b>';
  460.     if not (fsItalic    in ts.Style) and (fsItalic    in normalts.Style) then s := s+'<i>';
  461.     if not (fsUnderline in ts.Style) and (fsUnderline in normalts.Style) then s := s+'<u>';
  462.     if not (fsStrikeOut in ts.Style) and (fsStrikeOut in normalts.Style) then s := s+'<s>';
  463.     end
  464.   else begin
  465.     if (fsStrikeOut in ts.Style) then s := s+'</s>';
  466.     if (fsUnderline in ts.Style) then s := s+'</u>';
  467.     if (fsItalic in ts.Style)    then s := s+'</i>';
  468.     if (fsBold in ts.Style)      then s := s+'</b>';
  469.   end;
  470.   if not Relative or (ts.Size<>normalts.Size) or (ts.Color<>normalts.Color) or
  471.     (AnsiCompareText(ts.FontName,normalts.FontName)<>0) then
  472.     s:= s+'</font>';
  473.   Result := s;
  474. end;
  475. {------------------------------------------------------------------------------}
  476. { Closes HTML tags opened in RV_HTMLOpenFontTag2                               }
  477. function RV_HTMLCloseFontTag2(fnt: TFont; normalts: TFontInfo; UseFontName: Boolean):String;
  478. var s: String;
  479. begin
  480.   if (fsStrikeOut in fnt.Style) and not (fsStrikeOut in normalts.Style) then s := s+'</s>';
  481.   if (fsUnderline in fnt.Style) and not (fsUnderline in normalts.Style) then s := s+'</u>';
  482.   if (fsItalic    in fnt.Style) and not (fsItalic    in normalts.Style) then s := s+'</i>';
  483.   if (fsBold      in fnt.Style) and not (fsBold      in normalts.Style) then s := s+'</b>';
  484.   if not (fsBold      in fnt.Style) and (fsBold      in normalts.Style) then s := s+'<b>';
  485.   if not (fsItalic    in fnt.Style) and (fsItalic    in normalts.Style) then s := s+'<i>';
  486.   if not (fsUnderline in fnt.Style) and (fsUnderline in normalts.Style) then s := s+'<u>';
  487.   if not (fsStrikeOut in fnt.Style) and (fsStrikeOut in normalts.Style) then s := s+'<s>';
  488.   if (fnt.Size<>normalts.Size) or (fnt.Color<>normalts.Color) or
  489.     (UseFontName and (AnsiCompareText(fnt.Name,normalts.FontName)<>0)) then
  490.     s:= s+'</font>';
  491.   Result := s;
  492. end;
  493. {------------------------------------------------------------------------------}
  494. {$IFNDEF RVDONOTUSEHTML}
  495. const SymbolEntities: array [$20..$FE] of PChar =
  496. (
  497.   ' ',
  498.   '!', 'forall', '#', 'exist', '%', '&', '?', '(', ')', '*',
  499.   '+', ',', '-', '.', '/', '0', '1', '2', '3', '4',
  500.   '5', '6', '7', '8', '9', ':', ';', '<', '=', '>',
  501.   '?', 'cong', 'Alpha', 'Beta', 'Chi', 'Delta', 'Epsilon', 'Phi', 'Gamma', 'Eta',
  502.   'Iota', '#977', 'Kappa', 'Lambda', 'Mu', 'Nu', 'Omicron', 'Pi', 'Theta', 'Rho',
  503.   'Sigma', 'Tau', 'Upsilon', 'sigmaf', 'Omega', 'Xi', 'Psi', 'Zeta', '[', 'there4',
  504.   ']', 'perp', '_', '-', 'alpha', 'beta', 'chi', 'delta', 'epsilon', '#981',
  505.   'gamma', 'eta', 'iota', 'phi', 'kappa', 'lambda', 'mu', 'nu', 'omicron', 'pi',
  506.   'theta', 'rho', 'sigma', 'tau', 'upsilon', '#982', 'omega', 'xi', 'psi', 'zeta',
  507.   '{', '|', '}', '~', '', '', '', '', '', '',
  508.   '', '', '', '', '', '', '', '', '', '',
  509.   '', '', '', '', '', '', '', '', '', '',
  510.   '', '', '', '', '', '', '', '', '#978', 'prime',
  511.   'le', 'frasl', 'infin', 'fnof', 'clubs', 'diams', 'hearts', 'spades', 'harr', 'larr',
  512.   'uarr', 'rarr', 'darr', '