fpspreadsheet: A bunch of updates have run up...

- Activate ReadFromStream from xls5/8, xlsx, and ods readers (issue #0028389)
- Fix ods using correct hyperlink font
- Rich text formatting runs for xls5/8, xlsx, ods (both reading and writing)
- BIFFExplorer: show details of rich-text formatting runs for SST and RSTRING records

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

components/fpspreadsheet/fpolebasic.pas

@@ -35,6 +35,7 @@ type
   public
     procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: UTF8String='Book');
     procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
+    procedure ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
     procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument);
   end;
 
@@ -88,12 +89,31 @@ procedure TOLEStorage.ReadOLEFile(AFileName: string;
   AOLEDocument: TOLEDocument; const AStreamName: UTF8String);
 var
   RealFile: TFileStream;
+begin
+  RealFile:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
+  try
+    ReadOLEStream(RealFile, AOLEDocument, AStreamName);
+  finally
+    RealFile.Free;
+  end;
+end;
+
+
+procedure TOLEStorage.ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument;
+  const AStreamName: UTF8String = 'Book');
+var
   fsOLE: TVirtualLayer_OLE;
   OLEStream: TStream;
   VLAbsolutePath: UTF8String;
 begin
   VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths.
+  fsOLE := TVirtualLayer_OLE.Create(AStream);
   try
+    fsOLE.Initialize(); //Initialize the OLE container.
+    OLEStream := fsOLE.CreateStream(VLAbsolutePath, fmOpenRead);
+    try
+
+             {
     RealFile:=nil;
     RealFile:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
     try
@@ -114,12 +134,25 @@ begin
       finally
         OLEStream.Free;
       end;
+      }
+      if Assigned(OLEStream) then begin
+        if not AssigneD(AOLEDocument.Stream) then
+          AOLEDocument.Stream := TMemoryStream.Create
+        else
+          (AOLEDocument.Stream as TMemoryStream).Clear;
+        AOLEDocument.Stream.CopyFrom(OLEStream, OLEStream.Size);
+      end;
+    finally
+      OLEStream.Free;
+    end;
   finally
     fsOLE.Free;
   end;
+  {
   finally
     RealFile.Free;
   end;
+  }
 end;
 
 {@@

components/fpspreadsheet/fpsnumformatparser.pas

@@ -1253,6 +1253,9 @@ end;
 procedure TsNumFormatParser.ScanFormat;
 var
   done: Boolean;
+  s: String;
+  n: Integer;
+  uch: Cardinal;
 begin
   done := false;
   while (FCurrent < FEnd) and (FStatus = psOK) and (not done) do begin
@@ -1270,6 +1273,14 @@ begin
       '_':  // Excel: Leave width of next character empty
         begin
           FToken := NextToken;
+          uch := UTF8CharacterToUnicode(FCurrent, n);
+          if n > 1 then
+          begin
+            AddElement(nftEmptyCharWidth, UnicodeToUTF8(uch));
+            inc(FCurrent, n-1);
+            FToken := NextToken;
+            Continue;
+          end else
             AddElement(nftEmptyCharWidth, FToken);
         end;
       '@':  // Excel: Indicates text format
@@ -1301,6 +1312,12 @@ begin
           Exit;
         end;
       else
+        uch := UTF8CharacterToUnicode(FCurrent, n);
+        if n > 1 then
+        begin
+          AddElement(nftText, UnicodeToUTF8(uch));
+          inc(FCurrent, n-1);
+        end else
           AddElement(nftText, FToken);
     end;
     FToken := NextToken;

components/fpspreadsheet/fpsopendocument.pas

@@ -149,6 +149,7 @@ type
   private
     FColumnStyleList: TFPList;
     FRowStyleList: TFPList;
+    FRichTextFontList: TStringList;
     FHeaderFooterFontList: TObjectList;
 
     // Routines to write parts of files
@@ -163,6 +164,7 @@ type
     procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
     procedure WriteTableSettings(AStream: TStream);
     procedure WriteTableStyles(AStream: TStream);
+    procedure WriteTextStyles(AStream: TStream);
     procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
 
     function WriteBackgroundColorStyleXMLAsString(const AFormat: TsCellFormat): String;
@@ -232,7 +234,7 @@ type
 implementation
 
 uses
-  StrUtils, Variants, LazFileUtils, URIParser,
+  StrUtils, Variants, LazFileUtils, URIParser, LazUTF8,
  {$IFDEF FPS_VARISBOOL}
   fpsPatches,
  {$ENDIF}
@@ -958,7 +960,7 @@ end;
   The function result is false if a style with the given name could not be found }
 function TsSpreadOpenDocReader.ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean;
 var
-  fmt: PsCellFormat;
+  fmt: TsCellFormat;
   styleIndex: Integer;
   i: Integer;
 begin
@@ -980,8 +982,14 @@ begin
       exit;
     styleIndex := TColumnData(FColumnList[i]).DefaultCellStyleIndex;
   end;
-  fmt := FCellFormatList.Items[styleIndex];
+  fmt := FCellFormatList.Items[styleIndex]^;
-  ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
+  if (styleIndex = 0) and FWorksheet.HasHyperlink(ACell) then
+  begin
+    // Make sure to use hyperlink font for hyperlink cells in case of default cell style
+    fmt.FontIndex := HYPERLINK_FONTINDEX;
+    Include(fmt.UsedFormattingFields, uffFont);
+  end;
+  ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
 
   Result := true;
 end;
@@ -1660,7 +1668,9 @@ var
   fntSize: Single;
   fntStyles: TsFontStyles;
   fntColor: TsColor;
+  fntPosition: TsFontPosition;
   s: String;
+  p: Integer;
 begin
   if ANode = nil then
   begin
@@ -1687,9 +1697,20 @@ begin
   if not ((s = '') or (s = 'none')) then
     Include(fntStyles, fssUnderline);
   s := GetAttrValue(ANode, 'style:text-line-through-style');
+  if s = '' then s := GetAttrValue(ANode, 'style:text-line-through-type');
   if not ((s = '') or (s = 'none')) then
     Include(fntStyles, fssStrikeout);
 
+  fntPosition := fpNormal;
+  s := GetAttrValue(ANode, 'style:text-position');
+  if Length(s) >= 3 then
+  begin
+    if (s[3] = 'b') or (s[1] = '-') then
+      fntPosition := fpSubscript
+    else
+      fntPosition := fpSuperscript;
+  end;
+
   s := GetAttrValue(ANode, 'fo:color');
   if s <> '' then
     fntColor := HTMLColorStrToColor(s)
@@ -1703,13 +1724,13 @@ begin
   end else
   if (APreferredIndex > -1) then
   begin
-    FWorkbook.ReplaceFont(APreferredIndex, fntName, fntSize, fntStyles, fntColor);
+    FWorkbook.ReplaceFont(APreferredIndex, fntName, fntSize, fntStyles, fntColor, fntPosition);
     Result := APreferredIndex;
   end else
   begin
-    Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
+    Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor, fntPosition);
     if Result = -1 then
-      Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
+      Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor, fntPosition);
   end;
 end;
 
@@ -1825,6 +1846,10 @@ begin
     Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
 end;
 
+{ In principle, this method could be simplified by calling ReadFromStream which
+  is essentially a duplication of ReadFromFile. But ReadFromStream leads to
+  worse memory usage. --> KEEP READFROMFILE INTACT
+  See fpspeedtest, ods 20k x 100 cells --> out of mem in Win7-32 bit, 4 GB}
 procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string);
 var
   Doc : TXMLDocument;
@@ -1935,12 +1960,132 @@ begin
 end;
 
 procedure TsSpreadOpenDocReader.ReadFromStream(AStream: TStream);
+var
+  Doc : TXMLDocument;
+//  FilePath : string;
+//  UnZip : TUnZipper;
+//  FileList : TStringList;
+  BodyNode, SpreadSheetNode, TableNode: TDOMNode;
+  StylesNode: TDOMNode;
+  OfficeSettingsNode: TDOMNode;
+  nodename: String;
+  pageLayout: PsPageLayout;
+  XMLStream: TStream;
+begin
+  {
+  //unzip files into AFileName path
+  FilePath := GetTempDir(false);
+  UnZip := TUnZipper.Create;
+  FileList := TStringList.Create;
+  try
+    FileList.Add('styles.xml');
+    FileList.Add('content.xml');
+    FileList.Add('settings.xml');
+    UnZip.OutputPath := FilePath;
+    Unzip.UnZipFiles(AFileName,FileList);
+  finally
+    FreeAndNil(FileList);
+    FreeAndNil(UnZip);
+  end; //try
+   }
+  Doc := nil;
+  try
+    // process the styles.xml file
+    XMLStream := TMemoryStream.Create;
+    try
+      if UnzipToStream(AStream, 'styles.xml', XMLStream) then
+        ReadXMLStream(Doc, XMLStream);
+    finally
+      XMLStream.Free;
+    end;
+
+    StylesNode := Doc.DocumentElement.FindNode('office:styles');
+    ReadNumFormats(StylesNode);
+    ReadStyles(StylesNode);
+    ReadAutomaticStyles(Doc.DocumentElement.FindNode('office:automatic-styles'));
+    ReadMasterStyles(Doc.DocumentElement.FindNode('office:master-styles'));
+    FreeAndNil(Doc);
+
+    //process the content.xml file
+    XMLStream := TMemoryStream.Create;
+    try
+      if UnzipToStream(AStream, 'content.xml', XMLStream) then
+        ReadXMLStream(Doc, XMLStream);
+    finally
+      XMLStream.Free;
+    end;
+
+    StylesNode := Doc.DocumentElement.FindNode('office:automatic-styles');
+    ReadNumFormats(StylesNode);
+    ReadStyles(StylesNode);
+
+    BodyNode := Doc.DocumentElement.FindNode('office:body');
+    if not Assigned(BodyNode) then
+      raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] Node "office:body" not found.');
+
+    SpreadSheetNode := BodyNode.FindNode('office:spreadsheet');
+    if not Assigned(SpreadSheetNode) then
+      raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] Node "office:spreadsheet" not found.');
+
+    ReadDateMode(SpreadSheetNode);
+
+    //process each table (sheet)
+    TableNode := SpreadSheetNode.FindNode('table:table');
+    while Assigned(TableNode) do
+    begin
+      nodename := TableNode.Nodename;
+      // These nodes occur due to leading spaces which are not skipped
+      // automatically any more due to PreserveWhiteSpace option applied
+      // to ReadXMLFile
+      if nodeName <> 'table:table' then
+      begin
+        TableNode := TableNode.NextSibling;
+        continue;
+      end;
+      FWorkSheet := FWorkbook.AddWorksheet(GetAttrValue(TableNode, 'table:name'), true);
+      // Collect column styles used
+      ReadColumns(TableNode);
+      // Process each row inside the sheet and process each cell of the row
+      ReadRowsAndCells(TableNode);
+      // Read page layout
+      pageLayout := ReadPageLayout(StylesNode, GetAttrValue(TableNode, 'table:style-name'));
+      if pageLayout <> nil then
+        FWorksheet.PageLayout := pagelayout^;
+      // Handle columns and rows
+      ApplyColWidths;
+      // Page layout
+      FixCols(FWorksheet);
+      FixRows(FWorksheet);
+      // Continue with next table
+      TableNode := TableNode.NextSibling;
+    end; //while Assigned(TableNode)
+
+    FreeAndNil(Doc);
+
+    // process the settings.xml file (Note: it does not always exist!)
+    XMLStream := TMemoryStream.Create;
+    try
+      if UnzipToStream(AStream, 'settings.xml', XMLStream) then
+      begin
+        ReadXMLStream(Doc, XMLStream);
+        OfficeSettingsNode := Doc.DocumentElement.FindNode('office:settings');
+        ReadSettings(OfficeSettingsNode);
+      end;
+    finally
+      XMLStream.Free;
+    end;
+
+  finally
+    FreeAndNil(Doc);
+  end;
+end;
+{
 begin
   Unused(AStream);
   raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] '+
                          'Method not implemented. Use "ReadFromFile" instead.');
 end;
-
+ }
 procedure TsSpreadOpenDocReader.ReadHeaderFooterFont(ANode: TDOMNode;
   var AFontName: String; var AFontSize: Double;
   var AFontStyle: TsHeaderFooterFontStyles; var AFontColor: TsColor);
@@ -1998,13 +2143,16 @@ end;
 procedure TsSpreadOpenDocReader.ReadLabel(ARow, ACol: Cardinal;
   ACellNode: TDOMNode);
 var
-  cellText: String;
+  cellText, spanText: String;
   styleName: String;
   childnode: TDOMNode;
   subnode: TDOMNode;
   nodeName: String;
   cell: PCell;
   hyperlink: string;
+  fmt: TsCellFormat;
+  rtParams: TsRichTextParams;
+  idx: Integer;
 
   procedure AddToCellText(AText: String);
   begin
@@ -2020,6 +2168,7 @@ begin
     like below is much better: }
   cellText := '';
   hyperlink := '';
+  SetLength(rtParams, 0);
   childnode := ACellNode.FirstChild;
   while Assigned(childnode) do
   begin
@@ -2041,7 +2190,21 @@ begin
               AddToCellText(subnode.TextContent);
             end;
           'text:span':
-            AddToCellText(subnode.TextContent);
+            begin
+              spanText := subnode.TextContent;
+              stylename := GetAttrValue(subnode, 'text:style-name');
+              if stylename <> '' then begin
+                idx := FCellFormatList.FindIndexOfName(stylename);
+                if idx > -1 then
+                begin
+                  SetLength(rtParams, Length(rtParams)+1);
+                  rtParams[High(rtParams)].FontIndex := FCellFormatList[idx]^.FontIndex;
+                  rtParams[High(rtParams)].StartIndex := Length(cellText);
+                  rtParams[High(rtParams)].EndIndex := Length(cellText + spanText);
+                end;
+              end;
+              AddToCelLText(spanText);
+            end;
         end;
         subnode := subnode.NextSibling;
       end;
@@ -2056,7 +2219,7 @@ begin
   end else
     cell := FWorksheet.AddCell(ARow, ACol);
 
-  FWorkSheet.WriteUTF8Text(cell, cellText);
+  FWorkSheet.WriteUTF8Text(cell, cellText, rtParams);
   if hyperlink <> '' then
   begin
     // ODS sees relative paths relative to the internal own file structure
@@ -2917,6 +3080,7 @@ var
   nodeName: String;
   family: String;
   styleName: String;
+  parentstyle: String;
   fmt: TsCellFormat;
   numFmtIndexDefault: Integer;
   numFmtName: String;
@@ -2925,6 +3089,7 @@ var
   numFmtParams: TsNumFormatParams;
   clr: TsColor;
   s: String;
+  idx: Integer;
 
   procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
   const
@@ -3013,6 +3178,7 @@ begin
     if nodeName = 'style:style' then
     begin
       family := GetAttrValue(styleNode, 'style:family');
+      parentstyle := GetAttrValue(stylenode, 'style:parent-style-name');
 
       // Column styles
       if family = 'table-column' then
@@ -3028,6 +3194,13 @@ begin
         styleName := GetAttrValue(styleNode, 'style:name');
 
         InitFormatRecord(fmt);
+
+        if parentstyle <> '' then
+        begin
+          idx := FCellFormatList.FindIndexOfName(parentstyle);
+          if idx > -1 then
+            fmt := FCellFormatList[idx]^;
+        end;
         fmt.Name := styleName;
 
         numFmtIndex := -1;
@@ -3173,8 +3346,28 @@ begin
           end;
           styleChildNode := styleChildNode.NextSibling;
         end;
-
         FCellFormatList.Add(fmt);
+      end
+      else
+      if family = 'text' then
+      begin
+        // "Rich-text formatting run" style
+        styleName := GetAttrValue(styleNode, 'style:name');
+        styleChildNode := styleNode.FirstChild;
+        while Assigned(styleChildNode) do
+        begin
+          nodeName := styleChildNode.NodeName;
+          if nodeName = 'style:text-properties' then
+          begin
+            InitFormatRecord(fmt);
+            fmt.Name := styleName;
+            fmt.FontIndex := ReadFont(styleChildNode);
+            if fmt.FontIndex > 0 then
+              Include(fmt.UsedFormattingFields, uffFont);
+            FCellFormatList.Add(fmt);
+          end;
+          styleChildNode := stylechildNode.NextSibling;
+        end;
       end;
     end;
     styleNode := styleNode.NextSibling;
@@ -3410,6 +3603,9 @@ begin
   FSMetaInfManifest.Position := 0;
 end;
 
+{ Writes the node "office:automatic-styles". Although this node occurs in both
+  "contents.xml" and "styles.xml" files, this method is called only for writing
+  to "styles.xml". }
 procedure TsSpreadOpenDocWriter.WriteAutomaticStyles(AStream: TStream);
 var
   i: Integer;
@@ -3640,11 +3836,12 @@ begin
   AppendToStream(FSContent,
       '<office:automatic-styles>');
 
-  WriteNumFormats(FSContent);
+  WriteNumFormats(FSContent);        // "N1" ...
-  WriteColStyles(FSContent);
+  WriteColStyles(FSContent);         // "co1" ...
-  WriteRowStyles(FSContent);
+  WriteRowStyles(FSContent);         // "ro1" ...
-  WriteTableStyles(FSContent);
+  WriteTableStyles(FSContent);       // "ta1" ...
-  WriteCellStyles(FSContent);
+  WriteCellStyles(FSContent);        // "ce1" ...
+  WriteTextStyles(FSContent);        // "T1" ...
 
   AppendToStream(FSContent,
       '</office:automatic-styles>');
@@ -4221,6 +4418,7 @@ begin
 
   FColumnStyleList := TFPList.Create;
   FRowStyleList := TFPList.Create;
+  FRichTextFontList := TStringList.Create;
   FHeaderFooterFontList := TObjectList.Create;
 
   FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
@@ -4242,6 +4440,7 @@ begin
   for j:=FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
   FRowStyleList.Free;
 
+  FRichTextFontList.Free;    // Do not destroy fonts, they are owned by Workbook
   FHeaderFooterFontList.Free;
 
   inherited Destroy;
@@ -4614,6 +4813,12 @@ begin
   if fssStrikeout in AFont.Style then
     Result := Result + 'style:text-line-through-style="solid" ';
 
+  if AFont.Position = fpSubscript then
+    Result := Result + 'style:text-position="sub 58%" ';
+
+  if AFont.Position = fpSuperscript then
+    Result := Result + 'style:text-position="super 58%" ';
+
   if AFont.Color <> defFnt.Color then
     Result := Result + Format('fo:color="%s" ', [ColorToHTMLColorStr(AFont.Color)]);
 end;
@@ -4879,6 +5084,41 @@ begin
   end;
 end;
 
+procedure TsSpreadOpenDocWriter.WriteTextStyles(AStream: TStream);
+var
+  cell: PCell;
+  rtp: TsRichTextParam;
+  styleCounter: Integer;
+  fnt: TsFont;
+  fntStr: String;
+  styleName: String;
+  sheet: TsWorksheet;
+  i: Integer;
+begin
+  styleCounter := 0;
+  for i := 0 to FWorkbook.GetWorksheetCount-1 do
+  begin
+    sheet := FWorkbook.GetWorksheetByIndex(i);
+    for cell in sheet.Cells do
+    begin
+      if Length(cell^.RichTextParams) = 0 then
+        Continue;
+      for rtp in cell^.RichTextParams do
+      begin
+        inc(styleCounter);
+        stylename := Format('T%d', [stylecounter]);
+        fnt := FWorkbook.GetFont(rtp.FontIndex);
+        FRichTextFontList.AddObject(stylename, fnt);
+        fntStr := WriteFontStyleXMLAsString(fnt);
+        AppendToStream(AStream,
+          '<style:style style:name="' + stylename + '" style:family="text">' +
+            '<style:text-properties ' + fntStr + '/>' +
+          '</style:style>');
+      end;
+    end;
+  end;
+end;
+
 
 {@@ ----------------------------------------------------------------------------
   Creates an XML string for inclusion of the text rotation style option into the
@@ -5196,8 +5436,11 @@ var
   txt: ansistring;
   textp, target, bookmark, comment: String;
   fmt: TsCellFormat;
+  fnt: TsFont;
   hyperlink: PsHyperlink;
   u: TUri;
+  i, idx, n, len: Integer;
+  rtParam: TsRichTextParam;
 begin
   Unused(ARow, ACol);
 
@@ -5254,8 +5497,52 @@ begin
       '</text:p>', [target, txt]);
 
   end else
+  begin
     // No hyperlink, normal text only
-    textp := '<text:p>' + txt + '</text:p>';
+    if Length(ACell^.RichTextParams) = 0 then
+      // Standard text formatting
+      textp := '<text:p>' + txt + '</text:p>'
+    else
+    begin
+      // "Rich-text" formatting
+      len := UTF8Length(AValue);
+      textp := '<text:p>';
+      rtParam := ACell^.RichTextParams[0];
+      if rtParam.StartIndex > 0 then
+      begin
+        txt := UTF8Copy(AValue, 1, rtParam.StartIndex);
+        ValidXMLText(txt);
+        textp := textp + txt;
+      end;
+      for i := 0 to High(ACell^.RichTextParams) do
+      begin
+        rtParam := ACell^.RichTextParams[i];
+        fnt := FWorkbook.GetFont(rtParam.FontIndex);
+        idx := FRichTextFontList.IndexOfObject(fnt);
+        n := rtParam.EndIndex - rtParam.StartIndex;
+        txt := UTF8Copy(AValue, rtParam.StartIndex+1, n);
+        ValidXMLText(txt);
+        textp := textp +
+          '<text:span text:style-name="' + FRichTextFontList[idx] + '">' +
+            txt +
+          '</text:span>';
+        if (rtParam.EndIndex < len) and (i = High(ACell^.RichTextParams)) then
+        begin
+          txt := UTF8Copy(AValue, rtParam.EndIndex+1, MaxInt);
+          ValidXMLText(txt);
+          textp := textp + txt;
+        end else
+        if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex)
+        then begin
+          n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex;
+          txt := UTF8Copy(AValue, rtParam.EndIndex+1, n);
+          ValidXMLText(txt);
+          textp := textp + txt;
+        end;
+      end;
+      textp := textp + '</text:p>';
+    end;
+  end;
 
   // Write it ...
   AppendToStream(AStream, Format(

components/fpspreadsheet/fpspreadsheet.pas

@@ -1,3 +1,14 @@
+{**
+  Unit: fpspreadsheet
+
+  implements **spreadsheet documents** and their  properties and methods.
+
+  AUTHORS: Felipe Monteiro de Carvalho, Reinier Olislagers, Werner Pamler
+
+  LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
+           distribution, for details about the license.
+}
+
 {@@ ----------------------------------------------------------------------------
   Unit fpspreadsheet implements <b>spreadsheet documents</b> and their
   properties and methods.
@@ -31,6 +42,18 @@ type
   TsBasicSpreadReader = class;
   TsBasicSpreadWriter = class;
 
+  {**
+    Type: TRow -- record containing information about a spreadsheet row
+
+    Members:
+      - Row -- The index of the row (beginning with 0)
+      - Height -- The height of the row (expressed as line count of the default font)
+
+    Notes:
+      - Only rows with heights that cannot be derived from the font height have
+        a row record.
+    }
+
   {@@ The record TRow contains information about a spreadsheet row:
     @param Row   The index of the row (beginning with 0)
     @param Height  The height of the row (expressed as lines count of the default font)
@@ -239,9 +262,10 @@ type
     procedure WriteRPNFormula(ACell: PCell;
       AFormula: TsRPNFormula); overload;
 
-    function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell; overload;
+    function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring;
-//    procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
+      ARichTextParams: TsRichTextParams = nil): PCell; overload;
-    procedure WriteUTF8Text(ACell: PCell; AText: String; ARichTextparams: TsRichTextParams = nil); overload;
+    procedure WriteUTF8Text(ACell: PCell; AText: String;
+      ARichTextparams: TsRichTextParams = nil); overload;
 
     { Writing of cell attributes }
     function WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle;
@@ -890,9 +914,9 @@ begin
 end;
 
 
-{*******************************************************************************
+{------------------------------------------------------------------------------}
-*                           TsWorksheet                                        *
+{                           TsWorksheet                                        }
-*******************************************************************************}
+{------------------------------------------------------------------------------}
 
 {@@ ----------------------------------------------------------------------------
   Constructor of the TsWorksheet class.
@@ -3464,12 +3488,19 @@ end;
   @param  ARow             The row of the cell
   @param  ACol             The column of the cell
   @param  AText            The text to be written encoded in utf-8
+  @param  ARichTextParams  Array of formatting instructions for characters or
+                           groups of characters (see TsRichTextParam).
+
   @return Pointer to cell created or used
+
+  @see    TsRichTextParams
+  @see    TsRichTextParam
 -------------------------------------------------------------------------------}
-function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell;
+function TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring;
+  ARichTextParams: TsRichTextParams = nil): PCell;
 begin
   Result := GetCell(ARow, ACol);
-  WriteUTF8Text(Result, AText);
+  WriteUTF8Text(Result, AText, ARichTextParams);
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -3480,6 +3511,11 @@ end;
 
   @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
+                           groups of characters (see TsRichTextParam).
+
+  @see    TsRichTextParams
+  @see    TsRichTextParam
 -------------------------------------------------------------------------------}
 procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String;
   ARichTextParams: TsRichTextParams = nil);
@@ -3537,6 +3573,7 @@ end;
   @param  ARow         Cell row index
   @param  ACol         Cell column index
   @param  ANumber      Number to be written
+
   @return Pointer to cell created or used
 -------------------------------------------------------------------------------}
 function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double): PCell;
@@ -6032,9 +6069,9 @@ begin
 end;
 
 
-{*******************************************************************************
+{------------------------------------------------------------------------------}
-*                              TsWorkbook                                      *
+{                              TsWorkbook                                      }
-*******************************************************************************}
+{------------------------------------------------------------------------------}
 
 {@@ ----------------------------------------------------------------------------
   Helper method called before reading the workbook. Clears the error log.
@@ -7664,9 +7701,9 @@ begin
 end;
    *)
 
-{*******************************************************************************
+{------------------------------------------------------------------------------}
-*                          TsBasicSpreadReaderWriter                           *
+{                          TsBasicSpreadReaderWriter                           }
-*******************************************************************************}
+{------------------------------------------------------------------------------}
 
 {@@ ----------------------------------------------------------------------------
   Constructor of the reader/writer. Has the workbook to be read/written as a
@@ -7696,9 +7733,9 @@ begin
 end;
 
 
-{*******************************************************************************
+{------------------------------------------------------------------------------}
-*                             TsBasicSpreadWriter                              *
+{                             TsBasicSpreadWriter                              }
-*******************************************************************************}
+{------------------------------------------------------------------------------}
 
 {@@ ----------------------------------------------------------------------------
   Checks limitations of the writer, e.g max row/column count
@@ -7724,5 +7761,4 @@ initialization
 finalization
   SetLength(GsSpreadFormats, 0);
 
-end.
+end.   {** End Unit: fpspreadsheet }
-

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -598,17 +598,6 @@ uses
   fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils, fpsNumFormat;
 
 const
-  {@@ Translation of the fpspreadsheet type of horizontal text alignment to that
-      used in the graphics unit. }
-  HOR_ALIGNMENTS: array[haLeft..haRight] of TAlignment = (
-    taLeftJustify, taCenter, taRightJustify
-  );
-  {@@ Translation of the fpspreadsheet type of vertical text alignment to that
-      used in the graphics unit. }
-  VERT_ALIGNMENTS: array[TsVertAlignment] of TTextLayout = (
-    tlBottom, tlTop, tlCenter, tlBottom
-  );
-
   {@@ Default number of columns prepared for a new empty worksheet }
   DEFAULT_COL_COUNT = 26;
   {@@ Default number of rows prepared for a new empty worksheet }
@@ -2100,7 +2089,7 @@ var
   txtRot: TsTextRotation;
   fntIndex: Integer;
   lCell: PCell;
-  justif: Byte;
+//  justif: Byte;
   fmt: PsCellFormat;
 begin
   if (Worksheet = nil) then
@@ -2169,7 +2158,7 @@ begin
   txt := GetCellText(GetGridRow(lCell^.Col), GetGridCol(lCell^.Row));
   if txt = '' then
     exit;
-
+                        {
   case txtRot of
     trHorizontal:
       case horAlign of
@@ -2190,7 +2179,7 @@ begin
         vaCenter: justif := 1;
         vaBottom: justif := 0;
       end;
-  end;
+  end;                   }
   InternalDrawTextInCell(txt, ARect, horAlign, vertAlign, txtRot, wrapped,
     fntIndex, lCell^.RichTextParams);
 {

components/fpspreadsheet/fpstypes.pas

@@ -404,7 +404,7 @@ type
   TsFontStyles = set of TsFontStyle;
 
   {@@ Font position (subscript or superscript) }
-  TsFontPosition = (fpNormal, fpSubscript, fpSuperscript);
+  TsFontPosition = (fpNormal, fpSuperscript, fpSubscript);  // Keep order for compatibility with xls!
 
   {@@ Font record used in fpspreadsheet. Contains the font name, the font size
       (in points), the font style, and the font color. }
@@ -432,7 +432,7 @@ type
   TsRichTextParams = array of TsRichTextParam;
 
   {@@ Excel rich-text formatting run }
-  TsRichTextFormattingRun = record
+  TsRichTextFormattingRun = packed record
     FirstIndex: Integer;
     FontIndex: Integer;
   end;

components/fpspreadsheet/fpsvisualutils.pas

@@ -196,7 +196,7 @@ var
   totalHeight, linelen, stackPeriod: Integer;
 
   procedure InitFont(P: PChar; out rtState: TRtState;
-    PendingRtpIndex: Integer; out AHeight: Integer);
+    PendingRtpIndex: Integer; out AHeight: Integer; out AFontPos: TsFontPosition);
   var
     fnt: TsFont;
     hasRtp: Boolean;
@@ -216,12 +216,13 @@ var
     Convert_sFont_to_Font(fnt, ACanvas.Font);
     AHeight := ACanvas.TextHeight('Tg');
     if (fnt <> nil) and (fnt.Position <> fpNormal) then
-      ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+      ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+    AFontPos := fnt.Position;
   end;
 
   procedure UpdateFont(P:PChar; var rtState: TRtState;
     var PendingRtpIndex: Integer; var AHeight: Integer;
-    out AFontPos: TsFontPosition);
+    var AFontPos: TsFontPosition);
   var
     hasRtp: Boolean;
     rtp: TsRichTextParam;
@@ -238,7 +239,8 @@ var
         Convert_sFont_to_Font(fnt, ACanvas.Font);
         AHeight := ACanvas.TextHeight('Tg');
         if fnt.Position <> fpNormal then
-          ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+          ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+        AFontPos := fnt.Position;
         rtState := rtEnter;
       end else
       if (p - pStartText >= rtp.EndIndex) and (rtState = rtEnter) then
@@ -264,11 +266,11 @@ var
         Convert_sFont_to_Font(fnt, ACanvas.Font);
         AHeight := ACanvas.TextHeight('Tg');
         if fnt.Position <> fpNormal then
-          ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+          ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
-      end;
-    end;
         AFontPos := fnt.Position;
       end;
+    end;
+  end;
 
   procedure ScanLine(var P: PChar; var NumSpaces: Integer;
     var PendingRtpIndex: Integer; var width, height: Integer);
@@ -287,7 +289,7 @@ var
   begin
     NumSpaces := 0;
 
-    InitFont(p, rtState, PendingRtpIndex, h);
+    InitFont(p, rtState, PendingRtpIndex, h, fntpos);
     height := h;
 
     pEOL := p;
@@ -365,12 +367,12 @@ var
     p: PChar;
     rtState: TRtState;
     h, w: Integer;
-    fntpos: TsFontPosition;
+    fntpos: TsFontPosition = fpNormal;
     s: utf8String;
     charLen: Integer;
   begin
     p := pStart;
-    InitFont(p, rtState, PendingRtpIndex, h);
+    InitFont(p, rtState, PendingRtpIndex, h, fntpos);
     while p^ <> #0 do begin
       s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
       UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);

components/fpspreadsheet/fpsxmlcommon.pas

@@ -16,12 +16,15 @@ type
   TsSpreadXMLReader = class(TsCustomSpreadReader)
   protected
     procedure ReadXMLFile(out ADoc: TXMLDocument; AFileName: String);
+    procedure ReadXMLStream(out ADoc: TXMLDocument; AStream: TStream);
   end;
 
 function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
 function GetNodeValue(ANode: TDOMNode): String;
-procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
 
+procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
+function UnzipToStream(AZipStream: TStream; const AZippedFile: String;
+  ADestStream: TStream): Boolean;
 
 implementation
 
@@ -33,9 +36,13 @@ uses
  {$ENDIF}
   fpsStreams;
 
-{ Gets value for the specified attribute. Returns empty string if attribute
+{------------------------------------------------------------------------------}
-  not found. }
+{                                 Utilities                                    }
-function {TsSpreadXMLReader.}GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
+{------------------------------------------------------------------------------}
+
+{ Gets value for the specified attribute of the given node.
+  Returns empty string if attribute is not found. }
+function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string;
 var
   i: LongWord;
   Found: Boolean;
@@ -58,7 +65,7 @@ end;
 { Returns the text value of a node. Normally it would be sufficient to call
   "ANode.NodeValue", but since the DOMParser needs to preserve white space
   (for the spaces in date/time formats), we have to go more into detail. }
-function {TsSpreadXMLReader.}GetNodeValue(ANode: TDOMNode): String;
+function GetNodeValue(ANode: TDOMNode): String;
 var
   child: TDOMNode;
 begin
@@ -68,25 +75,99 @@ begin
     Result := child.NodeValue;
 end;
 
+
+{------------------------------------------------------------------------------}
+{                                 Unzipping                                    }
+{------------------------------------------------------------------------------}
+type
+  TStreamUnzipper = class(TUnzipper)
+  private
+    FInputStream: TStream;
+    FOutputStream: TStream;
+    FSuccess: Boolean;
+    procedure CloseInputStream(Sender: TObject; var AStream: TStream);
+    procedure CreateStream(Sender: TObject; var AStream: TStream;
+      AItem: TFullZipFileEntry);
+    procedure DoneStream(Sender: TObject; var AStream: TStream;
+      AItem: TFullZipFileEntry);
+    procedure OpenInputStream(Sender: TObject; var AStream: TStream);
+  public
+    constructor Create(AInputStream: TStream);
+    function UnzipFile(const AZippedFile: string; ADestStream: TStream): Boolean;
+  end;
+
+constructor TStreamUnzipper.Create(AInputStream: TStream);
+begin
+  inherited Create;
+  OnCloseInputStream := @CloseInputStream;
+  OnCreateStream := @CreateStream;
+  OnDoneStream := @DoneStream;
+  OnOpenInputStream := @OpenInputStream;
+  FInputStream := AInputStream
+end;
+
+procedure TStreamUnzipper.CloseInputStream(Sender: TObject; var AStream: TStream);
+begin
+  AStream := nil;
+end;
+
+procedure TStreamUnzipper.CreateStream(Sender: TObject; var AStream: TStream;
+  AItem: TFullZipFileEntry);
+begin
+  FSuccess := True;
+  AStream := FOutputStream;
+end;
+
+procedure TStreamUnzipper.DoneStream(Sender: TObject; var AStream: TStream;
+  AItem: TFullZipFileEntry);
+begin
+  AStream := nil;
+end;
+
+procedure TStreamUnzipper.OpenInputStream(Sender: TObject; var AStream: TStream);
+begin
+  AStream := FInputStream;
+end;
+
+function TStreamUnzipper.UnzipFile(const AZippedFile: string;
+  ADestStream: TStream): Boolean;
+begin
+  FOutputStream := ADestStream;
+  FSuccess := False;
+  Files.Clear;
+  Files.Add(AZippedFile);
+  UnZipAllFiles;
+  Result := FSuccess;
+end;
+
 { We have to use our own ReadXMLFile procedure (there is one in xmlread)
   because we have to preserve spaces in element text for date/time separator.
   As a side-effect we have to skip leading spaces by ourselves. }
 procedure TsSpreadXMLReader.ReadXMLFile(out ADoc: TXMLDocument; AFileName: String);
 var
-  parser: TDOMParser;
-  src: TXMLInputSource;
   stream: TStream;
 begin
   if (boBufStream in Workbook.Options) then
-    stream := TBufStream.Create(AFileName, fmOpenRead + fmShareDenyWrite)
+    stream := TBufStream.Create(AFilename, fmOpenRead + fmShareDenyWrite)
   else
     stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyWrite);
 
   try
+    ReadXMLStream(ADoc, stream);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TsSpreadXMLReader.ReadXMLStream(out ADoc: TXMLDocument; AStream: TStream);
+var
+  parser: TDOMParser;
+  src: TXMLInputSource;
+begin
   parser := TDOMParser.Create;
   try
     parser.Options.PreserveWhiteSpace := true;    // This preserves spaces!
-      src := TXMLInputSource.Create(stream);
+    src := TXMLInputSource.Create(AStream);
     try
       parser.Parse(src, ADoc);
     finally
@@ -95,9 +176,6 @@ begin
   finally
     parser.Free;
   end;
-  finally
-    stream.Free;
-  end;
 end;
 
 procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
@@ -121,5 +199,21 @@ begin
 end;
 
 
+function UnzipToStream(AZipStream: TStream; const AZippedFile: String;
+  ADestStream: TStream): Boolean;
+var
+  unzip: TStreamUnzipper;
+  p: Int64;
+begin
+  p := ADestStream.Position;
+  unzip := TStreamUnzipper.Create(AZipStream);
+  try
+    Result := unzip.UnzipFile(AZippedFile, ADestStream);
+    ADestStream.Position := p;
+  finally
+    unzip.Free;
+  end;
+end;
+
 end.
 

components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas

@@ -101,6 +101,7 @@ type
     procedure ShowRefreshAll;
     procedure ShowRightMargin;
     procedure ShowRK;
+    procedure ShowRString;
     procedure ShowRow;
     procedure ShowSelection;
     procedure ShowSharedFormula;
@@ -132,7 +133,12 @@ type
       ACharCount: Integer; out AString: String; out ANumbytes: Integer); overload;
     procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
       out AString: String; out ANumBytes: Integer;
+      out ARichTextRuns: TsRichTextFormattingRuns;
+      out ABufIndexOfFirstRichTextRun: LongWord;
       IgnoreCompressedFlag: Boolean = false); overload;
+    procedure ExtractString(ABufIndex: Integer; ALenbytes: Byte; AUnicode: Boolean;
+      out AString: String; out ANumBytes: Integer;
+      IgnoreCompressedFlag: Boolean=False); overload;
     procedure PopulateGrid;
     procedure ShowInRow(var ARow: Integer; var AOffs: LongWord; ASize: Word;
       AValue,ADescr: String; ADescrOnly: Boolean = false);
@@ -265,7 +271,21 @@ begin
 end;
 
 procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
-  out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false);
+  out AString: String; out ANumBytes: Integer;
+  IgnoreCompressedFlag: Boolean = false);
+var
+  rtfRuns: TsRichTextFormattingRuns;
+  rtfIndex: LongWord;
+begin
+  ExtractString(ABufIndex, ALenbytes, AUnicode, AString, ANumBytes,
+    rtfRuns, rtfIndex, IgnoreCompressedFlag);
+end;
+
+procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
+  out AString: String; out ANumBytes: Integer;
+  out ARichTextRuns: TsRichTextFormattingRuns;
+  out ABufIndexOfFirstRichTextRun: LongWord;
+  IgnoreCompressedFlag: Boolean = false);
 var
   ls: Integer;    // Character count of string
   w: Word;
@@ -273,9 +293,14 @@ var
   optn: Byte;
   n: Integer;     // Byte count in string character array
   asianPhoneticBytes: DWord;
-  richRuns: Word;
+  numRichRuns: Word;
   offs: Integer;
+  rtfBufIndex: Int64;
+  rtfIndex: Integer;
 begin
+  ABufIndexOfFirstRichTextRun := LongWord(-1);
+  SetLength(ARichTextRuns, 0);
+
   if Length(FBuffer) = 0 then begin
     AString := '';
     ANumBytes := 0;
@@ -291,13 +316,16 @@ begin
     offs := ALenBytes;
     optn := FBuffer[ABufIndex + ALenBytes];
     inc(offs, 1);
+
     if optn and $08 <> 0 then  // rich text
     begin
       Move(FBuffer[ABufIndex + offs], w, 2);
-      richRuns := WordLEToN(w);
+      numRichRuns := WordLEToN(w);
       inc(offs, 2);
     end else
-      richRuns := 0;
+      numRichRuns := 0;
+    SetLength(ARichTextRuns, numRichRuns);
+
     if optn and $04 <> 0 then  // Asian phonetic
     begin
       Move(FBuffer[ABufIndex + offs], dw, 4);
@@ -305,16 +333,31 @@ begin
       inc(offs, 4);
     end else
       asianPhoneticBytes := 0;
+
     if (optn  and $01 = 0) and (not IgnoreCompressedFlag) then
       // compressed --> 1 byte per character
       ExtractString(ABufIndex + offs, false, ls, AString, n)
     else
       // non-compressed unicode
       ExtractString(ABufIndex + offs, true, ls, AString, n);
-    ANumBytes := offs + n + richRuns * 4 + asianPhoneticBytes;
+
+    ANumBytes := offs + n + numRichRuns * 4 + asianPhoneticBytes;
+
+    rtfIndex := 0;
+    rtfBufIndex := ABufIndex + offs + n;
+    ABufIndexOfFirstRichTextRun := rtfBufIndex;
+    while rtfIndex < numRichRuns do begin
+      Move(FBuffer[rtfBufIndex], w, 2);
+      ARichTextRuns[rtfIndex].FirstIndex := WordLEToN(w);
+      Move(FBuffer[rtfBufIndex+2], w, 2);
+      ARichTextRuns[rtfIndex].FontIndex := WordLEToN(w);
+      inc(rtfIndex);
+      inc(rtfBufIndex, 4);
+    end;
   end else
   begin
     // ansi string
+    SetLength(ARichTextRuns, 0);  // no rich text formatting for ansi strings
     ExtractString(ABufIndex + ALenBytes, false, ls, AString, n);
     ANumbytes := ALenBytes + n;
   end;
@@ -471,6 +514,8 @@ begin
       ShowMulBlank;
     $00BD:
       ShowMulRK;
+    $00D6:
+      ShowRString;
     $00D7:
       ShowDBCell;
     $00DA:
@@ -1235,12 +1280,14 @@ var
   sa: ansistring;
   sw: widestring;
   ls: Integer;
-  i: Integer;
+  i, j: Integer;
   w: Word;
   n: Integer;
   run: Integer;
   total2: Integer;
   optn: Byte;
+  rtfRuns: TsRichTextFormattingRuns;
+  rtfBufferIndex: LongWord;
 begin
   case FInfo of
     BIFFNODE_TXO_CONTINUE1:
@@ -1345,9 +1392,20 @@ begin
         for i:=FCounterSST+1 to FTotalSST do
         begin
           FCounterSST := i;
-          ExtractString(FBufferIndex, 2, true, s, numBytes);
+          ExtractString(FBufferIndex, 2, true, s, numBytes, rtfRuns, rtfBufferIndex);
           ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]));
           inc(n);
+          if Length(rtfRuns) > 0 then begin
+            numBytes := 2;
+            for j:=0 to High(rtfRuns) do
+            begin
+              ShowInRow(FCurrRow, rtfBufferIndex, 2, IntToStr(rtfRuns[j].FirstIndex),
+                Format('Rich-Text formatting run #%d, index of first character', [j]));
+              ShowInRow(FCurrRow, rtfBufferIndex, 2, IntToStr(rtfRuns[j].FontIndex),
+                Format('Rich-Text formatting run #%d, font index', [j]));
+              inc(n, 2);
+            end;
+          end;
           if FPendingCharCount > 0 then
           begin
             FInfo := BIFFNODE_SST_CONTINUE;
@@ -1838,6 +1896,7 @@ var
   ansiStr: AnsiString;
   s: String;
   i, n: Integer;
+  rtfRuns: TsRichTextFormattingRuns;
 begin
   BeginUpdate;
   RowCount := FixedRows + 1000;
@@ -2112,7 +2171,7 @@ begin
     numBytes := 2;
     Move(FBuffer[FBufferIndex], w, numBytes);
     w := WordLEToN(w);
-    ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(2), 'Color index');
+    ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(w), 'Color index');
 
     numBytes := 2;
     Move(FBuffer[FBufferIndex], w, numBytes);
@@ -3309,6 +3368,7 @@ begin
     'Index to XF record');
 end;
 
+// Called for LABEL
 procedure TBIFFGrid.ShowLabelCell;
 var
   numBytes: Integer;
@@ -4997,6 +5057,72 @@ begin
 end;
 
 
+procedure TBIFFGrid.ShowRString;
+var
+  numBytes: Integer;
+  b: Byte;
+  w: Word;
+  s: String;
+  len: Integer;
+  j: Integer;
+  wideStr: wideString;
+  ansiStr: ansiString;
+begin
+  if FFormat < sfExcel5 then
+    exit;
+
+  RowCount := FixedRows + 5;
+
+  ShowRowColData(FBufferIndex);
+
+  numBytes := 2;
+  Move(FBuffer[FBufferIndex], w, numBytes);
+  w := WordLEToN(w);
+  ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('%d ($%.4x)', [w, w]),
+    'Index of XF record');
+
+  // String length
+  Move(FBuffer[FBufferIndex], w, 2);
+  len := WordLEToN(w);
+
+  if FFormat = sfExcel8 then
+  begin
+    SetLength(widestr, len);
+    Move(FBuffer[FBufferIndex+3], widestr[1], len*2);
+    s := UTF8Encode(WideStringLEToN(widestr));
+    numbytes := 3 + len*2;
+  end else
+  begin
+    SetLength(ansistr, len);
+    Move(FBuffer[FBufferIndex+2], ansistr[1], len);
+    s := AnsiToUTF8(ansistr);
+    numbytes := 2 + len;
+  end;
+
+  ShowInRow(FCurrRow, FBufferIndex, numbytes, s,
+    Format('%s string, 16-bit string length', [GetStringType]));
+
+  // Number of rich-text formatting runs
+  numbytes := IfThen(FFormat = sfExcel8, 2, 1);
+  Move(FBuffer[FBufferIndex], w, numbytes);
+  len := WordLEToN(w);
+  ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(len),
+    'Count of rich-text formatting runs');
+
+  // Formatting run data
+  RowCount := RowCount + 2*len;
+  for j:=0 to len-1 do
+  begin
+    Move(FBuffer[FBufferIndex], w, numbytes);
+    ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(WordLEToN(w)),
+      Format('Rich-Text formatting run #%d, index of first character', [j]));
+    Move(FBuffer[FBufferIndex], w, numbytes);
+    ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(WordLEToN(w)),
+      Format('Rich-Text formatting run #%d, font index', [j]));
+  end;
+end;
+
+
 procedure TBIFFGrid.ShowSelection;
 var
   numBytes: Integer;
@@ -5195,7 +5321,10 @@ var
   numBytes: Integer;
   s: String;
   total1, total2: DWord;
-  i, n: Integer;
+  i, j, n: Integer;
+  rtfRuns: TsRichTextFormattingRuns;
+  rtfIndex: LongWord;
+  w: Word;
 begin
   numBytes := 4;
   Move(FBuffer[FBufferIndex], total1, numBytes);
@@ -5204,7 +5333,7 @@ begin
   total2 := DWordLEToN(total2);
   FTotalSST := total2;
 
-  RowCount := FixedRows + 2 + total2;
+  RowCount := FixedRows + 1000;
 
   ShowInRow(FCurrRow, FBufferIndex, numBytes, IntToStr(total1),
     'Total number of shared strings in the workbook');
@@ -5215,10 +5344,22 @@ begin
   n := 0;
   for i:=1 to FTotalSST do begin
     FCounterSST := i;
-    ExtractString(FBufferIndex, 2, true, s, numBytes);  // BIFF8 only --> 2 length bytes
+    ExtractString(FBufferIndex, 2, true, s, numBytes, rtfRuns, rtfIndex);  // BIFF8 only --> 2 length bytes
     inc(n);
-    if FPendingCharCount = 0 then
+    if FPendingCharCount = 0 then begin
-      ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]))
+      ShowInRow(FCurrRow, FBufferIndex, numbytes, s, IfThen(Length(rtfRuns) > 0,
+        Format('Shared string #%d (Count of Rich-Text formatting runs: %d)', [i, Length(rtfRuns)]),
+        Format('Shared string #%d', [i])));
+//       ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]));
+      for j:=0 to High(rtfRuns) do
+      begin
+        ShowInRow(FCurrRow, rtfIndex, 2, IntToStr(rtfRuns[j].FirstIndex),
+          Format('  Rich-Text formatting run #%d, index of first character', [j]));
+        ShowInRow(FCurrRow, rtfIndex, 2, IntToStr(rtfRuns[j].FontIndex),
+          Format('  Rich-Text formatting run #%d, font index', [j]));
+        inc(n, 2);
+      end;
+    end
     else
     begin
       ShowInRow(FCurrRow, FBufferIndex, numbytes, s, Format('Shared string #%d - partial (--> CONTINUE)', [i]));

components/fpspreadsheet/xlsbiff5.pas

@@ -73,9 +73,6 @@ type
   { TsSpreadBIFF5Reader }
 
   TsSpreadBIFF5Reader = class(TsSpreadBIFFReader)
-  private
-    FWorksheetNames: TStringList;
-    FCurrentWorksheet: Integer;
   protected
     procedure PopulatePalette; override;
     { Record writing methods }
@@ -83,15 +80,15 @@ type
     procedure ReadFONT(const AStream: TStream);
     procedure ReadFORMAT(AStream: TStream); override;
     procedure ReadLABEL(AStream: TStream); override;
-    procedure ReadWorkbookGlobals(AStream: TStream);
+    procedure ReadRSTRING(AStream: TStream);
-    procedure ReadWorksheet(AStream: TStream);
-    procedure ReadRichString(AStream: TStream);
     procedure ReadStandardWidth(AStream: TStream; ASheet: TsWorksheet);
     procedure ReadStringRecord(AStream: TStream); override;
+    procedure ReadWorkbookGlobals(AStream: TStream); override;
+    procedure ReadWorksheet(AStream: TStream); override;
     procedure ReadXF(AStream: TStream);
   public
     { General reading methods }
-    procedure ReadFromFile(AFileName: string); override;
+//    procedure ReadFromFile(AFileName: string); override;
     procedure ReadFromStream(AStream: TStream); override;
   end;
 
@@ -323,6 +320,13 @@ type
     TextLen: Word;
   end;
 
+  TBiff5_RichTextFormattingRun = packed record
+    FirstIndex: Byte;
+    FontIndex: Byte;
+  end;
+
+  TBiff5_RichTextFormattingRuns = array of TBiff5_RichTextFormattingRun;
+
   TBIFF5_XFRecord = packed record
     RecordID: Word;
     RecordSize: Word;
@@ -426,7 +430,7 @@ begin
       INT_EXCEL_ID_RIGHTMARGIN   : ReadMargin(AStream, 1);
       INT_EXCEL_ID_RK            : ReadRKValue(AStream); //(RK) This record represents a cell that contains an RK value (encoded integer or floating-point value). If a floating-point value cannot be encoded to an RK value, a NUMBER record will be written. This record replaces the record INTEGER written in BIFF2.
       INT_EXCEL_ID_ROW           : ReadRowInfo(AStream);
-      INT_EXCEL_ID_RSTRING       : ReadRichString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
+      INT_EXCEL_ID_RSTRING       : ReadRString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
       INT_EXCEL_ID_SHAREDFMLA    : ReadSharedFormula(AStream);
       INT_EXCEL_ID_SHEETPR       : ReadSHEETPR(AStream);
       INT_EXCEL_ID_STANDARDWIDTH : ReadStandardWidth(AStream, FWorksheet);
@@ -508,12 +512,11 @@ begin
 
   SetLength(s, Len);
   AStream.ReadBuffer(s[1], Len*SizeOf(AnsiChar));
-//  sheetName := AnsiToUTF8(s);
   sheetName := ConvertEncoding(s, FCodePage, EncodingUTF8);
   FWorksheetNames.Add(sheetName);
 end;
 
-procedure TsSpreadBIFF5Reader.ReadRichString(AStream: TStream);
+procedure TsSpreadBIFF5Reader.ReadRSTRING(AStream: TStream);
 var
   L: Word;
   B, F: Byte;
@@ -593,6 +596,7 @@ begin
   FIncompleteCell := nil;
 end;
 
+(*
 procedure TsSpreadBIFF5Reader.ReadFromFile(AFileName: string);
 var
   MemStream: TMemoryStream;
@@ -620,7 +624,7 @@ begin
     OLEStorage.Free;
   end;
 end;
-
+*)
 procedure TsSpreadBIFF5Reader.ReadXF(AStream: TStream);
 var
   rec: TBIFF5_XFRecord;
@@ -642,15 +646,7 @@ begin
   AStream.ReadBuffer(rec.FontIndex, SizeOf(rec) - 2*SizeOf(Word));
 
   // Font index
-  i := WordLEToN(rec.FontIndex);
+  fmt.FontIndex := FixFontIndex(WordLEToN(rec.FontIndex));
-//  if i > 4 then dec(i);  // Watch out for the nasty missing font #4...
-  fmt.FontIndex := FixFontIndex(i);
-  {
-  fnt := TsFont(FFontList[i]);
-  fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
-  if fmt.FontIndex = -1 then
-    fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
-    }
   if fmt.FontIndex > 1 then
     Include(fmt.UsedFormattingFields, uffFont);
 
@@ -780,9 +776,94 @@ begin
   FCellFormatList.Add(fmt);
 end;
 
+procedure TsSpreadBIFF5Reader.ReadFromStream(AStream: TStream);
+var
+  OLEStream: TMemoryStream;
+  OLEStorage: TOLEStorage;
+  OLEDocument: TOLEDocument;
+begin
+  OLEStream := TMemoryStream.Create;
+  try
+    OLEStorage := TOLEStorage.Create;
+    try
+      // Only one stream is necessary for any number of worksheets
+      OLEDocument.Stream := OLEStream;
+      OLEStorage.ReadOLEStream(AStream, OLEDocument, 'Book');
+    finally
+      OLEStorage.Free;
+    end;
+    InternalReadFromStream(OLEStream);
+  finally
+    OLEStream.Free;
+  end;
+end;
+
+(*
 procedure TsSpreadBIFF5Reader.ReadFromStream(AStream: TStream);
 var
   BIFF5EOF: Boolean;
+  OLEStream: TMemoryStream;
+  OLEStorage: TOLEStorage;
+  OLEDocument: TOLEDocument;
+begin
+  OLEStream := TMemoryStream.Create;
+  try
+    OLEStorage := TOLEStorage.Create;
+    try
+      // Only one stream is necessary for any number of worksheets
+      OLEDocument.Stream := OLEStream;
+      OLEStorage.ReadOLEStream(AStream, OLEDocument);
+    finally
+      OLEStorage.Free;
+    end;
+
+    // Check if the operation succeeded
+    if OLEStream.Size = 0 then
+      raise Exception.Create('[TsSpreadBIFF5Reader.ReadFromFile] Reading of OLE document failed');
+
+    // Rewind the stream and read from it
+    OLEStream.Position := 0;
+
+    {Initializations }
+    FWorksheetNames := TStringList.Create;
+    try
+      FCurrentWirksheet := 0;
+      BIFF5EOF := false;
+
+      { Read workbook globals }
+      ReadWorkbookGlobals(OLEStream);
+
+      { Check for the end of the file }
+      if OLEStream.Position >= AStream.Size then
+        BIFF5EOF := true;
+
+      { Now read all worksheets }
+      while not BIFF5EOF do
+      begin
+        ReadWorksheet(OLEStream);
+
+        // Check for the end of the fild
+        if OLEStream.Position >= OLEStream.Size then
+          BIFF5EOF := true;
+
+        // Final preparations
+        inc(FCurrentWorksheet);
+        // It can happen in files written by Office97 that the OLE directory is
+        // at the end of the file.
+        if FCurrentWorksheet = FWorksheetNames.Count then
+          BIFF5EOF := true;
+      end;
+
+    finally
+      { Finalization }
+      FreeAndNil(FWorksheetNames);
+    end;
+  finally
+    OLEStream.Free;
+  end;
+end;
+    *)
+(*
 begin
   { Initializations }
 
@@ -815,6 +896,7 @@ begin
   { Finalization }
   FWorksheetNames.Free;
 end;
+*)
 
 procedure TsSpreadBIFF5Reader.ReadFont(const AStream: TStream);
 var
@@ -1253,7 +1335,7 @@ begin
     AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_NORMAL));
 
   { Escapement type }
-  AStream.WriteWord(0);
+  AStream.WriteWord(WordToLE(ord(AFont.Position)));
 
   { Underline type }
   if fssUnderline in AFont.Style then
@@ -1369,12 +1451,16 @@ end;
 procedure TsSpreadBIFF5Writer.WriteLabel(AStream: TStream; const ARow,
   ACol: Cardinal; const AValue: string; ACell: PCell);
 const
-  MAXBYTES = 255; //limit for this format
+  MAXBYTES = 255;  // Limit for this BIFF5
 var
   L: Word;
   AnsiValue: ansistring;
   rec: TBIFF5_LabelRecord;
   buf: array of byte;
+  useRTF: Boolean;
+  fmt: PsCellFormat;
+  run, j: Integer;
+  rtfRuns: TBiff5_RichTextformattingRuns;
 begin
   if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
     exit;
@@ -1401,9 +1487,40 @@ begin
   end;
   L := Length(AnsiValue);
 
+  useRTF := (Length(ACell^.RichTextParams) > 0);
+
   { BIFF record header }
-  rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL);
+  rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL));
-  rec.RecordSize := WordToLE(8 + L);
+  rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L);
+
+  { Prepare rich-text formatting runs }
+  if useRTF then
+  begin
+    fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
+    run := 0;
+    for j:=0 to High(ACell^.RichTextParams) do
+    begin
+      SetLength(rtfRuns, run + 1);
+      rtfRuns[run].FirstIndex := ACell^.RichTextParams[j].StartIndex;
+      rtfRuns[run].FontIndex := ACell^.RichTextParams[j].FontIndex;
+      if rtfRuns[run].FontIndex >= 4 then
+        inc(rtfRuns[run].FontIndex);  // Font #4 does not exist in BIFF
+      inc(run);
+      if (ACell^.RichTextParams[j].EndIndex < L) and
+         (ACell^.RichTextParams[j].EndIndex <> ACell^.RichTextParams[j+1].StartIndex)    // wp: j+1 needs to be checked!
+      then begin
+        SetLength(rtfRuns, run+1);
+        rtfRuns[run].FirstIndex := ACell^.RichTextParams[j].EndIndex;
+        rtfRuns[run].FontIndex := fmt^.FontIndex;
+        if rtfRuns[run].FontIndex >= 4 then
+          inc(rtfRuns[run].FontIndex);
+        inc(run);
+      end;
+    end;
+
+    // Adjust BIFF record size for appended formatting runs
+    inc(rec.RecordSize, SizeOf(byte) + run * SizeOf(TBiff5_RichTextFormattingRun));
+  end;
 
   { BIFF record data }
   rec.Row := WordToLE(ARow);
@@ -1416,15 +1533,25 @@ begin
   rec.TextLen := WordToLE(L);
 
   { Copy the text characters into a buffer immediately after rec }
-  SetLength(buf, SizeOf(rec) + SizeOf(ansiChar)*L);
+  SetLength(buf, SizeOf(rec) + L);
   Move(rec, buf[0], SizeOf(rec));
-  Move(AnsiValue[1], buf[SizeOf(rec)], L*SizeOf(ansiChar));
+  Move(AnsiValue[1], buf[SizeOf(rec)], L);
 
-  { Write out }
+  { Write out buffer }
-  AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*L);
+  AStream.WriteBuffer(buf[0], SizeOf(Rec) + L);
+
+  { Write rich-text information in case of RSTRING record }
+  if useRTF then
+  begin
+    { Write number of rich-text formatting runs }
+    AStream.WriteByte(run);
+    { Write rich-text formatting runs }
+    AStream.WriteBuffer(rtfRuns[0], run * SizeOf(TBiff5_RichTextFormattingRun));
+  end;
 
   { Clean up }
   SetLength(buf, 0);
+  SetLength(rtfRuns, 0);
 end;
 
 {@@ ----------------------------------------------------------------------------

components/fpspreadsheet/xlscommon.pas

@@ -353,6 +353,8 @@ type
     FIncompleteNoteLength: Word;
     FFirstNumFormatIndexInFile: Integer;
     FPalette: TsPalette;
+    FWorksheetNames: TStrings;
+    FCurrentWorksheet: Integer;
 
     procedure AddBuiltinNumFormats; override;
     procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual;
@@ -437,6 +439,10 @@ type
     procedure ReadVCENTER(AStream: TStream);
     // Read WINDOW2 record (gridlines, sheet headers)
     procedure ReadWindow2(AStream: TStream); virtual;
+    procedure ReadWorkbookGlobals(AStream: TStream); virtual;
+    procedure ReadWorksheet(AStream: TStream); virtual;
+
+    procedure InternalReadFromStream(AStream: TStream);
 
   public
     constructor Create(AWorkbook: TsWorkbook); override;
@@ -946,10 +952,6 @@ end;
   everything is known.
 -------------------------------------------------------------------------------}
 procedure TsSpreadBIFFReader.FixColors;
-var
-  i: Integer;
-  fnt: TsFont;
-  fmt: PsCellFormat;
 
   procedure FixColor(var AColor: TsColor);
   begin
@@ -957,7 +959,17 @@ var
       AColor := FPalette[AColor and $00FFFFFF];
   end;
 
+var
+  i: Integer;
+  fnt: TsFont;
+  fmt: PsCellFormat;
 begin
+  for i:=0 to FFontList.Count-1 do
+  begin
+    fnt := TsFont(FFontList[i]);
+    if fnt <> nil then FixColor(fnt.Color);
+  end;
+
   for i:=0 to FWorkbook.GetFontCount - 1 do
   begin
     fnt := FWorkbook.GetFont(i);
@@ -2254,6 +2266,17 @@ begin
     FWorksheet.Options := FWorksheet.Options - [soHasFrozenPanes];
 end;
 
+{ Reads the workbook globals. }
+procedure TsSpreadBIFFReader.ReadWorkbookGlobals(AStream: TStream);
+begin
+  // To be overridden by BIFF5 and BIFF8
+end;
+
+procedure TsSpreadBIFFReader.ReadWorksheet(AStream: TStream);
+begin
+  // To be overridden by BIFF5 and BIFF8
+end;
+
 {@@ ----------------------------------------------------------------------------
   Populates the reader's palette by default colors. Will be overwritten if the
   file contains a palette on its own
@@ -2263,6 +2286,64 @@ begin
   FPalette.AddBuiltinColors;
 end;
 
+procedure TsSpreadBIFFReader.InternalReadFromStream(AStream: TStream);
+var
+  BIFFEOF: Boolean;
+begin
+{  OLEStream := TMemoryStream.Create;
+  try
+    OLEStorage := TOLEStorage.Create;
+    try
+      // Only one stream is necessary for any number of worksheets
+      OLEDocument.Stream := AStream; //OLEStream;
+      OLEStorage.ReadOLEStream(AStream, OLEDocument, AStreamName);
+    finally
+      OLEStorage.Free;
+    end;
+ }
+
+    // Check if the operation succeeded
+    if AStream.Size = 0 then
+      raise Exception.Create('[TsSpreadBIFFReader.InternalReadFromStream] Reading of OLE document failed');
+
+    // Rewind the stream and read from it
+    AStream.Position := 0;
+
+    {Initializations }
+    FWorksheetNames := TStringList.Create;
+    try
+      FCurrentWorksheet := 0;
+      BIFFEOF := false;
+
+      { Read workbook globals }
+      ReadWorkbookGlobals(AStream);
+
+      { Check for the end of the file }
+      if AStream.Position >= AStream.Size then
+        BIFFEOF := true;
+
+      { Now read all worksheets }
+      while not BIFFEOF do
+      begin
+        ReadWorksheet(AStream);
+
+        // Check for the end of the file
+        if AStream.Position >= AStream.Size then
+          BIFFEOF := true;
+
+        // Final preparations
+        inc(FCurrentWorksheet);
+        // It can happen in files written by Office97 that the OLE directory is
+        // at the end of the file.
+        if FCurrentWorksheet = FWorksheetNames.Count then
+          BIFFEOF := true;
+      end;
+    finally
+      { Finalization }
+      FreeAndNil(FWorksheetNames);
+    end;
+end;
+
 
 {------------------------------------------------------------------------------}
 {                            TsSpreadBIFFWriter                                }

components/fpspreadsheet/xlsxooxml.pas

@@ -130,7 +130,7 @@ type
     procedure WriteComments(AWorksheet: TsWorksheet);
     procedure WriteDimension(AStream: TStream; AWorksheet: TsWorksheet);
     procedure WriteFillList(AStream: TStream);
-    procedure WriteFont(AStream: TStream; AFont: TsFont; ATag: String);
+    procedure WriteFont(AStream: TStream; AFont: TsFont; UseInStyleNode: Boolean);
     procedure WriteFontList(AStream: TStream);
     procedure WriteHeaderFooter(AStream: TStream; AWorksheet: TsWorksheet);
     procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet);
@@ -749,9 +749,9 @@ begin
       if (s1 <> '') and (s2 <> '0') then
       begin
         fnt := TsFont(FFontList.Items[StrToInt(s1)]);
-        fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
+        fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
         if fmt.FontIndex = -1 then
-          fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
+          fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
         if fmt.FontIndex > 0 then
           Include(fmt.UsedFormattingFields, uffFont);
       end;
@@ -1065,9 +1065,8 @@ begin
   end;
 end;
 
-{ Reads the font described by the specified node. If the node is already
+{ Reads the font described by the specified node and stores it in the reader's
-  contained in the font list the font's index is returned; otherwise the
+  FontList. }
-  new font is added to the list and its index is returned. }
 function TsSpreadOOXMLReader.ReadFont(ANode: TDOMNode): Integer;
 var
   node: TDOMNode;
@@ -1079,6 +1078,7 @@ var
   fntPos: TsFontPosition;
   nodename: String;
   s: String;
+  acceptDuplicates: Boolean;
 begin
   fnt := Workbook.GetDefaultFont;
   if fnt <> nil then
@@ -1097,6 +1097,7 @@ begin
     fntPos := fpNormal;
   end;
 
+  acceptDuplicates := true;
   node := ANode.FirstChild;
   while node <> nil do
   begin
@@ -1105,6 +1106,7 @@ begin
     begin
       s := GetAttrValue(node, 'val');
       if s <> '' then fntName := s;
+      if nodename = 'rFont' then acceptDuplicates := false;
     end
     else
     if nodename = 'sz' then
@@ -1115,26 +1117,26 @@ begin
     else
     if nodename = 'b' then
     begin
-      if GetAttrValue(node, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false' then
-        then fntStyles := fntStyles + [fssBold];
+        fntStyles := fntStyles + [fssBold];
     end
     else
     if nodename = 'i' then
     begin
-      if GetAttrValue(node, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false' then
-        then fntStyles := fntStyles + [fssItalic];
+        fntStyles := fntStyles + [fssItalic];
     end
     else
     if nodename = 'u' then
     begin
-      if GetAttrValue(node, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false' then
-        then fntStyles := fntStyles+ [fssUnderline]
+        fntStyles := fntStyles+ [fssUnderline]
     end
     else
     if nodename = 'strike' then
     begin
-      if GetAttrValue(node, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false' then
-        then fntStyles := fntStyles + [fssStrikeout];
+        fntStyles := fntStyles + [fssStrikeout];
     end
     else
     if nodename = 'vertAlign' then
@@ -1154,11 +1156,14 @@ begin
     node := node.NextSibling;
   end;
 
-  // Check whether font is already contained in font list
+  // If this method is called when reading the sharedstrings.xml duplicate
+  // fonts should not be added to the reader's fontList.
+  // As a function result we return the index of the already existing font.
+  if not acceptDuplicates then
     for Result := 0 to FFontList.Count-1 do
     begin
       fnt := TsFont(FFontList[Result]);
-    if (fnt.FontName = fntName) and
+      if SameText(fnt.FontName, fntName) and
          (fnt.Size = fntSize) and
          (fnt.Style = fntStyles) and
          (fnt.Color = fntColor) and
@@ -1167,7 +1172,10 @@ begin
         exit;
   end;
 
-  // Font not yet stored --> create a new font and store it in list
+  // Create a font record and store it in the reader's fontlist.
+  // In case of fonts in styles.xml (nodename = "name"), do no look for
+  // duplicates because this will screw up the font index
+  // used in the xf records
   fnt := TsFont.Create;
   fnt.FontName := fntName;
   fnt.Size := fntSize;
@@ -1812,9 +1820,13 @@ begin
   FixRows(AWorksheet);
 end;
 
-procedure TsSpreadOOXMLReader.ReadFromFile(AFileName: string);
+{ In principle, this method could be simplified by calling ReadFromStream which
+  is essentially a duplication of ReadFromFile. But ReadFromStream leads to
+  worse memory usage. --> KEEP READFROMFILE INTACT }
+procedure TsSpreadOOXMLReader.ReadFromFile(AFilename: String);
 var
   Doc : TXMLDocument;
+  RelsNode: TDOMNode;
   FilePath : string;
   UnZip : TUnZipper;
   FileList : TStringList;
@@ -1822,6 +1834,7 @@ var
   i: Integer;
   fn: String;
   fn_comments: String;
+  XMLStream: TStream;
 begin
   //unzip "content.xml" of "AFileName" to folder "FilePath"
   FilePath := GetTempDir(false);
@@ -1927,6 +1940,7 @@ begin
       else
         // this sheet does not have any cell comments
         continue;
+
       // Extract texts from the comments file found and apply to worksheet.
       if fn_comments <> '' then
       begin
@@ -1939,6 +1953,7 @@ begin
           FreeAndNil(Doc);
         end;
       end;
+      // Add hyperlinks to cells
       ApplyHyperlinks(FWorksheet);
     end;  // for
 
@@ -1948,13 +1963,173 @@ begin
   end;
 end;
 
+procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream);
+var
+  Doc : TXMLDocument;
+  RelsNode: TDOMNode;
+  SheetList: TStringList;
+  i: Integer;
+  fn: String;
+  fn_comments: String;
+  XMLStream: TStream;
+begin
+  Doc := nil;
+  SheetList := TStringList.Create;
+  try
+    // Retrieve theme colors
+    XMLStream := TMemoryStream.Create;
+    try
+      if UnzipToStream(AStream, OOXML_PATH_XL_THEME, XMLStream) then
+      begin
+        ReadXMLStream(Doc, XMLStream);
+        ReadThemeElements(Doc.DocumentElement.FindNode('a:themeElements'));
+        FreeAndNil(Doc);
+      end;
+    finally
+      XMLStream.Free;
+    end;
+
+    // process the workbook.xml file
+    XMLStream := TMemoryStream.Create;
+    try
+      if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then
+        raise Exception.CreateFmt(rsDefectiveInternalStructure, ['xlsx']);
+      ReadXMLStream(Doc, XMLStream);
+      ReadFileVersion(Doc.DocumentElement.FindNode('fileVersion'));
+      ReadDateMode(Doc.DocumentElement.FindNode('workbookPr'));
+      ReadSheetList(Doc.DocumentElement.FindNode('sheets'), SheetList);
+      FreeAndNil(Doc);
+    finally
+      XMLStream.Free;
+    end;
+
+    // process the styles.xml file
+    XMLStream := TMemoryStream.Create;
+    try
+      // Should always exist, just to make sure...
+      if UnzipToStream(AStream, OOXML_PATH_XL_STYLES, XMLStream) then
+      begin
+        ReadXMLStream(Doc, XMLStream);
+        ReadPalette(Doc.DocumentElement.FindNode('colors'));
+        ReadFonts(Doc.DocumentElement.FindNode('fonts'));
+        ReadFills(Doc.DocumentElement.FindNode('fills'));
+        ReadBorders(Doc.DocumentElement.FindNode('borders'));
+        ReadNumFormats(Doc.DocumentElement.FindNode('numFmts'));
+        ReadCellXfs(Doc.DocumentElement.FindNode('cellXfs'));
+        FreeAndNil(Doc);
+      end;
+    finally
+      XMLStream.Free;
+    end;
+
+    // process the sharedstrings.xml file
+    // To do: Use buffered stream instead since shared strings may be large
+    XMLStream := TMemoryStream.Create;
+    try
+      if UnzipToStream(AStream, OOXML_PATH_XL_STRINGS, XMLStream) then
+      begin
+        ReadXMLStream(Doc, XMLStream);
+        ReadSharedStrings(Doc.DocumentElement.FindNode('si'));
+        FreeAndNil(Doc);
+      end;
+    finally
+      XMLStream.Free;
+    end;
+
+    // read worksheets
+    for i:=0 to SheetList.Count-1 do begin
+      // Create worksheet
+      FWorksheet := FWorkbook.AddWorksheet(SheetList[i], true);
+
+      // unzip sheet file
+      XMLStream := TMemoryStream.Create;
+      try
+        fn := OOXML_PATH_XL_WORKSHEETS + Format('sheet%d.xml', [i+1]);
+        if not UnzipToStream(AStream, fn, XMLStream) then
+          Continue;
+        ReadXMLStream(Doc, XMLStream);
+      finally
+        XMLStream.Free;
+      end;
+
+      // Sheet data, formats, etc.
+      ReadSheetViews(Doc.DocumentElement.FindNode('sheetViews'), FWorksheet);
+      ReadSheetFormatPr(Doc.DocumentElement.FindNode('sheetFormatPr'), FWorksheet);
+      ReadCols(Doc.DocumentElement.FindNode('cols'), FWorksheet);
+      ReadWorksheet(Doc.DocumentElement.FindNode('sheetData'), FWorksheet);
+      ReadMergedCells(Doc.DocumentElement.FindNode('mergeCells'), FWorksheet);
+      ReadHyperlinks(Doc.DocumentElement.FindNode('hyperlinks'));
+      ReadPrintOptions(Doc.DocumentElement.FindNode('printOptions'), FWorksheet);
+      ReadPageMargins(Doc.DocumentElement.FindNode('pageMargins'), FWorksheet);
+      ReadPageSetup(Doc.DocumentElement.FindNode('pageSetup'), FWorksheet);
+      ReadHeaderFooter(Doc.DocumentElement.FindNode('headerFooter'), FWorksheet);
+
+      FreeAndNil(Doc);
+
+      { Comments:
+        The comments are stored in separate "comments<n>.xml" files (n = 1, 2, ...)
+        The relationship which comment belongs to which sheet file must be
+        retrieved from the "sheet<n>.xml.rels" file (n = 1, 2, ...).
+        The rels file contains also the second part of the hyperlink data. }
+      fn := OOXML_PATH_XL_WORKSHEETS_RELS + Format('sheet%d.xml.rels', [i+1]);
+      XMLStream := TMemoryStream.Create;
+      try
+        if UnzipToStream(AStream, fn, XMLStream) then
+        begin
+          // Find exact name of comments<n>.xml file
+          ReadXMLStream(Doc, XMLStream);
+          RelsNode := Doc.DocumentElement.FindNode('Relationship');
+          fn_comments := FindCommentsFileName(RelsNode);
+          // Get hyperlink data
+          ReadHyperlinks(RelsNode);
+          FreeAndNil(Doc);
+        end else
+        if (SheetList.Count = 1) then
+          // If the workbook has only one sheet then the sheet.xml.rels file
+          // is missing
+          fn_comments := 'comments1.xml'
+        else
+          // This sheet does not have any cell comments at all
+          continue;
+      finally
+        XMLStream.Free;
+      end;
+
+      // Extract texts from the comments file found and apply to worksheet.
+      if fn_comments <> '' then
+      begin
+        fn := OOXML_PATH_XL + fn_comments;
+        XMLStream := TMemoryStream.Create;
+        try
+          if UnzipToStream(AStream, fn, XMLStream) then
+          begin
+            ReadXMLStream(Doc, XMLStream);
+            ReadComments(Doc.DocumentElement.FindNode('commentList'), FWorksheet);
+            FreeAndNil(Doc);
+          end;
+        finally
+          XMLStream.Free;
+        end;
+      end;
+
+      // Add hyperlinks to cells
+      ApplyHyperlinks(FWorksheet);
+    end;  // for
+
+  finally
+    SheetList.Free;
+    FreeAndNil(Doc);
+  end;
+end;
+
+                                             (*
 procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream);
 begin
   Unused(AStream);
   raise Exception.Create('[TsSpreadOOXMLReader.ReadFromStream] '+
                          'Method not implemented. Use "ReadFromFile" instead.');
 end;
-
+                                               *)
 
 {------------------------------------------------------------------------------}
 {                             TsSpreadOOXMLWriter                              }
@@ -2331,15 +2506,19 @@ end;
 
 { Writes font parameters to the stream.
   ATag is "font" for the entry in "styles.xml", or "rPr" for the entry for
-  richtext parameters in the shared string list. }
+  richtext parameters in the shared string list.
+  ANameTag is "name" for the entry in "styles.xml", or "rFont" for the entry}
 procedure TsSpreadOOXMLWriter.WriteFont(AStream: TStream; AFont: TsFont;
-  ATag: String);
+  UseInStyleNode: Boolean);
+const
+  TAG: Array[boolean] of string = ('rPr', 'font');
+  NAME_TAG: Array[boolean] of String = ('rFont', 'name');
 var
   s: String;
 begin
   s := '';
   s := s + Format('<sz val="%g" />', [AFont.Size], FPointSeparatorSettings);
-  s := s + Format('<name val="%s" />', [AFont.FontName]);
+  s := s + Format('<%s val="%s" />', [NAME_TAG[UseInStyleNode], AFont.FontName]);
   if (fssBold in AFont.Style) then
     s := s + '<b />';
   if (fssItalic in AFont.Style) then
@@ -2355,7 +2534,7 @@ begin
     fpSuperscript: s := s + '<vertAlign val="superscript" />';
   end;
   AppendToStream(AStream, Format(
-    '<%s>%s</%s>', [ATag, s, ATag]));
+    '<%s>%s</%s>', [TAG[UseInStyleNode], s, TAG[UseInStyleNode]]));
 end;
 
 { Writes the fontlist of the workbook to the stream. }
@@ -2368,7 +2547,7 @@ begin
     '<fonts count="%d">', [Workbook.GetFontCount]));
   for i:=0 to Workbook.GetFontCount-1 do begin
     font := Workbook.GetFont(i);
-    WriteFont(AStream, font, 'font');
+    WriteFont(AStream, font, true);
   end;
   AppendToStream(AStream,
     '</fonts>');
@@ -3606,8 +3785,14 @@ var
   CellPosText: string;
   lStyleIndex: Cardinal;
   ResultingValue: string;
+  fnt: TsFont;
+  n: Integer;
+  i: Integer;
+  L: Integer;
+  rtParam: TsRichTextParam;
+  txt: String;
 begin
-  // Office 2007-2010 (at least) support no more characters in a cell;
+  // Office 2007-2010 (at least) supports no more characters in a cell;
   if Length(AValue) > MAXBYTES then
   begin
     ResultingValue := Copy(AValue, 1, MAXBYTES); //may chop off multicodepoint UTF8 characters but well...
@@ -3618,16 +3803,79 @@ begin
   else
     ResultingValue := AValue;
 
-  if not ValidXMLText(ResultingValue) then
+  txt := ResultingValue;
+  if not ValidXMLText(txt) then
     Workbook.AddErrorMsg(
       rsInvalidCharacterInCell, [
       GetCellString(ARow, ACol)
     ]);
 
+  { Write string to SharedString table }
+
+  if Length(ACell^.RichTextParams) = 0 then
+    // unformatted string
     AppendToStream(FSSharedStrings,
       '<si>' +
-      '<t>' + ResultingValue + '</t>' +
+        '<t>' + txt + '</t>' +
+      '</si>')
+  else
+  begin
+    // rich-text formatted string
+    L := UTF8Length(Resultingvalue);
+    AppendToStream(FSSharedStrings,
+      '<si>');
+    rtParam := ACell^.RichTextParams[0];
+    if rtParam.StartIndex > 0 then
+    begin
+      txt := UTF8Copy(ResultingValue, 1, rtParam.StartIndex);
+      ValidXMLText(txt);
+      AppendToStream(FSSharedStrings,
+        '<r>' +
+          '<t>' + txt + '</t>' +
+        '</r>'
+      );
+    end;
+    for i := 0 to High(ACell^.RichTextParams) do
+    begin
+      rtParam := ACell^.RichTextParams[i];
+      fnt := FWorkbook.GetFont(rtParam.FontIndex);
+      n := rtParam.EndIndex - rtParam.StartIndex;
+      txt := UTF8Copy(Resultingvalue, rtParam.StartIndex+1, n);
+      ValidXMLText(txt);
+      AppendToStream(FSSharedStrings,
+        '<r>');
+      WriteFont(FSSharedStrings, fnt, false);  // <rPr> ... font data ... </rPr>
+      AppendToStream(FSSharedStrings,
+          '<t>' + txt + '</t>' +
+        '</r>'
+      );
+      if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
+      begin
+        txt := UTF8Copy(ResultingValue, rtParam.EndIndex+1, MaxInt);
+        ValidXMLText(txt);
+        AppendToStream(FSSharedStrings,
+          '<r>' +
+            '<t>' + txt + '</t>' +
+          '</r>'
+        )
+      end else
+      if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex)
+      then begin
+        n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex;
+        txt := UTF8Copy(Resultingvalue, rtParam.EndIndex+1, n);
+        ValidXMLText(txt);
+        AppendToStream(FSSharedStrings,
+          '<r>' +
+            '<t>' + txt + '</t>' +
+          '</r>'
+        );
+      end;
+    end;
+    AppendToStream(FSSharedStrings,
       '</si>');
+  end;
+
+  { Write shared string index to cell record }
 
   CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
   lStyleIndex := GetStyleIndex(ACell);