pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4226 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-07-30 16:28:30 +00:00
parent 56a82b945b
commit 954be7d438
6 changed files with 36 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/fpsutils.pas
View File

@ -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;';

2
components/fpspreadsheet/xlsbiff2.pas
View File

@ -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,

2
components/fpspreadsheet/xlsbiff5.pas
View File

@ -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

6
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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

23
components/fpspreadsheet/xlscommon.pas
View File

@ -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;

10
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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;