fpspreadsheet: Add new worksheet method "WriteTextAsHTML" which can contain embedded html codes translated to "rich-text" sections. The method for normal text, "WriteUTF8Text", has been renamed to "WriteText"; the old one is deprecated. Same with "ReadAsUTF8Text" (which is now "ReadText").

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4267 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/read_write/excel8demo/excel8read.lpr

@@ -50,7 +50,7 @@ begin
     begin
       Write('Row: ', CurCell^.Row,
        ' Col: ', CurCell^.Col, ' Value: ',
-       UTF8ToConsole(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row,
+       UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row,
          CurCell^.Col))
        );
       if HasFormula(CurCell) then

components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr

@@ -19,7 +19,6 @@ const
   Str_Fourth = 'Fourth';
   Str_Worksheet1 = 'Meu Relatório';
   Str_Worksheet2 = 'My Worksheet 2';
-  Str_Total = 'Total:';
 var
   MyWorkbook: TsWorkbook;
   MyWorksheet: TsWorksheet;
@@ -58,9 +57,13 @@ begin
   MyWorksheet.WriteNumber(0, 1, 2.0);        // B1
   MyWorksheet.WriteNumber(0, 2, 3.0);        // C1
   MyWorksheet.WriteNumber(0, 3, 4.0);        // D1
-  MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5
+  MyWorksheet.WriteText  (4, 2, 'Total');    // C5
   MyWorksheet.WriteNumber(4, 3, 10);         // D5
 
+  MyWorksheet.WriteTextAsHTML(2, 0, 'H<sub>2</sub>O');
+  MyWorksheet.WriteTextAsHTML(3, 0, '<font color="red">red</font>, <font color="yellow">yellow</font>, <font color="green">green</font>');
+  MyWorksheet.WriteTextAsHTML(4, 0, 'sin<sup>2</sup> &alpha; + cos<sup>2</sup> &beta; = 1');
+
   // D6 number with background color
   MyWorksheet.WriteNumber(5, 3, 10);
   lCell := MyWorksheet.GetCell(5, 3);
@@ -82,7 +85,7 @@ begin
   // F7, top border only, but different color
   MyWorksheet.WriteBorders(6, 5, [cbNorth]);
   MyWorksheet.WriteBorderColor(6, 5, cbNorth, scGreen);
-  MyWorksheet.WriteUTF8Text(6, 5, 'top border green or red?');
+  MyWorksheet.WriteText(6, 5, 'top border green or red?');
   // Excel shows it to be red --> the upper border wins
 
   // H6 empty cell, all medium borders
@@ -122,15 +125,15 @@ begin
   MyWorksheet.WriteBorderLineStyle(5, 14, cbWest, lsDouble);
 
   // Word-wrapped long text in D7
-  MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.');
+  MyWorksheet.WriteText(6, 3, 'This is a very, very, very, very long wrapped text.');
   MyWorksheet.WriteUsedFormatting(6, 3, [uffWordwrap]);
 
   // Cell with changed font in D8
-  MyWorksheet.WriteUTF8Text(7, 3, 'This is 16pt red bold & italic Times New Roman.');
+  MyWorksheet.WriteText(7, 3, 'This is 16pt red bold & italic Times New Roman.');
   Myworksheet.WriteFont(7, 3, 'Times New Roman', 16, [fssBold, fssItalic], scRed);
 
   // Cell with changed font and background in D9 and comment
-  MyWorksheet.WriteUTF8Text(8, 3, 'Colors...');
+  MyWorksheet.WriteText(8, 3, 'Colors...');
   MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
   MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
 //  MyWorksheet.WriteComment(8, 3, 'This is font "Courier New", Size 12.');
@@ -174,46 +177,46 @@ begin
     nil)))));
 
   r := 10;
-  MyWorksheet.WriteUTF8Text(r, 0, 'Writing current date/time:');
+  MyWorksheet.WriteText(r, 0, 'Writing current date/time:');
   inc(r, 2);
   // Write current date/time to cells B11:B16
-  MyWorksheet.WriteUTF8Text(r, 0, '(default format)');
+  MyWorksheet.WriteText(r, 0, '(default format)');
   MyWorksheet.WriteDateTime(r, 1, now);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate');
+  MyWorksheet.WriteText(r, 0, 'nfShortDate');
   MyWorksheet.WriteDateTime(r, 1, now, nfShortDate);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfLongDate');
+  MyWorksheet.WriteText(r, 0, 'nfLongDate');
   MyWorksheet.WriteDateTime(r, 1, now, nfLongDate);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTime');
+  MyWorksheet.WriteText(r, 0, 'nfShortTime');
   MyWorksheet.WriteDateTime(r, 1, now, nfShortTime);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfLongTime');
+  MyWorksheet.WriteText(r, 0, 'nfLongTime');
   MyWorksheet.WriteDateTime(r, 1, now, nfLongTime);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDateTime');
+  MyWorksheet.WriteText(r, 0, 'nfShortDateTime');
   MyWorksheet.WriteDateTime(r, 1, now, nfShortDateTime);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''dd/mmm''');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, ''dd/mmm''');
   MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'dd/mmm');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''MMM/YY''');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, ''MMM/YY''');
   MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mmm/yy');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTimeAM');
+  MyWorksheet.WriteText(r, 0, 'nfShortTimeAM');
   MyWorksheet.WriteDateTime(r, 1, now, nfShortTimeAM);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfLongTimeAM');
+  MyWorksheet.WriteText(r, 0, 'nfLongTimeAM');
   MyWorksheet.WriteDateTime(r, 1, now, nfLongTimeAM);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss''');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, ''mm:ss''');
   MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss.z''');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, ''mm:ss.z''');
   MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.z');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mm:ss.zzz''');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, ''mm:ss.zzz''');
   MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.zzz');
 
   // Write formatted numbers
@@ -221,88 +224,88 @@ begin
   val(s, number, i);
 
   inc(r, 2);
-  MyWorksheet.WriteUTF8Text(r, 0, 'The number '+s+' is displayed in various formats:');
+  MyWorksheet.WriteText(r, 0, 'The number '+s+' is displayed in various formats:');
   inc(r,2);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfGeneral');
+  MyWorksheet.WriteText(r, 0, 'nfGeneral');
   MyWorksheet.WriteNumber(r, 1, number, nfGeneral);
   MyWorksheet.WriteNumber(r, 2, -number, nfGeneral);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 0 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixed, 0 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixed, 0);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 0);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 1 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixed, 1 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixed, 1);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 1);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 2 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixed, 2 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixed, 2);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 2);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 3 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixed, 3 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixed, 3);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 3);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 0 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixedTh, 0 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 0);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 0);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 1 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixedTh, 1 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 1);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 1);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 2 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixedTh, 2 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 2);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 2);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 3 decs');
+  MyWorksheet.WriteText(r, 0, 'nfFixedTh, 3 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 3);
   MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 3);
   inc(r,2);
 
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 0 dec');
+  MyWorksheet.WriteText(r, 0, 'nfExp, 0 dec');
   MyWorksheet.WriteNumber(r, 1, number, nfExp, 0);
   MyWorksheet.WriteNumber(r, 2, -number, nfExp, 0);
   MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 0);
   MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 0);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 1 dec');
+  MyWorksheet.WriteText(r, 0, 'nfExp, 1 dec');
   MyWorksheet.WriteNumber(r, 1, number, nfExp, 1);
   MyWorksheet.WriteNumber(r, 2, -number, nfExp, 1);
   MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 1);
   MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 1);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 2 decs');
+  MyWorksheet.WriteText(r, 0, 'nfExp, 2 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfExp, 2);
   MyWorksheet.WriteNumber(r, 2, -number, nfExp, 2);
   MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 2);
   MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 2);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 3 decs');
+  MyWorksheet.WriteText(r, 0, 'nfExp, 3 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfExp, 3);
   MyWorksheet.WriteNumber(r, 2, -number, nfExp, 3);
   MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 3);
   MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 3);
   inc(r,2);
 
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrency, 0 decs');
+  MyWorksheet.WriteText(r, 0, 'nfCurrency, 0 decs');
   MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, 'USD');
   MyWorksheet.WriteCurrency(r, 2, -number, nfCurrency, 0, 'USD');
   MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrency, 0, 'USD');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrencyRed, 0 decs');
+  MyWorksheet.WriteText(r, 0, 'nfCurrencyRed, 0 decs');
   MyWorksheet.WriteCurrency(r, 1, number, nfCurrencyRed, 0, 'USD');
   MyWorksheet.WriteCurrency(r, 2, -number, nfCurrencyRed, 0, 'USD');
   MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrencyRed, 0, 'USD');
 
   inc(r,2);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)');
   MyWorksheet.WriteNumber(r, 1, number);
   MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"EUR "#,##0_);("EUR "#,##0)');
   MyWorksheet.WriteNumber(r, 2, -number);
   MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"EUR "#,##0_);("EUR "#,##0)');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)');
+  MyWorksheet.WriteText(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)');
   MyWorksheet.WriteNumber(r, 1, number);
   MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)');
   MyWorksheet.WriteNumber(r, 2, -number);
@@ -310,61 +313,61 @@ begin
 
   inc(r, 2);
   number := 1.333333333;
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 0 decs');
+  MyWorksheet.WriteText(r, 0, 'nfPercentage, 0 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 0);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 1 decs');
+  MyWorksheet.WriteText(r, 0, 'nfPercentage, 1 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 1);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 2 decs');
+  MyWorksheet.WriteText(r, 0, 'nfPercentage, 2 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 2);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 3 decs');
+  MyWorksheet.WriteText(r, 0, 'nfPercentage, 3 decs');
   MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 3);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval Default=[h]:mm:ss');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval Default=[h]:mm:ss');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval);
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m:s');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, h:m:s');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m:s');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:m:s');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]:m:s');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:m:s');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:n:s');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]:n:s');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:n:s');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [hh]:mm');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [hh]:mm');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[hh]:mm');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [hh]:nn');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [hh]:nn');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[hh]:nn');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval [h]:m');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval [h]:m');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:m');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]:n');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]:n');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]:n');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [h]');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [h]');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[h]');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [m]:s');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [m]:s');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[m]:s');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, m:s');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, m:s');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'm:s');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [mm]:ss');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [mm]:ss');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[mm]:ss');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [ss]');
+  MyWorksheet.WriteText(r, 0, 'nfTimeInterval, [ss]');
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[ss]');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, ??/??');
+  MyWorksheet.WriteText(r, 0, 'nfFraction, ??/??');
   Myworksheet.WriteNumber(r, 1, number, nfFraction, '??/??');
   inc(r);
-  MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, # ??/??');
+  MyWorksheet.WriteText(r, 0, 'nfFraction, # ??/??');
   Myworksheet.WriteNumber(r, 1, number, nfFraction, '# ??/??');
 
   // Set width of columns 0, 1 and 5
@@ -384,10 +387,10 @@ begin
   MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
 
   // Write some string cells
-  MyWorksheet.WriteUTF8Text(0, 0, Str_First);
+  MyWorksheet.WriteText(0, 0, Str_First);
-  MyWorksheet.WriteUTF8Text(0, 1, Str_Second);
+  MyWorksheet.WriteText(0, 1, Str_Second);
-  MyWorksheet.WriteUTF8Text(0, 2, Str_Third);
+  MyWorksheet.WriteText(0, 2, Str_Third);
-  MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth);
+  MyWorksheet.WriteText(0, 3, Str_Fourth);
   MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation);
   MyWorksheet.WriteFontStyle(0, 1, [fssBold]);
 

components/fpspreadsheet/fpshtml.pas

@@ -162,8 +162,6 @@ begin
 end;
 
 destructor TsHTMLReader.Destroy;
-var
-  i: Integer;
 begin
   FreeAndNil(FFontStack);
   FreeAndNil(FCurrFont);

components/fpspreadsheet/fpshtmlutils.pas

@@ -5,7 +5,7 @@ unit fpsHTMLUtils;
 interface
 
 uses
-  Classes, SysUtils, contnrs;
+  Classes, SysUtils, contnrs, fpstypes, fpspreadsheet;
 
 type
   TsHTMLEntity = record
@@ -36,12 +36,15 @@ type
     property Items[AIndex: Integer]: TsHTMLAttr read GetItem write SetItem; default;
   end;
 
+procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont;
+  const AHTMLText: String; out APlainText: String;
+  out ARichTextParams: TsRichTextParams);
 
 implementation
 
 uses
-  Strings,
+  math, Strings, lazUtf8, fasthtmlparser,
-  fpsUtils;
+  fpsUtils, fpsClasses;
 
 const
   // http://unicode.e-workers.de/entities.php
@@ -570,5 +573,343 @@ begin
 end;
 
 
+{==============================================================================}
+{                         HTML-to-Rich-text conversion                         }
+{==============================================================================}
+type
+  TsHTMLAnalyzer = class(THTMLParser)
+  private
+    FWorkbook: TsWorkbook;
+    FPlainText: String;
+    FRichTextParams: TsRichTextParams;
+    FAttrList: TsHTMLAttrList;
+    FFontStack: TsIntegerStack;
+    FCurrFont: TsFont;
+    FPointSeparatorSettings: TFormatSettings;
+    function AddFont(AFont: TsFont): Integer;
+    procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1);
+    procedure ProcessFontRestore;
+    procedure ReadFont(AFont: TsFont);
+    procedure TagFoundHandler(NoCaseTag, ActualTag: string);
+    procedure TextFoundHandler(AText: string);
+  public
+    constructor Create(AWorkbook: TsWorkbook; AFont: TsFont; AText: String);
+    destructor Destroy; override;
+    property PlainText: String read FPlainText;
+    property RichTextParams: TsRichTextParams read FRichTextParams;
+  end;
+
+constructor TsHTMLAnalyzer.Create(AWorkbook: TsWorkbook; AFont: TsFont;
+  AText: String);
+begin
+  if AWorkbook = nil then
+    raise Exception.Create('[TsHTMLAnalyzer.Create] Workbook required.');
+  if AFont = nil then
+    raise Exception.Create('[TsHTMLAnalyzer.Create] Font required.');
+
+  inherited Create(AText);
+  FWorkbook := AWorkbook;
+
+  OnFoundTag := @TagFoundHandler;
+  OnFoundText := @TextFoundHandler;
+
+  FPlainText := '';
+  SetLength(FRichTextParams, 0);
+
+  FAttrList := TsHTMLAttrList.Create;
+  FCurrFont := TsFont.Create;
+  FCurrFont.CopyOf(AFont);
+
+  FFontStack := TsIntegerStack.Create;
+
+  FPointSeparatorSettings := DefaultFormatSettings;
+  FPointSeparatorSettings.DecimalSeparator := '.';
+end;
+
+destructor TsHTMLAnalyzer.Destroy;
+begin
+  FreeAndNil(FFontStack);
+  FreeAndNil(FCurrFont);
+  FreeAndNil(FAttrList);
+  inherited Destroy;
+end;
+
+{ Stores a font in the workbook's font list. Does not allow duplicates. }
+function TsHTMLAnalyzer.AddFont(AFont: TsFont): Integer;
+const
+  EPS = 1e-3;
+var
+  i: Integer;
+  fnt: TsFont;
+begin
+  // Is the font already stored in the workbook's font list?
+  Result := FWorkbook.FindFont(AFont.FontName, AFont.Size, AFont.Style, AFont.Color, AFont.Position);
+  if Result = -1 then
+  begin
+    // No. Create a new font, add it to the list, and return the new index.
+    fnt := TsFont.Create;
+    fnt.CopyOf(AFont);
+    Result := FWorkbook.AddFont(fnt);
+  end;
+end;
+
+procedure TsHTMLAnalyzer.AddRichTextParam(AFont: TsFont;
+  AHyperlinkIndex: Integer = -1);
+var
+  len: Integer;
+  fntIndex: Integer;
+  n: Integer;
+begin
+  n := Length(FRichTextParams);
+  len := UTF8Length(FPlainText);
+  fntIndex := AddFont(AFont);
+  if (n > 0) and (FRichTextparams[n-1].FirstIndex = len+1) then
+  begin
+    // Avoid adding another rich-text parameter for the same text location:
+    // Update the previous one
+    FRichTextParams[n-1].FontIndex := fntIndex;
+    FRichTextParams[n-1].HyperlinkIndex := AHyperlinkIndex;
+  end else
+  begin
+    // Add a new rich-text parameter
+    SetLength(FRichTextParams, n+1);
+    FRichTextParams[n].FirstIndex := len + 1;
+    FRichTextParams[n].FontIndex := fntIndex;
+    FRichTextParams[n].HyperlinkIndex := AHyperlinkIndex;
+  end;
+end;
+
+procedure TsHTMLAnalyzer.ProcessFontRestore;
+var
+  fntIndex: Integer;
+begin
+  fntIndex := FFontStack.Pop;
+  if fntIndex > -1 then
+  begin
+    FCurrFont.CopyOf(FWorkbook.GetFont(fntIndex));
+    AddRichTextParam(FCurrFont);
+  end;
+end;
+
+procedure TsHTMLAnalyzer.ReadFont(AFont: TsFont);
+const
+  FACTOR = 1.2;
+  MIN_FONTSIZE = 6;
+var
+  idx: Integer;
+  L: TStringList;
+  i, ip, im: Integer;
+  s: String;
+  f: Double;
+  defFntSize: Single;
+begin
+  idx := FAttrList.IndexOfName('font-family');    // style tag
+  if idx = -1 then
+    idx := FAttrList.IndexOfName('face');         // html tag
+  if idx > -1 then begin
+    L := TStringList.Create;
+    try
+      L.StrictDelimiter := true;
+      L.DelimitedText := FAttrList[idx].Value;
+      AFont.FontName := L[0];
+    finally
+      L.Free;
+    end;
+  end;
+
+  idx := FAttrList.IndexOfName('font-size');
+  if idx = -1 then
+    idx := FAttrList.IndexOfName('size');
+  if idx > -1 then begin
+    defFntSize := FWorkbook.GetDefaultFont.Size;
+    s := FAttrList[idx].Value;
+    case s of
+      'medium',   '3' : AFont.Size := defFntSize;
+      'large',    '4' : AFont.Size := defFntSize*FACTOR;
+      'x-large',  '5' : AFont.Size := defFntSize*FACTOR*FACTOR;
+      'xx-large', '6' : AFont.Size := defFntSize*FACTOR*FACTOR*FACTOR;
+      'small',    '2' : AFont.Size := Max(MIN_FONTSIZE, defFntSize/FACTOR);
+      'x-small'       : AFont.Size := Max(MIN_FONTSIZE, defFntSize/FACTOR/FACTOR);
+      'xx-small', '1' : AFont.Size := Max(MIN_FONTSIZE, defFntSize/FACTOR/FACTOR/FACTOR);
+      'larger'        : AFont.Size := AFont.Size * FACTOR;
+      'smaller'       : AFont.Size := Max(MIN_FONTSIZE, AFont.Size / FACTOR);
+      else
+        if s[1] in ['+', '-'] then
+        begin
+          TryStrToInt(s, i);
+          AFont.Size := defFntSize * IntPower(FACTOR, i);
+        end else
+        begin
+          i := 0;
+          im := 0;
+          ip := pos('%', s);
+          if ip = 0 then begin
+            im := pos('rem', s);
+            if im = 0 then
+              im := pos('em', s);
+          end;
+          if (ip > 0) then i := ip else
+            if (im > 0) then i := im;
+          if i > 0 then
+          begin
+            s := copy(s, 1, i-1);
+            if TryStrToFloat(s, f, FPointSeparatorSettings) then
+            begin
+              if ip > 0 then f := f * 0.01;
+              AFont.Size := Max(MIN_FONTSIZE, abs(f) * defFntSize);
+            end;
+          end else
+            AFont.Size := Max(MIN_FONTSIZE, HTMLLengthStrToPts(s));
+        end;
+    end;
+  end;
+
+  idx := FAttrList.IndexOfName('font-style');
+  if idx > -1 then
+    case FAttrList[idx].Value of
+      'normal'  : Exclude(AFont.Style, fssItalic);
+      'italic'  : Include(AFont.Style, fssItalic);
+      'oblique' : Include(AFont.Style, fssItalic);
+    end;
+
+  idx := FAttrList.IndexOfName('font-weight');
+  if idx > -1 then
+  begin
+    s := FAttrList[idx].Value;
+    if TryStrToInt(s, i) and (i >= 700) then Include(AFont.Style, fssBold);
+  end;
+
+  idx := FAttrList.IndexOfName('text-decoration');
+  if idx > -1 then
+  begin
+    s := FAttrList[idx].Value;
+    if pos('underline', s) <> 0 then Include(AFont.Style, fssUnderline);
+    if pos('line-through', s) <> 0 then Include(AFont.Style, fssStrikeout);
+  end;
+
+  idx := FAttrList.IndexOfName('color');
+  if idx > -1 then
+    AFont.Color := HTMLColorStrToColor(FAttrList[idx].Value);
+end;
+
+procedure TsHTMLAnalyzer.TagFoundHandler(NoCaseTag, ActualTag: String);
+begin
+  case NoCaseTag[2] of
+    'B': case NoCaseTag of
+           '<B>'  : begin
+                      FFontStack.Push(AddFont(FCurrFont));
+                      Include(FCurrFont.Style, fssBold);
+                      AddRichTextParam(FCurrFont);
+                    end;
+           '<BR>',
+           '<BR/>': FPlainText := FPlainText + FPS_LINE_ENDING;
+           else     if (pos('<BR ', NoCaseTag) = 1) then
+                      FPlainText := FPlainText + FPS_LINE_ENDING;
+         end;
+    'D': if (NoCaseTag = '<DEL>') then
+         begin
+           FFontStack.Push(AddFont(FCurrFont));
+           Include(FCurrFont.Style, fssStrikeout);
+           AddRichTextParam(FCurrFont);
+         end;
+    'E': if (NoCaseTag = '<EM>') then
+         begin
+           FFontStack.Push(AddFont(FCurrFont));
+           Include(FCurrFont.Style, fssItalic);
+           AddRichTextParam(FCurrFont);
+         end;
+    'F': if (pos('<FONT ', NoCaseTag) = 1) then
+         begin
+           FFontStack.Push(AddFont(FCurrFont));
+           FAttrList.Parse(ActualTag);
+           ReadFont(FCurrFont);
+           AddRichTextparam(FCurrFont);
+         end;
+    'I': case NoCaseTag of
+           '<I>'  : begin
+                      FFontStack.Push(AddFont(FCurrFont));
+                      Include(FCurrFont.Style, fssItalic);
+                      AddRichTextParam(FCurrFont);
+                    end;
+           '<INS>': begin
+                      FFontStack.Push(AddFont(FCurrFont));
+                      Include(FCurrFont.Style, fssUnderline);
+                      AddRichTextParam(FCurrFont);
+                    end;
+         end;
+    'S': case NoCaseTag of
+           '<S>'  : begin
+                      FFontStack.Push(AddFont(FCurrFont));
+                      Include(FCurrFont.Style, fssStrikeout);
+                      AddRichTextParam(FCurrFont);
+                    end;
+           '<STRONG>':begin
+                       FFontStack.Push(AddFont(FCurrFont));
+                       Include(FCurrFont.Style, fssBold);
+                       AddRichTextParam(FCurrFont);
+                    end;
+           '<SUB>': begin
+                      FFontStack.Push(AddFont(FCurrFont));
+                      FCurrFont.Position := fpSubscript;
+                      AddRichTextParam(FCurrFont);
+                    end;
+           '<SUP>': begin
+                      FFontStack.Push(AddFont(FCurrFont));
+                      FCurrFont.Position := fpSuperscript;
+                      AddRichTextParam(FCurrFont);
+                    end;
+         end;
+    'U': if (NoCaseTag = '<U>') then
+         begin
+           FFontStack.Push(AddFont(FCurrFont));
+           Include(FCurrFont.Style, fssUnderline);
+           AddRichTextParam(FCurrFont);
+         end;
+    '/': case NoCaseTag[3] of
+           'B': if (NoCaseTag) = '</B>' then ProcessFontRestore;
+           'D': if (NoCaseTag) = '</DEL>' then ProcessFontRestore;
+           'E': if (NoCaseTag) = '</EM>' then ProcessFontRestore;
+           'F': if (NoCaseTag) = '</FONT>' then ProcessFontRestore;
+           'I': if (NoCaseTag = '</I>') or (NoCaseTag = '</INS>') then ProcessFontRestore;
+           'S': if (NoCaseTag = '</S>') or (NoCaseTag = '</STRONG>') or
+                   (NoCaseTag = '</SUB>') or (NoCaseTag = '</SUP>') then ProcessFontRestore;
+           'U': if (NoCaseTag = '</U>') then ProcessFontRestore;
+         end;
+  end;
+end;
+
+procedure TsHTMLAnalyzer.TextFoundHandler(AText: String);
+begin
+  AText := CleanHTMLString(AText);
+  if AText <> '' then
+  begin
+    if FPlainText = '' then
+      FPlainText := AText
+    else
+      FPlainText := FPlainText + AText;
+  end;
+end;
+
+
+
+procedure HTMLToRichText(AWorkbook: TsWorkbook; AFont: TsFont;
+  const AHTMLText: String; out APlainText: String;
+  out ARichTextParams: TsRichTextParams);
+var
+  analyzer: TsHTMLAnalyzer;
+  j: Integer;
+begin
+  analyzer := TsHTMLAnalyzer.Create(AWorkbook, AFont, AHTMLText + '<end>');
+  try
+    analyzer.Exec;
+    APlainText := analyzer.PlainText;
+    SetLength(ARichTextParams, Length(analyzer.RichTextParams));
+    for j:=0 to High(ARichTextParams) do
+      ARichTextParams[j] := analyzer.RichTextParams[j];
+  finally
+    analyzer.Free;
+  end;
+end;
+
 end.
 

components/fpspreadsheet/fpspreadsheet.pas

@@ -174,9 +174,12 @@ type
     procedure UpdateCaches;
 
     { Reading of values }
-    function  ReadAsUTF8Text(ARow, ACol: Cardinal): string; overload;
+    function  ReadAsText(ARow, ACol: Cardinal): string; overload;
-    function  ReadAsUTF8Text(ACell: PCell): string; overload;
+    function  ReadAsText(ACell: PCell): string; overload;
-    function  ReadAsUTF8Text(ACell: PCell; AFormatSettings: TFormatSettings): string; overload;
+    function  ReadAsText(ACell: PCell; AFormatSettings: TFormatSettings): string; overload;
+    function  ReadAsUTF8Text(ARow, ACol: Cardinal): string; overload; deprecated 'Use ReadAsText';
+    function  ReadAsUTF8Text(ACell: PCell): string; overload; deprecated 'Use ReadAsText';
+    function  ReadAsUTF8Text(ACell: PCell; AFormatSettings: TFormatSettings): string; overload; deprecated 'Use ReadAsText';
     function  ReadAsNumber(ARow, ACol: Cardinal): Double; overload;
     function  ReadAsNumber(ACell: PCell): Double; overload;
     function  ReadAsDateTime(ARow, ACol: Cardinal; out AResult: TDateTime): Boolean; overload;
@@ -263,10 +266,17 @@ type
     procedure WriteRPNFormula(ACell: PCell;
       AFormula: TsRPNFormula); overload;
 
-    function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring;
+    function WriteText(ARow, ACol: Cardinal; AText: String;
       ARichTextParams: TsRichTextParams = nil): PCell; overload;
-    procedure WriteUTF8Text(ACell: PCell; AText: String;
+    procedure WriteText(ACell: PCell; AText: String;
       ARichTextparams: TsRichTextParams = nil); overload;
+    function WriteTextAsHTML(ARow, ACol: Cardinal; AText: String): PCell; overload;
+    procedure WriteTextAsHTML(ACell: PCell; AText: String); overload;
+
+    function WriteUTF8Text(ARow, ACol: Cardinal; AText: String;
+      ARichTextParams: TsRichTextParams = nil): PCell; overload; deprecated 'Use WriteText';
+    procedure WriteUTF8Text(ACell: PCell; AText: String;
+      ARichTextparams: TsRichTextParams = nil); overload; deprecated 'Use WriteText';
 
     { Writing of cell attributes }
     function WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle;
@@ -826,7 +836,7 @@ implementation
 uses
   Math, StrUtils, DateUtils, TypInfo, lazutf8, lazFileUtils, URIParser, RegExpr,
   fpsStrings, uvirtuallayer_ole,
-  fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
+  fpsUtils, fpsHTMLUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
   fpsNumFormatParser;
 
 (*
@@ -1481,7 +1491,7 @@ begin
   // Detect whether the cell already has a hyperlink, but has no other content.
   if HasHyperlink(ACell) then
     noCellText := (ACell^.ContentType = cctUTF8String) and
-      (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsUTF8Text(ACell));
+      (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsText(ACell));
 
   // Attach the hyperlink to the cell
   FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip);
@@ -2085,7 +2095,7 @@ begin
   Result := 0;
   if (ACell <> nil) and (ACell^.ContentType = cctNumber) then
   begin
-    s := ReadAsUTF8Text(ACell);
+    s := ReadAsText(ACell);
     p := pos(Workbook.FormatSettings.DecimalSeparator, s);
     if p > 0 then
     begin
@@ -2367,9 +2377,14 @@ end;
   @param  ACol      The column of the cell
   @return The text representation of the cell
 -------------------------------------------------------------------------------}
-function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): string; //ansistring;
+function TsWorksheet.ReadAsText(ARow, ACol: Cardinal): string;
 begin
-  Result := ReadAsUTF8Text(GetCell(ARow, ACol));
+  Result := ReadAsText(GetCell(ARow, ACol));
+end;
+
+function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): string;
+begin
+  Result := ReadAsText(GetCell(ARow, ACol));
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -2381,9 +2396,14 @@ end;
   @param  ACell     Pointer to the cell
   @return The text representation of the cell
 -------------------------------------------------------------------------------}
-function TsWorksheet.ReadAsUTF8Text(ACell: PCell): string; //ansistring;
+function TsWorksheet.ReadAsText(ACell: PCell): string;
 begin
-  Result := ReadAsUTF8Text(ACell, FWorkbook.FormatSettings);
+  Result := ReadAsText(ACell, FWorkbook.FormatSettings);
+end;
+
+function TsWorksheet.ReadAsUTF8Text(ACell: PCell): string;
+begin
+  Result := ReadAsText(ACell, FWorkbook.FormatSettings);
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -2397,7 +2417,7 @@ end;
                            of numbers and date/times.
   @return The text representation of the cell
 -------------------------------------------------------------------------------}
-function TsWorksheet.ReadAsUTF8Text(ACell: PCell;
+function TsWorksheet.ReadAsText(ACell: PCell;
   AFormatSettings: TFormatSettings): string;
 var
   fmt: PsCellFormat;
@@ -2464,6 +2484,12 @@ begin
     end;
 end;
 
+function TsWorksheet.ReadAsUTF8Text(ACell: PCell;
+  AFormatSettings: TFormatSettings): string;
+begin
+  Result := ReadAsText(ACell, AFormatSettings);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Returns the value of a cell as a number.
 
@@ -3563,7 +3589,7 @@ var
   var
     txt: String;
   begin
-    txt := ReadAsUTF8Text(ACell);
+    txt := ReadAsText(ACell);
     if (soRegularExpr in AOptions) then
       Result := regex.Exec(txt)
     else
@@ -3753,19 +3779,23 @@ end;
   @see    TsRichTextParams
   @see    TsRichTextParam
 -------------------------------------------------------------------------------}
-function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring;
+function TsWorksheet.WriteText(ARow, ACol: Cardinal; AText: String;
   ARichTextParams: TsRichTextParams = nil): PCell;
 begin
   Result := GetCell(ARow, ACol);
-  WriteUTF8Text(Result, AText, ARichTextParams);
+  WriteText(Result, AText, ARichTextParams);
+end;
+
+function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: String;
+  ARichTextParams: TsRichTextParams = nil): PCell;
+begin
+  Result := GetCell(ARow, ACol);
+  WriteText(Result, AText, ARichTextParams);
 end;
 
 {@@ ----------------------------------------------------------------------------
   Writes UTF-8 encoded text to a cell.
 
-  On formats that don't support unicode, the text will be converted
-  to ISO Latin 1.
-
   @param  ACell            Pointer to the cell
   @param  AText            The text to be written encoded in utf-8
   @param  ARichTextParams  Array of formatting instructions for characters or
@@ -3774,7 +3804,7 @@ end;
   @see    TsRichTextParams
   @see    TsRichTextParam
 -------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String;
+procedure TsWorksheet.WriteText(ACell: PCell; AText: String;
   ARichTextParams: TsRichTextParams = nil);
 var
   r, c: Cardinal;
@@ -3823,6 +3853,71 @@ begin
   ChangedCell(ACell^.Row, ACell^.Col);
 end;
 
+procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String;
+  ARichTextParams: TsRichTextParams = nil);
+begin
+  WriteText(ACell, AText, ARichTextParams);
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Writes text containing HTML codes to a cell. Here are the allowed HTML codes:
+    <b>, <strong>  ... bold text
+    <i>, <em> ........ italic text
+    <u>, <ins> ....... underlined text
+    <s>, <del> ....... strike-out text
+    <sub> ............ subscript
+    <sup> ............ superscript
+    <font tags> ...... full font selection. "tags" can be:
+                       face="..." ... font name
+                       size="..." ... font size, in pt, em, px, % (add units!)
+                       color="..." .. font color (e.g. red, or #FF0000).
+
+  @param  ARow         The row of the cell
+  @param  ACol         The column of the cell
+  @param  AText        The text containing the html codes
+
+  @return Pointer to cell created or used
+
+  @see    TsRichTextParams
+  @see    TsRichTextParam
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteTextAsHTML(ARow, ACol: Cardinal; AText: String): PCell;
+begin
+  Result := GetCell(ARow, ACol);
+  WriteTextAsHTML(Result, AText);
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Writes text containing HTML codes to a cell. Here are the allowed HTML codes:
+    <b>, <strong>  ... bold text
+    <i>, <em> ........ italic text
+    <u>, <ins> ....... underlined text
+    <s>, <del> ....... strike-out text
+    <sub> ............ subscript
+    <sup> ............ superscript
+    <font tags> ...... full font selection. "tags" can be:
+                       face="..." ... font name
+                       size="..." ... font size, in pt, em, px, % (add units!)
+                       color="..." .. font color (e.g. red, or #FF0000).
+
+  @param  ACell        Pointer to the cell
+  @param  AText        The text containing the html codes
+
+  @see    TsRichTextParams
+  @see    TsRichTextParam
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.WriteTextAsHTML(ACell: PCell; AText: String);
+var
+  plainText: String;
+  rtParams: TsRichTextParams;
+begin
+  if ACell = nil then
+    exit;
+
+  HTMLToRichText(FWorkbook, ReadCellFont(ACell), AText, plainText, rtParams);
+  WriteText(ACell, plainText, rtParams);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Writes a floating-point number to a cell, does not change the number format