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

fpspreadsheet: Fix writing of rich-text info for biff5 and biff8 in some special cases.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4249 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-04 18:08:10 +00:00
parent 68d15c38a9
commit 63f7b01a76
3 changed files with 74 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
components/fpspreadsheet/xlsbiff5.pas
View File

@ -1460,8 +1460,10 @@ var
buf: array of byte;
useRTF: Boolean;
fmt: PsCellFormat;
run, j: Integer;
i, nRuns: Integer;
rtParam: TsRichTextParam;
rtfRuns: TBiff5_RichTextformattingRuns;
fntIndex, cellFntIndex: Integer;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
@ -1494,6 +1496,47 @@ begin
rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL));
rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L);
{ Prepare rich-text formatting runs }
if useRTF then
begin
fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
cellFntIndex := fmt^.FontIndex;
if cellFntIndex >= 4 then inc(cellFntIndex);
nRuns := 0;
for i := 0 to High(ACell^.RichTextParams) do
begin
// formatted part according to RichTextParams
rtParam := ACell^.RichTextParams[i];
SetLength(rtfRuns, nRuns + 1);
fntIndex := rtParam.FontIndex;
if fntIndex >= 4 then
inc(fntIndex); // Font #4 does not exist in BIFF
rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.StartIndex);
inc(nRuns);
// Unformatted part at end?
if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
begin
SetLength(rtfRuns, nRuns + 1);
rtfRuns[nRuns].FontIndex := WordLEToN(cellFntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.EndIndex);
inc(nRuns);
end else
// Unformatted part between two formatted parts?
if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex) then
begin
SetLengtH(rtfRuns, nRuns + 1);
rtfRuns[nRuns].FontIndex := WordLEToN(cellFntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.EndIndex);
inc(nRuns);
end;
end;
// Adjust BIFF record size for appended formatting runs
inc(rec.RecordSize, SizeOf(word) + nRuns * SizeOf(TBiff5_RichTextFormattingRun));
end;
(*
{ Prepare rich-text formatting runs }
if useRTF then
begin
@ -1522,7 +1565,7 @@ begin
// 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);
rec.Col := WordToLE(ACol);
@ -1545,9 +1588,9 @@ begin
if useRTF then
begin
{ Write number of rich-text formatting runs }
AStream.WriteByte(run);
AStream.WriteByte(nRuns);
{ Write rich-text formatting runs }
AStream.WriteBuffer(rtfRuns[0], run * SizeOf(TBiff5_RichTextFormattingRun));
AStream.WriteBuffer(rtfRuns[0], nRuns * SizeOf(TBiff5_RichTextFormattingRun));
end;
{ Clean up }

39
components/fpspreadsheet/xlsbiff8.pas
View File

@ -131,7 +131,7 @@ type
procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFONT(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream);
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
@ -2188,7 +2188,7 @@ end;
Writes an Excel 8 FONT record.
The font data is passed as an instance of TsFont
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteFont(AStream: TStream; AFont: TsFont);
procedure TsSpreadBIFF8Writer.WriteFONT(AStream: TStream; AFont: TsFont);
var
Len: Byte;
WideFontName: WideString;
@ -2599,11 +2599,13 @@ var
WideValue: WideString;
rec: TBIFF8_LabelRecord;
rtfRuns: TBiff8_RichTextFormattingRuns;
rtParam: TsRichTextParam;
buf: array of byte;
j, nRuns: Integer;
i, nRuns: Integer;
fmt: PsCellFormat;
useRTF: Boolean;
fntIndex: Word;
cellfntIndex: Word;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
@ -2638,25 +2640,34 @@ begin
if useRTF then
begin
fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
cellFntIndex := fmt^.FontIndex;
if cellFntIndex >= 4 then inc(cellFntIndex);
nRuns := 0;
for j:=0 to High(ACell^.RichTextParams) do
for i := 0 to High(ACell^.RichTextParams) do
begin
// formatted part according to RichTextParams
rtParam := ACell^.RichTextParams[i];
SetLength(rtfRuns, nRuns + 1);
fntIndex := ACell^.RichTextParams[j].FontIndex;
fntIndex := rtParam.FontIndex;
if fntIndex >= 4 then
inc(fntIndex); // Font #4 does not exist in BIFF
rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(ACell^.RichTextParams[j].StartIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.StartIndex);
inc(nRuns);
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
// Unformatted part at end?
if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
begin
SetLength(rtfRuns, nRuns + 1);
fntIndex := fmt^.FontIndex;
if fntIndex >= 4 then
inc(fntIndex);
rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(ACell^.RichTextParams[j].EndIndex);
rtfRuns[nRuns].FontIndex := WordLEToN(cellFntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.EndIndex);
inc(nRuns);
end else
// Unformatted part between two formatted parts?
if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex) then
begin
SetLengtH(rtfRuns, nRuns + 1);
rtfRuns[nRuns].FontIndex := WordLEToN(cellFntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.EndIndex);
inc(nRuns);
end;
end;

2
components/fpspreadsheet/xlscommon.pas
View File

@ -387,7 +387,7 @@ type
procedure ReadDateMode(AStream: TStream);
// Reads the default column width
procedure ReadDefColWidth(AStream: TStream);
// Reas the default row height
// Read the default row height
procedure ReadDefRowHeight(AStream: TStream);
// Read FORMAT record (cell formatting)
procedure ReadFormat(AStream: TStream); virtual;