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

fpspreadsheet: Fix xls format using incorrect font index in SST (see https://forum.lazarus.freepascal.org/index.php/topic,40784.0.html).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6292 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-05 10:42:01 +00:00
parent 2b912d8e33
commit 56f7814556
3 changed files with 30 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
components/fpspreadsheet/source/common/fpstypes.pas
View File

@ -485,14 +485,9 @@ type
{@@ Parameter describing formatting of an text range in cell text }
TsRichTextParam = record
FirstIndex: Integer; // 1-based utf8 character index
FirstIndex: Integer; // 1-based utf8 code-point ("character") index
FontIndex: Integer;
HyperlinkIndex: Integer;
{
FontIndex: Integer;
StartIndex: Integer; // zero-based
EndIndex: Integer; // zero-based, next character!
}
end;
{@@ Parameters describing formatting of text ranges in cell text }

19
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -159,6 +159,7 @@ function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation):
procedure FixLineEndings(var AText: String; var ARichTextParams: TsRichTextParams);
function RandomString(ALen: Integer): String;
function SameRichTextParams(ARtp1, ARtp2: TsRichTextparams): Boolean;
function SplitStr(const AText: String; ADelimiter: Char): TStringArray;
function UnquoteStr(AString: String): String;
@ -1966,6 +1967,24 @@ begin
Result[i] := char(Random(26) + ord('a'));
end;
{@@ ----------------------------------------------------------------------------
Checks wether ARtp1 and ARtp2 are the same rich-text parameters.
-------------------------------------------------------------------------------}
function SameRichTextParams(ARtp1, ARtp2: TsRichTextparams): Boolean;
var
i: Integer;
begin
Result := false;
if Length(ARtp1) <> Length(ARtp2) then
exit;
for i := 0 to High(ARtp1) do begin
if ARtp1[i].FirstIndex <> ARtp2[i].FirstIndex then exit;
if ARtp1[i].FontIndex <> ARtp2[i].FontIndex then exit;
if ARtp1[i].HyperlinkIndex <> ARtp2[i].HyperlinkIndex then exit;
end;
Result := true;
end;
{@@ ----------------------------------------------------------------------------
Splits a string at the specified delimiters into individual strings and passes
them in an array.

14
components/fpspreadsheet/source/common/xlsbiff8.pas
View File

@ -2211,7 +2211,8 @@ begin
for Result := 0 to FSharedStringTable.Count-1 do begin
s := FSharedStringTable.Strings[Result];
obj := FSharedStringTable.Objects[Result];
if (s = AText) and (TsRichTextParams(obj) = ARichTextParams)
// if (s = AText) and (TsRichTextParams(obj) = ARichTextParams)
if (s = AText) and SameRichTextParams(TsRichTextParams(obj), ARichTextParams)
then exit;
end;
Result := -1;
@ -3739,7 +3740,7 @@ procedure TsSpreadBIFF8Writer.WriteSST(AStream: TStream);
var
sizePos: Int64;
bytesWritten, totalBytesWritten: Integer;
i: Integer;
i, j: Integer;
rtParams: TsRichTextParams;
bytesAvail: Integer;
isASCII: Boolean;
@ -3766,7 +3767,7 @@ begin
AStream.WriteDWord(DWordToLE(FSharedStringTable.Count));
{ Now begins writing of strings. Take care of overflow into following
CONTINUE records if the maximum record size (MaX_BYTES_IN_RECORD) is
CONTINUE records if the maximum record size (MAX_BYTES_IN_RECORD) is
exceeded. }
totalBytesWritten := 8;
for i:=0 to FSharedStringTable.Count-1 do
@ -3793,7 +3794,12 @@ begin
end;
end;
rtParams := TsRichTextParams(FSharedStringTable.Objects[i]);
SetLength(rtParams, Length(TsRichTextParams(FSharedStringTable.Objects[i])));
for j := 0 to High(rtParams) do begin
rtParams[j] := TsRichTextParams(FSharedStringTable.Objects[i])[j];
// Index of new font. Be aware of font #4 missing in BIFF!
if rtParams[j].FontIndex >= 4 then inc(rtParams[j].FontIndex);
end;
textIndex := 1;
rtIndex := 0;