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; buf: array of byte;
useRTF: Boolean; useRTF: Boolean;
fmt: PsCellFormat; fmt: PsCellFormat;
run, j: Integer; i, nRuns: Integer;
rtParam: TsRichTextParam;
rtfRuns: TBiff5_RichTextformattingRuns; rtfRuns: TBiff5_RichTextformattingRuns;
fntIndex, cellFntIndex: Integer;
begin begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit; exit;
@ -1494,6 +1496,47 @@ begin
rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL)); rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL));
rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L); 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 } { Prepare rich-text formatting runs }
if useRTF then if useRTF then
begin begin
@ -1522,7 +1565,7 @@ begin
// Adjust BIFF record size for appended formatting runs // Adjust BIFF record size for appended formatting runs
inc(rec.RecordSize, SizeOf(byte) + run * SizeOf(TBiff5_RichTextFormattingRun)); inc(rec.RecordSize, SizeOf(byte) + run * SizeOf(TBiff5_RichTextFormattingRun));
end; end;
*)
{ BIFF record data } { BIFF record data }
rec.Row := WordToLE(ARow); rec.Row := WordToLE(ARow);
rec.Col := WordToLE(ACol); rec.Col := WordToLE(ACol);
@ -1545,9 +1588,9 @@ begin
if useRTF then if useRTF then
begin begin
{ Write number of rich-text formatting runs } { Write number of rich-text formatting runs }
AStream.WriteByte(run); AStream.WriteByte(nRuns);
{ Write rich-text formatting runs } { Write rich-text formatting runs }
AStream.WriteBuffer(rtfRuns[0], run * SizeOf(TBiff5_RichTextFormattingRun)); AStream.WriteBuffer(rtfRuns[0], nRuns * SizeOf(TBiff5_RichTextFormattingRun));
end; end;
{ Clean up } { Clean up }

41
components/fpspreadsheet/xlsbiff8.pas
View File

@ -131,7 +131,7 @@ type
procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont); procedure WriteFONT(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream); procedure WriteFonts(AStream: TStream);
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String; procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override; ANumFormatIndex: Integer); override;
@ -1242,7 +1242,7 @@ begin
//Reads the shared string table, only compatible with BIFF8 //Reads the shared string table, only compatible with BIFF8
if not Assigned(FSharedStringTable) then begin if not Assigned(FSharedStringTable) then begin
//First time SST creation //First time SST creation
FSharedStringTable:=TStringList.Create; FSharedStringTable := TStringList.Create;
// Total number of strings in the workbook, not used // Total number of strings in the workbook, not used
DWordLEtoN(AStream.ReadDWord); DWordLEtoN(AStream.ReadDWord);
@ -2188,7 +2188,7 @@ end;
Writes an Excel 8 FONT record. Writes an Excel 8 FONT record.
The font data is passed as an instance of TsFont 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 var
Len: Byte; Len: Byte;
WideFontName: WideString; WideFontName: WideString;
@ -2599,11 +2599,13 @@ var
WideValue: WideString; WideValue: WideString;
rec: TBIFF8_LabelRecord; rec: TBIFF8_LabelRecord;
rtfRuns: TBiff8_RichTextFormattingRuns; rtfRuns: TBiff8_RichTextFormattingRuns;
rtParam: TsRichTextParam;
buf: array of byte; buf: array of byte;
j, nRuns: Integer; i, nRuns: Integer;
fmt: PsCellFormat; fmt: PsCellFormat;
useRTF: Boolean; useRTF: Boolean;
fntIndex: Word; fntIndex: Word;
cellfntIndex: Word;
begin begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit; exit;
@ -2638,25 +2640,34 @@ begin
if useRTF then if useRTF then
begin begin
fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
cellFntIndex := fmt^.FontIndex;
if cellFntIndex >= 4 then inc(cellFntIndex);
nRuns := 0; nRuns := 0;
for j:=0 to High(ACell^.RichTextParams) do for i := 0 to High(ACell^.RichTextParams) do
begin begin
// formatted part according to RichTextParams
rtParam := ACell^.RichTextParams[i];
SetLength(rtfRuns, nRuns + 1); SetLength(rtfRuns, nRuns + 1);
fntIndex := ACell^.RichTextParams[j].FontIndex; fntIndex := rtParam.FontIndex;
if fntIndex >= 4 then if fntIndex >= 4 then
inc(fntIndex); // Font #4 does not exist in BIFF inc(fntIndex); // Font #4 does not exist in BIFF
rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex); rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex);
rtfRuns[nRuns].FirstIndex := WordLEToN(ACell^.RichTextParams[j].StartIndex); rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.StartIndex);
inc(nRuns); inc(nRuns);
if (ACell^.RichTextParams[j].EndIndex < L) and // Unformatted part at end?
(ACell^.RichTextParams[j].EndIndex <> ACell^.RichTextParams[j+1].StartIndex) // wp: j+1 needs to be checked! if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
then begin begin
SetLength(rtfRuns, nRuns + 1); SetLength(rtfRuns, nRuns + 1);
fntIndex := fmt^.FontIndex; rtfRuns[nRuns].FontIndex := WordLEToN(cellFntIndex);
if fntIndex >= 4 then rtfRuns[nRuns].FirstIndex := WordLEToN(rtParam.EndIndex);
inc(fntIndex); inc(nRuns);
rtfRuns[nRuns].FontIndex := WordLEToN(fntIndex); end else
rtfRuns[nRuns].FirstIndex := WordLEToN(ACell^.RichTextParams[j].EndIndex); // 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); inc(nRuns);
end; end;
end; end;

2
components/fpspreadsheet/xlscommon.pas
View File

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