fpspreadsheet: Fix writing rich-text to xlsx (Error when Excel opens this file). Fix writing multiline cell texts containing a CR as line ending which is not accepted by xls.

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

components/fpspreadsheet/fpsutils.pas

@@ -52,7 +52,7 @@ function WordLEtoN(AValue: Word): Word;
 function DWordLEtoN(AValue: Cardinal): Cardinal;
 function WideStringLEToN(const AValue: WideString): WideString;
 
-// Other routines
+// Cell, column and row strings
 function ParseIntervalString(const AStr: string;
   out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
   out ADirection: TsSelectionDirection): Boolean;
@@ -1534,6 +1534,7 @@ begin
       '"': Result := Result + '"';
       '''':Result := Result + ''';
       '%': Result := Result + '%';
+      {     this breaks multi-line labels in xlsx
       #10: begin
              Result := Result + '<br />';
              if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx);
@@ -1542,6 +1543,7 @@ begin
              Result := Result + '<br />';
              if (idx < Length(AText)) and (AText[idx+1] = #10) then inc(idx);
            end;
+           }
       {
       #10: WrkStr := WrkStr + '&#10;';
       #13: WrkStr := WrkStr + '&#13;';

components/fpspreadsheet/xlsbiff2.pas

@@ -1836,7 +1836,7 @@ begin
 
   if AValue = '' then Exit; // Writing an empty text doesn't work
 
-  AnsiText := UTF8ToISO_8859_1(AValue);
+  AnsiText := UTF8ToISO_8859_1(FixLineEnding(AValue));
 
   if Length(AnsiText) > MAXBYTES then begin
     // BIFF 5 does not support labels/text bigger than 255 chars,

components/fpspreadsheet/xlsbiff5.pas

@@ -1465,7 +1465,7 @@ begin
   if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
     exit;
 
-  ansiValue := ConvertEncoding(AValue, encodingUTF8, FCodePage);
+  ansiValue := ConvertEncoding(FixLineEnding(AValue), encodingUTF8, FCodePage);
   if AnsiValue = '' then begin
     // Bad formatted UTF8String (maybe ANSI?)
     if Length(AValue) <> 0 then begin

components/fpspreadsheet/xlsbiff8.pas

@@ -141,7 +141,7 @@ type
     procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet);
     procedure WriteHyperlinkToolTip(AStream: TStream; const ARow, ACol: Cardinal;
       const ATooltip: String);
-    procedure WriteIndex(AStream: TStream);
+    procedure WriteINDEX(AStream: TStream);
     procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: string; ACell: PCell); override;
     procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet);
@@ -2613,7 +2613,7 @@ end;
 
     nm = (rl - rf - 1) / 32 + 1 (using integer division)
 -------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteIndex(AStream: TStream);
+procedure TsSpreadBIFF8Writer.WriteINDEX(AStream: TStream);
 begin
   { BIFF Record header }
   WriteBIFFHeader(AStream, INT_EXCEL_ID_INDEX, 16);
@@ -2664,7 +2664,7 @@ begin
   if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
     exit;
 
-  WideValue := UTF8Decode(AValue); //to UTF16
+  WideValue := UTF8Decode(FixLineEnding(AValue)); //to UTF16
   if WideValue = '' then begin
     // Badly formatted UTF8String (maybe ANSI?)
     if Length(AValue)<>0 then begin

components/fpspreadsheet/xlscommon.pas

@@ -460,6 +460,7 @@ type
     FPalette: TsPalette;
     procedure AddBuiltinNumFormats; override;
     function FindXFIndex(ACell: PCell): Integer; virtual;
+    function FixLineEnding(const AText: String): String;
     function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
     function GetLastColIndex(AWorksheet: TsWorksheet): Word;
     function GetPrintOptions: Word; virtual;
@@ -2414,6 +2415,28 @@ begin
   Result := LAST_BUILTIN_XF + ACell^.FormatIndex;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  The line separator for multi-line text in label cells is accepted by xls
+  to be either CRLF or LF, CR does not work.
+  This procedure replaces accidentally used single CR characters by LF.
+-------------------------------------------------------------------------------}
+function TsSpreadBIFFWriter.FixLineEnding(const AText: String): String;
+var
+  i: Integer;
+begin
+  Result := AText;
+  if Result = '' then
+    exit;
+  // if the last character is a #13 it cannot be part of a CRLF --> replace by #10
+  if Result[Length(Result)] = #13 then
+    Result[Length(Result)] := #10;
+  // In the rest of the string replace all #13 (which are not followed by a #10)
+  // by #10.
+  for i:=1 to Length(Result)-1 do
+    if (Result[i] = #13) and (Result[i+1] <> #10) then
+      Result[i] := #10;
+end;
+
 function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
 begin
   Result := AWorksheet.GetLastRowIndex;

components/fpspreadsheet/xlsxooxml.pas

@@ -3853,7 +3853,7 @@ begin
     // unformatted string
     AppendToStream(FSSharedStrings,
       '<si>' +
-        '<t>' + txt + '</t>' +
+        '<t xml:space="preserve">' + txt + '</t>' +
       '</si>')
   else
   begin
@@ -3868,7 +3868,7 @@ begin
       ValidXMLText(txt);
       AppendToStream(FSSharedStrings,
         '<r>' +
-          '<t>' + txt + '</t>' +
+          '<t xml:space="preserve">' + txt + '</t>' +
         '</r>'
       );
     end;
@@ -3883,7 +3883,7 @@ begin
         '<r>');
       WriteFont(FSSharedStrings, fnt, false);  // <rPr> ... font data ... </rPr>
       AppendToStream(FSSharedStrings,
-          '<t>' + txt + '</t>' +
+          '<t xml:space="preserve">' + txt + '</t>' +
         '</r>'
       );
       if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
@@ -3892,7 +3892,7 @@ begin
         ValidXMLText(txt);
         AppendToStream(FSSharedStrings,
           '<r>' +
-            '<t>' + txt + '</t>' +
+            '<t xml:space="preserve">' + txt + '</t>' +
           '</r>'
         )
       end else
@@ -3903,7 +3903,7 @@ begin
         ValidXMLText(txt);
         AppendToStream(FSSharedStrings,
           '<r>' +
-            '<t>' + txt + '</t>' +
+            '<t xml:space="preserve">' + txt + '</t>' +
           '</r>'
         );
       end;