From 63f7b01a761f9c75a993b317cc6e2b591ca5d002 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 4 Aug 2015 18:08:10 +0000 Subject: [PATCH] fpspreadsheet: Fix writing of rich-text info for biff5 and biff8 in some special cases. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4249 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/xlsbiff5.pas | 51 ++++++++++++++++++++++++-- components/fpspreadsheet/xlsbiff8.pas | 41 +++++++++++++-------- components/fpspreadsheet/xlscommon.pas | 2 +- 3 files changed, 74 insertions(+), 20 deletions(-) diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index e6be37d0f..8ca422942 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -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 } diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 62ec4775e..290671940 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -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; @@ -1242,7 +1242,7 @@ begin //Reads the shared string table, only compatible with BIFF8 if not Assigned(FSharedStringTable) then begin //First time SST creation - FSharedStringTable:=TStringList.Create; + FSharedStringTable := TStringList.Create; // Total number of strings in the workbook, not used DWordLEtoN(AStream.ReadDWord); @@ -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; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 5a6778b85..5b79aecd9 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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;