fpspreadsheet: Excel 2003/XML reader supports rich-text formatting.

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

components/fpspreadsheet/source/common/fpshtmlutils.pas

@@ -41,7 +41,7 @@ type
 
 procedure HTMLToRichText(AWorkbook: TsBasicWorkbook; AFont: TsFont;
   const AHTMLText: String; out APlainText: String;
-  out ARichTextParams: TsRichTextParams);
+  out ARichTextParams: TsRichTextParams; APrefix: String = '');
 
 procedure RichTextToHTML(AWorkbook: TsBasicWorkbook; AFont: TsFont;
   const APlainText: String; const ARichTextParams: TsRichTextParams;
@@ -623,6 +623,7 @@ type
     FCurrFont: TsFont;
     FPointSeparatorSettings: TFormatSettings;
     FPreserveSpaces: Boolean;
+    FPrefix: String;
     function AddFont(AFont: TsFont): Integer;
     procedure AddRichTextParam(AFont: TsFont; AHyperlinkIndex: Integer = -1);
     procedure ProcessFontRestore;
@@ -633,6 +634,7 @@ type
     constructor Create(AWorkbook: TsWorkbook; AFont: TsFont; AText: String);
     destructor Destroy; override;
     property PlainText: String read FPlainText;
+    property Prefix: String read FPrefix write FPrefix;
     property RichTextParams: TsRichTextParams read FRichTextParams;
     property PreserveSpaces: Boolean read FPreserveSpaces write FPreserveSpaces;
   end;
@@ -738,9 +740,9 @@ var
   f: Double;
   defFntSize: Single;
 begin
-  idx := FAttrList.IndexOfName('font-family');    // style tag
+  idx := FAttrList.IndexOfName(FPrefix + 'font-family');    // style tag
   if idx = -1 then
-    idx := FAttrList.IndexOfName('face');         // html tag
+    idx := FAttrList.IndexOfName(FPrefix + 'face');         // html tag
   if idx > -1 then begin
     L := TStringList.Create;
     try
@@ -752,9 +754,9 @@ begin
     end;
   end;
 
-  idx := FAttrList.IndexOfName('font-size');
+  idx := FAttrList.IndexOfName(FPrefix + 'font-size');
   if idx = -1 then
-    idx := FAttrList.IndexOfName('size');
+    idx := FAttrList.IndexOfName(FPrefix + 'size');
   if idx > -1 then begin
     defFntSize := FWorkbook.GetDefaultFont.Size;
     s := FAttrList[idx].Value;
@@ -799,7 +801,7 @@ begin
     end;
   end;
 
-  idx := FAttrList.IndexOfName('font-style');
+  idx := FAttrList.IndexOfName(FPrefix + 'font-style');
   if idx > -1 then
     case FAttrList[idx].Value of
       'normal'  : Exclude(AFont.Style, fssItalic);
@@ -807,14 +809,14 @@ begin
       'oblique' : Include(AFont.Style, fssItalic);
     end;
 
-  idx := FAttrList.IndexOfName('font-weight');
+  idx := FAttrList.IndexOfName(FPrefix + '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');
+  idx := FAttrList.IndexOfName(FPrefix + 'text-decoration');
   if idx > -1 then
   begin
     s := FAttrList[idx].Value;
@@ -822,7 +824,7 @@ begin
     if pos('line-through', s) <> 0 then Include(AFont.Style, fssStrikeout);
   end;
 
-  idx := FAttrList.IndexOfName('color');
+  idx := FAttrList.IndexOfName(FPrefix + 'color');
   if idx > -1 then
     AFont.Color := HTMLColorStrToColor(FAttrList[idx].Value);
 end;
@@ -942,7 +944,7 @@ end;
 -------------------------------------------------------------------------------}
 procedure HTMLToRichText(AWorkbook: TsBasicWorkbook; AFont: TsFont;
   const AHTMLText: String; out APlainText: String;
-  out ARichTextParams: TsRichTextParams);
+  out ARichTextParams: TsRichTextParams; APrefix: String = '');
 var
   analyzer: TsHTMLAnalyzer;
   j: Integer;
@@ -952,6 +954,7 @@ begin
   analyzer := TsHTMLAnalyzer.Create(AWorkbook as TsWorkbook, AFont, AHTMLText + '<end>');
   try
     analyzer.PreserveSpaces := true;
+    analyzer.Prefix := APrefix;
     analyzer.Exec;
     APlainText := analyzer.PlainText;
     nrtp := Length(analyzer.RichTextParams);

components/fpspreadsheet/source/common/xlsxml.pas

@@ -195,6 +195,33 @@ begin
   end;
 end;
 
+{ Helper routine to rebuild the html content of the "ss:Data" nodes }
+procedure RebuildChildNodes(ANode: TDOMNode; var AText: String);
+var
+  nodeName: String;
+  s: String;
+  i: Integer;
+begin
+  if ANode = nil then
+    exit;
+  while ANode <> nil do begin
+    nodeName := ANode.NodeName;
+    if nodeName = '#text' then
+      AText := AText + ANode.NodeValue
+    else begin
+      s := '';
+      for i := 0 to ANode.Attributes.Length-1 do
+        s := Format('%s %s="%s"', [s, ANode.Attributes.Item[i].NodeName, ANode.Attributes.Item[i].NodeValue]);
+      AText := Format('%s<%s%s>', [AText, nodeName, s]);
+      s := '';
+      RebuildChildNodes(ANode.FirstChild, s);
+      if s <> '' then
+        AText := Format('%s%s</%s>', [AText, s, nodeName]);
+    end;
+    ANode := ANode.NextSibling;
+  end;
+end;
+
 
 {===============================================================================
                           TsSpreadExcelXMLReader
@@ -414,12 +441,15 @@ var
   sheet: TsWorksheet absolute AWorksheet;
   nodeName: string;
   s, st, sv: String;
+  txt: String;
   node: TDOMNode;
   err: TsErrorValue;
   cell: PCell;
   fmt: TsCellFormat;
   idx: Integer;
   mergedCols, mergedRows: Integer;
+  font: TsFont;
+  rtp: TsRichTextParams;
 begin
   if ANode = nil then
     exit;
@@ -429,6 +459,7 @@ begin
 
   cell := sheet.GetCell(ARow, ACol);
   book := TsWorkbook(FWorkbook);
+  font := book.GetDefaultFont;
 
   s := GetAttrValue(ANode, 'ss:StyleID');
   if s <> '' then begin
@@ -436,6 +467,7 @@ begin
     if idx <> -1 then begin
       fmt := FCellFormatList.Items[idx]^;
       cell^.FormatIndex := book.AddCellFormat(fmt);
+      font := book.GetFont(fmt.FontIndex);;
     end;
   end;
 
@@ -499,6 +531,11 @@ begin
               if TryStrToErrorValue(sv, err) then
                 sheet.WriteErrorValue(cell, err);
           end;
+          if nodeName = 'ss:Data' then begin
+            txt := '';
+            RebuildChildNodes(node, txt);
+            HTMLToRichText(FWorkbook, font, txt, s, cell^.RichTextParams, 'html:');
+          end;
         end
         else
         if (nodeName = 'Comment') then