diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas index 0a02a098c..09582b171 100644 --- a/components/fpspreadsheet/fpshtml.pas +++ b/components/fpspreadsheet/fpshtml.pas @@ -1198,9 +1198,9 @@ begin textp := textp + ''; rtParam := ACell^.RichTextParams[0]; // Part before first formatted section (has cell fnt) - if rtParam.StartIndex > 0 then + if rtParam.FirstIndex > 1 then begin - txt := UTF8Copy(AValue, 1, rtParam.StartIndex); + txt := UTF8Copy(AValue, 1, rtParam.FirstIndex - 1); ValidXMLText(txt); if cellfnt.Position <> fpNormal then txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[cellFnt.Position], txt]); @@ -1214,31 +1214,14 @@ begin style := GetFontAsStyle(rtParam.FontIndex); if style <> '' then style := ' style="' + style +'"'; - n := rtParam.EndIndex - rtParam.StartIndex; - txt := UTF8Copy(AValue, rtParam.StartIndex+1, n); + if i = High(ACell^.RichTextParams) then + n := len - rtParam.FirstIndex else + n := ACell^.RichTextParams[i+1].FirstIndex - rtParam.FirstIndex; + txt := UTF8Copy(AValue, rtParam.FirstIndex, n); ValidXMLText(txt); if fnt.Position <> fpNormal then txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[fnt.Position], txt]); textp := textp + '' + txt + ''; - // unformatted section before end - if (rtParam.EndIndex < len) and (i = High(ACell^.RichTextParams)) then - begin - txt := UTF8Copy(AValue, rtParam.EndIndex+1, MaxInt); - ValidXMLText(txt); - if cellFnt.Position <> fpNormal then - txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[cellFnt.Position], txt]); - textp := textp + txt; - end else - // unformatted section between two formatted sections - if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex) - then begin - n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex; - txt := UTF8Copy(AValue, rtParam.EndIndex+1, n); - ValidXMLText(txt); - if cellFnt.Position <> fpNormal then - txt := Format('<%0:s>%1:s', [ESCAPEMENT_TAG[cellFnt.Position], txt]); - textp := textp + txt; - end; end; if target <> '' then textp := textp + '' else diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index b700c1712..5c7d09e5e 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -2261,12 +2261,12 @@ begin if idx > -1 then begin SetLength(rtParams, Length(rtParams)+1); + rtParams[High(rtParams)].FirstIndex := UTF8Length(cellText) + 1; // 1-based character index rtParams[High(rtParams)].FontIndex := FCellFormatList[idx]^.FontIndex; - rtParams[High(rtParams)].StartIndex := Length(cellText); - rtParams[High(rtParams)].EndIndex := Length(cellText + spanText); + rtParams[High(rtParams)].HyperlinkIndex := -1; // TO DO !!!! end; end; - AddToCelLText(spanText); + AddToCellText(spanText); end; end; subnode := subnode.NextSibling; @@ -5644,7 +5644,7 @@ var fntName: String; hyperlink: PsHyperlink; u: TUri; - i, idx, fntidx, len: Integer; + i, idx, endidx, fntidx, len: Integer; rtParam: TsRichTextParam; wideStr, txt: WideString; ch: WideChar; @@ -5750,16 +5750,16 @@ begin else begin // "Rich-text" formatting - wideStr := UTF8Encode(AValue); // Convert to unicode - // Before the first formatted section which has the cell's format + wideStr := UTF8Decode(AValue); // Convert to unicode + // Before the first formatted section having the cell's format len := Length(wideStr); totaltxt := ''; rtParam := ACell^.RichTextParams[0]; idx := 1; txt := ''; - if rtParam.StartIndex > 0 then + if rtParam.FirstIndex > 1 then begin - while (idx <= len) and (idx <= rtParam.StartIndex) do + while (idx <= len) and (idx < rtParam.FirstIndex) do begin ch := wideStr[idx]; if NewLine(idx) then @@ -5770,17 +5770,19 @@ begin end; if txt <> '' then AppendTxt(false, ''); -// totaltxt := totaltxt + UTF8Encode(txt); end; txt := ''; for i := 0 to High(ACell^.RichTextParams) do begin - // Formatted part of the string according the RichTextParam + // Formatted parts of the string according the RichTextParams rtParam := ACell^.RichTextParams[i]; fnt := FWorkbook.GetFont(rtParam.FontIndex); fntidx := FRichTextFontList.IndexOfObject(fnt); fntName := FRichTextFontList[fntIdx]; - while (idx <= len) and (idx <= rtParam.EndIndex) do + if i < High(ACell^.RichTextParams) then + endidx := ACell^.RichTextParams[i+1].FirstIndex-1 else + endidx := len; + while (idx <= len) and (idx <= endidx) do begin ch := wideStr[idx]; if NewLine(idx) then @@ -5791,36 +5793,6 @@ begin end; if txt <> '' then AppendTxt(false, fntName); - // Unformatted part at end of string (cell's format) - if (rtParam.EndIndex < len) and (i = High(ACell^.RichTextParams)) then - begin - while (idx <= len) do - begin - ch := wideStr[idx]; - if NewLine(idx) then - AppendTxt(true, '') - else - txt := txt + ch; - inc(idx); - end; - if txt <> '' then - AppendTxt(false, ''); - end - else - // Unformatted part between formatted parts (cll's format) - if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex) - then begin - while (idx <= len) and (idx <= ACell^.RichTextParams[i+1].StartIndex) do begin - ch := wideStr[idx]; - if NewLine(idx) then - AppendTxt(true, '') - else - txt := txt + ch; - inc(idx); - end; - if txt <> '' then - AppendTxt(false, ''); - end; end; totaltxt := totaltxt + ''; end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 383274074..12ee3947c 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -442,7 +442,8 @@ type // Searching function Search(ASearchText: String; AOptions: TsSearchOptions; - AStartRow: Cardinal = $FFFFFFFF; AStartCol: Cardinal = $FFFFFFFF): PCell; + AStartRow: Cardinal = UNASSIGNED_ROW_COL_INDEX; + AStartCol: Cardinal = UNASSIGNED_ROW_COL_INDEX): PCell; // Comments function FindComment(ACell: PCell): PsComment; @@ -725,8 +726,8 @@ type { Searching } function Search(ASearchText: String; AOptions: TsSearchOptions; - AStartSheet: TsWorksheet = nil; AStartRow: Cardinal = $FFFFFFFF; - AStartCol: Cardinal = $FFFFFFFF): PCell; + AStartSheet: TsWorksheet = nil; AStartRow: Cardinal = UNASSIGNED_ROW_COL_INDEX; + AStartCol: Cardinal = UNASSIGNED_ROW_COL_INDEX): PCell; { Utilities } procedure UpdateCaches; @@ -954,13 +955,13 @@ begin FDefaultColWidth := 12; FDefaultRowHeight := 1; - FFirstRowIndex := $FFFFFFFF; - FFirstColIndex := $FFFFFFFF; - FLastRowIndex := $FFFFFFFF; - FLastColIndex := $FFFFFFFF; + FFirstRowIndex := UNASSIGNED_ROW_COL_INDEX; + FFirstColIndex := UNASSIGNED_ROW_COL_INDEX; + FLastRowIndex := UNASSIGNED_ROW_COL_INDEX; + FLastColIndex := UNASSIGNED_ROW_COL_INDEX; - FActiveCellRow := Cardinal(-1); - FActiveCellCol := Cardinal(-1); + FActiveCellRow := UNASSIGNED_ROW_COL_INDEX; // Cardinal(-1); + FActiveCellCol := UNASSIGNED_ROW_COL_INDEX; // Cardinal(-1); FOptions := [soShowGridLines, soShowHeaders]; end; @@ -1916,14 +1917,22 @@ end; function TsWorksheet.AddCell(ARow, ACol: Cardinal): PCell; begin Result := Cells.AddCell(ARow, ACol); - if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true) - else FFirstColIndex := Min(FFirstColIndex, ACol); - if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true) - else FFirstRowIndex := Min(FFirstRowIndex, ARow); - if FLastColIndex = $FFFFFFFF then FLastColIndex := GetLastColIndex(true) - else FLastColIndex := Max(FLastColIndex, ACol); - if FLastRowIndex = $FFFFFFFF then FLastRowIndex := GetLastRowIndex(true) - else FLastRowIndex := Max(FLastRowIndex, ARow); + + if FFirstColIndex = UNASSIGNED_ROW_COL_INDEX then + FFirstColIndex := GetFirstColIndex(true) else + FFirstColIndex := Min(FFirstColIndex, ACol); + + if FFirstRowIndex = UNASSIGNED_ROW_COL_INDEX then + FFirstRowIndex := GetFirstRowIndex(true) else + FFirstRowIndex := Min(FFirstRowIndex, ARow); + + if FLastColIndex = UNASSIGNED_ROW_COL_INDEX then + FLastColIndex := GetLastColIndex(true) else + FLastColIndex := Max(FLastColIndex, ACol); + + if FLastRowIndex = UNASSIGNED_ROW_COL_INDEX then + FLastRowIndex := GetLastRowIndex(true) else + FLastRowIndex := Max(FLastRowIndex, ARow); end; {@@ ---------------------------------------------------------------------------- @@ -2160,7 +2169,7 @@ var begin if AForceCalculation then begin - Result := Cardinal(-1); + Result := UNASSIGNED_ROW_COL_INDEX; for cell in FCells do Result := Math.Min(Result, cell^.Col); // In addition, there may be column records defining the column width even @@ -2174,7 +2183,7 @@ begin else begin Result := FFirstColIndex; - if Result = cardinal(-1) then + if Result = UNASSIGNED_ROW_COL_INDEX then Result := GetFirstColIndex(true); end; end; @@ -2200,7 +2209,7 @@ function TsWorksheet.GetLastColIndex(AForceCalculation: Boolean = false): Cardin var i: Integer; begin - if AForceCalculation or (FLastColIndex = $FFFFFFFF) then + if AForceCalculation or (FLastColIndex = UNASSIGNED_ROW_COL_INDEX) then begin // Traverse the tree from lowest to highest. // Since tree primary sort order is on row highest col could exist anywhere. @@ -2265,7 +2274,7 @@ var begin if AForceCalculation then begin - Result := $FFFFFFFF; + Result := UNASSIGNED_ROW_COL_INDEX; cell := FCells.GetFirstCell; if cell <> nil then Result := cell^.Row; // In addition, there may be row records even for rows without cells. @@ -2278,7 +2287,7 @@ begin else begin Result := FFirstRowIndex; - if Result = Cardinal(-1) then + if Result = UNASSIGNED_ROW_COL_INDEX then Result := GetFirstRowIndex(true); end; end; @@ -2303,7 +2312,7 @@ function TsWorksheet.GetLastRowIndex(AForceCalculation: Boolean = false): Cardin var i: Integer; begin - if AForceCalculation or (FLastRowIndex = $FFFFFFFF) then + if AForceCalculation or (FLastRowIndex = UNASSIGNED_ROW_COL_INDEX) then begin // Index of highest row with at least one existing cell Result := GetLastOccupiedRowIndex; @@ -3542,7 +3551,8 @@ end; first cell meeting the criteria. -------------------------------------------------------------------------------} function TsWorksheet.Search(ASearchText: String; AOptions: TsSearchOptions; - AStartRow: Cardinal = $FFFFFFFF; AStartCol: Cardinal = $FFFFFFFF): PCell; + AStartRow: Cardinal = UNASSIGNED_ROW_COL_INDEX; + AStartCol: Cardinal = UNASSIGNED_ROW_COL_INDEX): PCell; var regex: TRegExpr; cell, startCell: PCell; @@ -3577,12 +3587,12 @@ begin // Find first occupied cell to start with if (soBackward in AOptions) then begin - if AStartRow = $FFFFFFFF then AStartRow := lastR; - if AStartCol = $FFFFFFFF then AStartCol := lastC; + if AStartRow = UNASSIGNED_ROW_COL_INDEX then AStartRow := lastR; + if AStartCol = UNASSIGNED_ROW_COL_INDEX then AStartCol := lastC; end else begin - if AStartRow = $FFFFFFFF then AStartRow := firstR; - if AStartCol = $FFFFFFFF then AStartCol := firstC; + if AStartRow = UNASSIGNED_ROW_COL_INDEX then AStartRow := firstR; + if AStartCol = UNASSIGNED_ROW_COL_INDEX then AStartCol := firstC; end; startcell := FindCell(AStartRow, AStartCol); if startcell = nil then @@ -3805,11 +3815,10 @@ begin ACell^.ContentType := cctUTF8String; ACell^.UTF8StringValue := AText; - if Length(ARichTextParams) > 0 then begin - SetLength(ACell^.RichTextParams, Length(ARichTextParams)); + SetLength(ACell^.RichTextParams, Length(ARichTextParams)); + if Length(ARichTextParams) > 0 then for i:=0 to High(ARichTextParams) do ACell^.RichTextParams[i] := ARichTextParams[i]; - end; ChangedCell(ACell^.Row, ACell^.Col); end; @@ -5779,10 +5788,10 @@ begin FillChar(Result^, SizeOf(TCol), #0); Result^.Col := ACol; FCols.Add(Result); - if FFirstColIndex = $FFFFFFFF + if FFirstColIndex = UNASSIGNED_ROW_COL_INDEX then FFirstColIndex := GetFirstColIndex(true) else FFirstColIndex := Min(FFirstColIndex, ACol); - if FLastColIndex = $FFFFFFFF + if FLastColIndex = UNASSIGNED_ROW_COL_INDEX then FLastColIndex := GetLastColIndex(true) else FLastColIndex := Max(FLastColIndex, ACol); end; @@ -6386,8 +6395,8 @@ end; a specified text. -------------------------------------------------------------------------------} function TsWorkbook.Search(ASearchText: String; AOptions: TsSearchOptions; - AStartSheet: TsWorksheet = nil; AStartRow: Cardinal = $FFFFFFFF; - AStartCol: Cardinal = $FFFFFFFF): PCell; + AStartSheet: TsWorksheet = nil; AStartRow: Cardinal = UNASSIGNED_ROW_COL_INDEX; + AStartCol: Cardinal = UNASSIGNED_ROW_COL_INDEX): PCell; var i, idxSheet: Integer; sheet: TsWorksheet; @@ -6395,19 +6404,19 @@ begin // Setup missing default parameters if soBackward in AOptions then begin - if (AStartRow = $FFFFFFFF) and (AStartCol = $FFFFFFFF) and (AStartSheet = nil) + if (AStartRow = UNASSIGNED_ROW_COL_INDEX) and (AStartCol = UNASSIGNED_ROW_COL_INDEX) and (AStartSheet = nil) then AStartsheet := GetWorksheetByIndex(GetWorksheetCount-1); - if AStartRow = $FFFFFFFF then + if AStartRow = UNASSIGNED_ROW_COL_INDEX then AStartRow := AStartsheet.GetLastRowIndex; - if AStartCol = $FFFFFFFF then + if AStartCol = UNASSIGNED_ROW_COL_INDEX then AStartCol := AStartsheet.GetLastColIndex; end else begin - if (AStartRow = $FFFFFFFF) and (AStartCol = $FFFFFFFF) and (AStartSheet = nil) + if (AStartRow = UNASSIGNED_ROW_COL_INDEX) and (AStartCol = UNASSIGNED_ROW_COL_INDEX) and (AStartSheet = nil) then AStartsheet := GetWorksheetByIndex(0); - if (AStartRow = $FFFFFFFF) then + if (AStartRow = UNASSIGNED_ROW_COL_INDEX) then AStartRow := AStartsheet.GetFirstRowIndex; - if (AStartCol = $FFFFFFFF) then + if (AStartCol = UNASSIGNED_ROW_COL_INDEX) then AStartCol := AStartsheet.GetFirstColIndex; end; if AStartSheet = nil then diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 0da168407..a01f1332c 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -2725,7 +2725,7 @@ begin begin s := ''; for rtp in ACell^.RichTextParams do - s := Format('%s; Font #%d @ %d-%d', [s, rtp.FontIndex, rtp.StartIndex, rtp.EndIndex]); + s := Format('%s; Font #%d after pos %d', [s, rtp.FontIndex, rtp.FirstIndex]); Delete(s, 1, 2); if s = '' then s := '(none)'; AStrings.Add('Rich-text parameters='+s); diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index cdd7e1a48..7912ee9c1 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -1878,7 +1878,7 @@ begin // Because of possible cell overflow from cells left of the visible range // we have to seek to the left for the first occupied text cell // and start painting from here. - if FTextOverflow and (sr <> Cardinal(-1)) and Assigned(Worksheet) then + if FTextOverflow and (sr <> UNASSIGNED_ROW_COL_INDEX) and Assigned(Worksheet) then while (gc > FixedCols) do begin dec(gc); @@ -1904,7 +1904,7 @@ begin // Now find the last column. Again text can overflow into the visible area // from cells to the right. gcLast := Right; - if FTextOverflow and (sr <> Cardinal(-1)) and Assigned(Worksheet) then + if FTextOverflow and (sr <> UNASSIGNED_ROW_COL_INDEX) and Assigned(Worksheet) then begin gcLastUsed := GetGridCol(scLastUsed); while (gcLast < ColCount-1) and (gcLast < gcLastUsed) do begin @@ -3011,7 +3011,7 @@ end; function TsCustomWorksheetGrid.GetWorksheetCol(AGridCol: Integer): cardinal; begin if (FHeaderCount > 0) and (AGridCol = 0) then - Result := Cardinal(-1) + Result := UNASSIGNED_ROW_COL_INDEX else Result := AGridCol - FHeaderCount; end; @@ -3027,7 +3027,7 @@ end; function TsCustomWorksheetGrid.GetWorksheetRow(AGridRow: Integer): Cardinal; begin if (FHeaderCount > 0) and (AGridRow = 0) then - Result := Cardinal(-1) + Result := UNASSIGNED_ROW_COL_INDEX else Result := AGridRow - FHeaderCount; end; diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 6233d4e88..5651ce00d 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -51,6 +51,9 @@ const {@@ Maximum count of worksheet columns} MAX_COL_COUNT = 65535; + {@@ Unassigned row/col index } + UNASSIGNED_ROW_COL_INDEX = $FFFFFFFF; + {@@ Name of the default font} DEFAULT_FONTNAME = 'Arial'; {@@ Size of the default font} @@ -426,14 +429,20 @@ type {@@ Parameter describing formatting of an text range in cell text } TsRichTextParam = record + FirstIndex: Integer; // 1-based utf8 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 } TsRichTextParams = array of TsRichTextParam; + (* {@@ Excel rich-text formatting run } TsRichTextFormattingRun = packed record FirstIndex: Integer; @@ -442,6 +451,7 @@ type {@@ Array of Excel rich-text formatting runs } TsRichTextFormattingRuns = array of TsRichTextFormattingRun; + *) {@@ Indicates the border for a cell. If included in the CellBorders set the corresponding border is drawn in the style defined by the CellBorderStyle. } diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index b269e9644..afd8a60a9 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -131,6 +131,7 @@ function TintedColor(AColor: TsColor; tint: Double): TsColor; function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String; +procedure FixLineEndings(var AText: String; var ARichTextParams: TsRichTextParams); function UnquoteStr(AString: String): String; function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1; @@ -1665,6 +1666,34 @@ begin RemoveChars(0, coEqual); end; +{@@ ---------------------------------------------------------------------------- + Replaces CRLF line endings by LF (#10) alone because this is what xml returns. + This is required to keep the character indexes of the rich text formatting + runs in synch when reading xml files. +-------------------------------------------------------------------------------} +procedure FixLineEndings(var AText: String; var ARichTextParams: TsRichTextParams); +var + i, j: Integer; +begin + if AText = '' then + exit; + + i := 1; + if AText[Length(AText)] = #13 then + Delete(AText, Length(AText), 1); + + while i <= Length(AText) - 1 do + begin + if (AText[i] = #13) and (AText[i+1] = #10) then + begin + Delete(AText, i, 1); + for j := 0 to High(ARichTextParams) do + if ARichTextParams[j].FirstIndex > i then dec(ARichTextParams[j].FirstIndex); + end; + inc(i); + end; +end; + {@@ ---------------------------------------------------------------------------- Removes quotation characters which enclose a string -------------------------------------------------------------------------------} diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas index 288760da9..06112a990 100644 --- a/components/fpspreadsheet/fpsvisualutils.pas +++ b/components/fpspreadsheet/fpsvisualutils.pas @@ -176,129 +176,120 @@ procedure InternalDrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; const ARect: TRect; const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment; - ARotation: TsTextRotation; AOverrideTextColor: TColor; - var Width,Height: Integer; AMeasureOnly: Boolean); + ARotation: TsTextRotation; AOverrideTextColor: TColor; AMeasureOnly: Boolean; + var AWidth, AHeight: Integer); type TLineInfo = record pStart, pEnd: PChar; NumSpaces: Integer; - FirstRtpIndex: Integer; - NextRtpIndex: Integer; + BeginsWithFontOfRtpIndex: Integer; Width: Integer; Height: Integer; end; - TRtState = (rtEnter, rtExit); var xpos, ypos: Integer; p, pStartText: PChar; - iRtp: Integer; + rtpIndex: Integer; lineInfo: TLineInfo; lineInfos: Array of TLineInfo = nil; totalHeight, linelen, stackPeriod: Integer; + charPos: Integer; + fontpos: TsFontPosition; + fontHeight: Integer; - procedure InitFont(P: PChar; out rtState: TRtState; - PendingRtpIndex: Integer; out AHeight: Integer; out AFontPos: TsFontPosition); + procedure InitFont(out ARtpFontIndex: Integer; out AFontHeight: Integer; + out AFontPos: TsFontPosition); var fnt: TsFont; - hasRtp: Boolean; - rtp: TsRichTextParam; + rtParam: TsRichTextParam; begin - fnt := AWorkbook.GetFont(AFontIndex); - hasRtp := PendingRtpIndex >= 0; - if hasRTP and (PendingRtpIndex < Length(ARichTextParams)) then begin - rtp := ARichTextParams[PendingRtpIndex]; - if p - pStartText >= rtp.StartIndex then - begin - fnt := AWorkbook.GetFont(rtp.FontIndex); - rtState := rtEnter; - end else - rtState := rtExit; + if (Length(ARichTextParams) > 0) and (charPos >= ARichTextParams[0].FirstIndex) then + begin + ARtpFontIndex := 0; + fnt := AWorkbook.GetFont(ARichTextParams[0].FontIndex); + end else + begin + ARtpFontIndex := -1; + fnt := AWorkbook.GetFont(AFontIndex); end; Convert_sFont_to_Font(fnt, ACanvas.Font); - AHeight := ACanvas.TextHeight('Tg'); + AFontHeight := ACanvas.TextHeight('Tg'); if (fnt <> nil) and (fnt.Position <> fpNormal) then ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); AFontPos := fnt.Position; end; - procedure UpdateFont(P:PChar; var rtState: TRtState; - var PendingRtpIndex: Integer; var AHeight: Integer; - var AFontPos: TsFontPosition); + procedure UpdateFont(ACharPos: Integer; var ARtpFontIndex: Integer; + var AFontHeight: Integer; var AFontPos: TsFontPosition); var - hasRtp: Boolean; - rtp: TsRichTextParam; + rtParam: TsRichTextParam; fnt: TsFont; + endPos: Integer; begin - fnt := AWorkbook.GetFont(AFontIndex); - hasRtp := PendingRtpIndex >= 0; - if hasRtp and (PendingRtpIndex < Length(ARichTextParams)) then - begin - rtp := ARichTextParams[PendingRtpIndex]; - if (p - pStartText >= rtp.StartIndex) and (rtState = rtExit) then - begin - fnt := AWorkbook.GetFont(rtp.FontIndex); - Convert_sFont_to_Font(fnt, ACanvas.Font); - AHeight := ACanvas.TextHeight('Tg'); - if fnt.Position <> fpNormal then - ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); - AFontPos := fnt.Position; - rtState := rtEnter; - end else - if (p - pStartText >= rtp.EndIndex) and (rtState = rtEnter) then - begin - inc(PendingRtpIndex); - if PendingRtpIndex = Length(ARichTextparams) then - begin - fnt := AWorkbook.GetFont(AFontIndex); - rtState := rtExit; - end else - begin - rtp := ARichTextParams[PendingRtpIndex]; - if (p - pStartText < rtp.StartIndex) then - begin - fnt := AWorkbook.GetFont(AFontIndex); - rtState := rtExit; - end else - begin - fnt := AWorkbook.GetFont(rtp.FontIndex); - rtState := rtEnter; - end; - end; - Convert_sFont_to_Font(fnt, ACanvas.Font); - AHeight := ACanvas.TextHeight('Tg'); - if fnt.Position <> fpNormal then - ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); - AFontPos := fnt.Position; - end; + if ARtpFontIndex = High(ARichTextParams) then + endPos := MaxInt + else begin + rtParam := ARichTextParams[ARtpFontIndex + 1]; + endPos := rtParam.FirstIndex; + end; + + if ACharPos >= endPos then begin + inc(ARtpFontIndex); + rtParam := ARichTextParams[ARtpFontIndex]; + fnt := AWorkbook.GetFont(rtParam.FontIndex); + Convert_sFont_to_Font(fnt, ACanvas.Font); + AFontHeight := ACanvas.TextHeight('Tg'); + if fnt.Position <> fpNormal then + ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); + AFontPos := fnt.Position; end; end; + { Scans the line for a possible line break. The max width is determined by + the size of the rectangle ARect passed to the outer procedure: + rectangle width in case of horizontal painting, rectangle height in case + of vertical painting. Line breaks can occure at spaces or cr/lf characters, + or, if not found, at any character reaching the max width. + + Parameters: + + P defines where the scan starts. At the end of the routine it + points to the first character of the next line. + ANumSpaces is how many spaces were found between the start and end value + of P. + ARtpFontIndex At input, this is the index of the rich-text formatting + parameter value used for the font at line start. At output, + it is the index which will be valid at next line start. + ALineWidth the pixel width of the line seen along drawing direction, i.e. + in case of stacked text it is the character height times + character count in the line (!) + ALineHeight The height of the line as seen vertical to the drawing + direction. Normally this is the height of the largest font + found in the line; in case of stacked text it is the + standardized width of a character. } procedure ScanLine(var P: PChar; var NumSpaces: Integer; - var PendingRtpIndex: Integer; var width, height: Integer); + var ARtpFontIndex: Integer; var ALineWidth, ALineHeight: Integer); var pEOL: PChar; savedSpaces: Integer; savedWidth: Integer; savedRtpIndex: Integer; maxWidth: Integer; - rtState: TRtState; - dw, h: Integer; - fntpos: TsFontPosition; + dw: Integer; spaceFound: Boolean; s: utf8String; - charLen: Integer; + charLen: Integer; // Number of bytes of current utf8 character begin NumSpaces := 0; - InitFont(p, rtState, PendingRtpIndex, h, fntpos); - height := h; - - pEOL := p; - width := 0; + ALineHeight := fontHeight; + ALineWidth := 0; savedWidth := 0; savedSpaces := 0; - savedRtpIndex := PendingRtpIndex; + savedRtpIndex := ARtpFontIndex; spaceFound := false; + pEOL := p; + if AWordwrap then begin if ARotation = trHorizontal then @@ -310,48 +301,55 @@ var maxWidth := MaxInt; while p^ <> #0 do begin - UpdateFont(p, rtState, PendingRtpIndex, h, fntpos); - if h > height then height := h; + UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); + ALineHeight := Max(fontHeight, ALineHeight); s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen)); case p^ of ' ': begin spaceFound := true; pEOL := p; - savedWidth := width; + savedWidth := ALineWidth; savedSpaces := NumSpaces; - savedRtpIndex := PendingRtpIndex; - dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(s)); - if width + dw < MaxWidth then + savedRtpIndex := ARtpFontIndex; + dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(s)); + if ALineWidth + dw < MaxWidth then begin inc(NumSpaces); - width := width + dw; + ALineWidth := ALineWidth + dw; end else break; end; - #13, + #13: begin + inc(p); + inc(charPos); + if p^ = #10 then + begin + inc(p); + inc(charPos); + end; + break; + end; #10: begin - // dec(p); - //width := savedWidth; - //numSpaces := savedspaces; - //PendingRtpIndex := savedRtpIndex; - exit; + inc(p); + inc(charPos); + break; end; else begin - dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(s)); - width := width + dw; - if width > maxWidth then + dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(s)); + ALineWidth := ALineWidth + dw; + if ALineWidth > maxWidth then begin if spaceFound then begin p := pEOL; - width := savedWidth; + ALineWidth := savedWidth; NumSpaces := savedSpaces; - PendingRtpIndex := savedRtpIndex; + ARtpFontIndex := savedRtpIndex; end else begin - width := width - dw; - if width = 0 then + ALineWidth := ALineWidth - dw; + if ALineWidth = 0 then inc(p); end; break; @@ -360,53 +358,76 @@ var end; inc(p, charLen); + inc(charPos); end; + UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); end; - procedure DrawLine(pStart, pEnd: PChar; x,y, hLine: Integer; PendingRtpIndex: Integer); + { Paints the text between the pointers pStart and pEnd. + Starting point for the text location is given by the coordinates x/y, i.e. + text alignment is already corrected. In case of sub/superscripts, the + characters reduced in size are shifted vertical to drawing direction by a + fraction of the line height (ALineHeight). + ARtpFontIndex is the index of the rich-text formatting param used to at line + start for font selection; it will advance automatically along the line } + procedure DrawLine(pStart, pEnd: PChar; x,y, ALineHeight: Integer; + ARtpFontIndex: Integer); var p: PChar; - rtState: TRtState; - h, w: Integer; - fntpos: TsFontPosition = fpNormal; + w: Integer; s: utf8String; charLen: Integer; begin p := pStart; - InitFont(p, rtState, PendingRtpIndex, h, fntpos); while p^ <> #0 do begin s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen)); - UpdateFont(p, rtState, PendingRtpIndex, h, fntpos); + UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); if AOverrideTextColor <> clNone then ACanvas.Font.Color := AOverrideTextColor; + case p^ of + #10: begin + inc(p); + inc(charPos); + break; + end; + #13: begin + inc(p); + inc(charPos); + if p^ = #10 then begin + inc(p); + inc(charpos); + end; + break; + end; + end; case ARotation of trHorizontal: begin ACanvas.Font.Orientation := 0; - case fntpos of + case fontpos of fpNormal : ACanvas.TextOut(x, y, s); - fpSubscript : ACanvas.TextOut(x, y + hLine div 2, s); - fpSuperscript: ACanvas.TextOut(x, y - hLine div 6, s); + fpSubscript : ACanvas.TextOut(x, y + ALineHeight div 2, s); + fpSuperscript: ACanvas.TextOut(x, y - ALineHeight div 6, s); end; inc(x, ACanvas.TextWidth(s)); end; rt90DegreeClockwiseRotation: begin ACanvas.Font.Orientation := -900; - case fntpos of + case fontpos of fpNormal : ACanvas.TextOut(x, y, s); - fpSubscript : ACanvas.TextOut(x - hLine div 2, y, s); - fpSuperscript: ACanvas.TextOut(x + hLine div 6, y, s); + fpSubscript : ACanvas.TextOut(x - ALineHeight div 2, y, s); + fpSuperscript: ACanvas.TextOut(x + ALineHeight div 6, y, s); end; inc(y, ACanvas.TextWidth(s)); end; rt90DegreeCounterClockwiseRotation: begin ACanvas.Font.Orientation := +900; - case fntpos of + case fontpos of fpNormal : ACanvas.TextOut(x, y, s); - fpSubscript : ACanvas.TextOut(x + hLine div 2, y, s); - fpSuperscript: ACanvas.TextOut(x - hLine div 6, y, s); + fpSubscript : ACanvas.TextOut(x + ALineHeight div 2, y, s); + fpSuperscript: ACanvas.TextOut(x - ALineHeight div 6, y, s); end; dec(y, ACanvas.TextWidth(s)); end; @@ -415,18 +436,20 @@ var ACanvas.Font.Orientation := 0; w := ACanvas.TextWidth(s); // chars centered around x - case fntpos of + case fontpos of fpNormal : ACanvas.TextOut(x - w div 2, y, s); - fpSubscript : ACanvas.TextOut(x - w div 2, y + hLine div 2, s); - fpSuperscript: ACanvas.TextOut(x - w div 2, y - hLine div 6, s); + fpSubscript : ACanvas.TextOut(x - w div 2, y + ALineHeight div 2, s); + fpSuperscript: ACanvas.TextOut(x - w div 2, y - ALineHeight div 6, s); end; - inc(y, h); + inc(y, fontHeight); end; end; inc(P, charLen); + inc(charPos); if P >= PEnd then break; end; + UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); end; begin @@ -435,56 +458,50 @@ begin p := PChar(AText); pStartText := p; // first char of text - - if (Length(ARichTextParams) > 0) then - iRTP := 0 - else - iRtp := -1; + charPos := 1; // Counter for utf8 character position totalHeight := 0; linelen := 0; Convert_sFont_to_Font(AWorkbook.GetFont(AFontIndex), ACanvas.Font); - if ARotation = rtStacked then stackPeriod := ACanvas.TextWidth('M') * 2; - // Get layout of lines: - // "lineinfos" collect data on where lines start and end, their width and + // (1) Get layout of lines + // ====================== + // "lineinfos" collect data for where lines start and end, their width and // height, the rich-text parameter index range, and the number of spaces // (for text justification) + InitFont(rtpIndex, fontheight, fontpos); repeat SetLength(lineInfos, Length(lineInfos)+1); with lineInfos[High(lineInfos)] do begin pStart := p; pEnd := p; - FirstRtpIndex := iRtp; - NextRtpIndex := iRtp; - ScanLine(pEnd, NumSpaces, NextRtpIndex, Width, Height); + BeginsWithFontOfRtpIndex := rtpIndex; + ScanLine(pEnd, NumSpaces, rtpIndex, Width, Height); totalHeight := totalHeight + Height; linelen := Max(linelen, Width); - iRtp := NextRtpIndex; p := pEnd; - case p^ of - ' ': while (p^ <> #0) and (p^ = ' ') do inc(p); - #13: begin - inc(p); - if p^ = #10 then inc(p); - end; - #10: inc(p); - end; + if p^ = ' ' then + while (p^ <> #0) and (p^ = ' ') do begin + inc(p); + inc(charPos); + end; end; until p^ = #0; - Width := linelen; + AWidth := linelen; if ARotation = rtStacked then - Height := Length(lineinfos) * stackperiod + AHeight := Length(lineinfos) * stackperiod // to be understood horizontally else - Height := totalHeight; + AHeight := totalHeight; if AMeasureOnly then exit; - // Draw lines - // 1/ get starting point of line + // (2) Draw lines + // ============== + // 2a) get starting point of line + // ------------------------------ case ARotation of trHorizontal: case AVertAlignment of @@ -515,7 +532,10 @@ begin end; end; - // 2/ Draw line by line and respect text rotation + // (2b) Draw line by line and respect text rotation + // ------------------------------------------------ + charPos := 1; // Counter for utf8 character position + InitFont(rtpIndex, fontheight, fontpos); for lineInfo in lineInfos do begin with lineInfo do begin @@ -528,7 +548,7 @@ begin haRight : xpos := ARect.Right - Width; haCenter : xpos := (ARect.Left + ARect.Right - Width) div 2; end; - DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex); + DrawLine(pStart, pEnd, xpos, ypos, Height, BeginsWithFontOfRtpIndex); inc(ypos, Height); end; rt90DegreeClockwiseRotation: @@ -538,7 +558,7 @@ begin vaBottom : ypos := ARect.Bottom - Width; vaCenter : ypos := (ARect.Top + ARect.Bottom - Width) div 2; end; - DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex); + DrawLine(pStart, pEnd, xpos, ypos, Height, BeginsWithFontOfRtpIndex); dec(xpos, Height); end; rt90DegreeCounterClockwiseRotation: @@ -548,7 +568,7 @@ begin vaBottom : ypos := ARect.Bottom; vaCenter : ypos := (ARect.Top + ARect.Bottom + Width) div 2; end; - DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex); + DrawLine(pStart, pEnd, xpos, ypos, Height, BeginsWithFontOfRtpIndex); inc(xpos, Height); end; rtStacked: @@ -558,7 +578,7 @@ begin vaBottom : ypos := ARect.Bottom - Width; vaCenter : ypos := (ARect.Top + ARect.Bottom - Width) div 2; end; - DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex); + DrawLine(pStart, pEnd, xpos, ypos, Height, BeginsWithFontOfRtpIndex); inc(xpos, stackPeriod); end; end; @@ -575,7 +595,7 @@ var begin InternalDrawRichText(ACanvas, AWorkbook, ARect, AText, AFontIndex, ARichTextParams, AWordWrap, AHorAlignment, AVertAlignment, ARotation, - AOverrideTextColor, w, h, false); + AOverrideTextColor, false, w, h); end; function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; AMaxRect: TRect; @@ -585,8 +605,8 @@ var h, w: Integer; begin InternalDrawRichText(ACanvas, AWorkbook, AMaxRect, AText, AFontIndex, - ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, - w, h, true); + ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, true, + w, h); case ATextRotation of trHorizontal, rtStacked: Result := w; @@ -602,8 +622,8 @@ var h, w: Integer; begin InternalDrawRichText(ACanvas, AWorkbook, AMaxRect, AText, AFontIndex, - ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, - w, h, true); + ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, true, + w, h); case ATextRotation of trHorizontal: Result := h; diff --git a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas index 68e765699..076faa4d0 100644 --- a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas +++ b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas @@ -12,6 +12,11 @@ type TBIFFDetailsEvent = procedure(Sender: TObject; ADetails: TStrings) of object; + TRichTextFormattingRun = packed record + FirstIndex, fontIndex: Word; + end; + TRichTextFormattingRuns = array of TRichTextFormattingRun; + TBIFFGrid = class(TStringGrid) private FRecType: Word; @@ -133,7 +138,7 @@ type ACharCount: Integer; out AString: String; out ANumbytes: Integer); overload; procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean; out AString: String; out ANumBytes: Integer; - out ARichTextRuns: TsRichTextFormattingRuns; + out ARichTextRuns: TRichTextFormattingRuns; out ABufIndexOfFirstRichTextRun: LongWord; IgnoreCompressedFlag: Boolean = false); overload; procedure ExtractString(ABufIndex: Integer; ALenbytes: Byte; AUnicode: Boolean; @@ -274,7 +279,7 @@ procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false); var - rtfRuns: TsRichTextFormattingRuns; + rtfRuns: TRichTextFormattingRuns; rtfIndex: LongWord; begin ExtractString(ABufIndex, ALenbytes, AUnicode, AString, ANumBytes, @@ -283,7 +288,7 @@ end; procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean; out AString: String; out ANumBytes: Integer; - out ARichTextRuns: TsRichTextFormattingRuns; + out ARichTextRuns: TRichTextFormattingRuns; out ABufIndexOfFirstRichTextRun: LongWord; IgnoreCompressedFlag: Boolean = false); var @@ -1286,7 +1291,7 @@ var run: Integer; total2: Integer; optn: Byte; - rtfRuns: TsRichTextFormattingRuns; + rtfRuns: TRichTextFormattingRuns; rtfBufferIndex: LongWord; begin case FInfo of @@ -1896,7 +1901,7 @@ var ansiStr: AnsiString; s: String; i, n: Integer; - rtfRuns: TsRichTextFormattingRuns; + rtfRuns: TRichTextFormattingRuns; begin BeginUpdate; RowCount := FixedRows + 1000; @@ -5322,7 +5327,7 @@ var s: String; total1, total2: DWord; i, j, n: Integer; - rtfRuns: TsRichTextFormattingRuns; + rtfRuns: TRichTextFormattingRuns; rtfIndex: LongWord; w: Word; begin diff --git a/components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm b/components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm index 8570d1fb0..812475ef0 100644 --- a/components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm +++ b/components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm @@ -175,22 +175,22 @@ object MainForm: TMainForm OnSelection = HexGridSelection ColWidths = ( 28 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 21 - 26 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 20 + 24 ) Cells = ( 16 @@ -261,22 +261,22 @@ object MainForm: TMainForm OnClick = GridClick OnSelection = AlphaGridSelection ColWidths = ( - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 17 - 18 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 ) Cells = ( 16 @@ -415,7 +415,6 @@ object MainForm: TMainForm Width = 419 Align = alClient ButtonStyle = bsTriangle - Colors.UnfocusedColor = clMedGray DefaultText = 'Node' Header.AutoSizeIndex = 4 Header.Columns = < diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 8ca422942..b72d95b08 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -106,7 +106,7 @@ type procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String; ANumFormatIndex: Integer); override; procedure WriteIndex(AStream: TStream); - procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; + procedure WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStyle(AStream: TStream); @@ -519,22 +519,19 @@ end; procedure TsSpreadBIFF5Reader.ReadRSTRING(AStream: TStream); var - L: Word; + L, i: Word; B: Byte; ARow, ACol: Cardinal; XF: Word; ansistr: ansistring; valueStr: UTF8String; cell: PCell; - rtfRuns: TsRichTextFormattingRuns; + rtfRuns: TBiff5_RichTextFormattingRuns; + fntIndex: Integer; + fnt: TsFont; begin ReadRowColXF(AStream, ARow, ACol, XF); - { Byte String with 16-bit size } - L := WordLEtoN(AStream.ReadWord); - SetLength(ansistr, L); - AStream.ReadBuffer(ansistr[1], L); - { Create cell } if FIsVirtualMode then begin InitCell(ARow, ACol, FVirtualCell); @@ -542,21 +539,37 @@ begin end else cell := FWorksheet.AddCell(ARow, ACol); - { Save the data } + { Read data string (Byte string with 16-bit length) } + L := WordLEtoN(AStream.ReadWord); + SetLength(ansistr, L); + AStream.ReadBuffer(ansistr[1], L); + + { Save the data string to cell } valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8); FWorksheet.WriteUTF8Text(cell, valuestr); - // Read rich-text formatting runs + { Read rich-text formatting runs } B := AStream.ReadByte; + SetLength(cell^.RichTextParams, B); SetLength(rtfRuns, B); - for L := 0 to B-1 do begin - rtfRuns[L].FirstIndex := AStream.ReadByte; // Index of first formatted character - rtfRuns[L].FontIndex := AStream.ReadByte; // Index of font used + AStream.ReadBuffer(rtfRuns[0], B * SizeOf(TBiff5_RichTextFormattingRun)); + for i := 0 to B-1 do begin + // Index of first formatted character; it is 0-based in file, but 1-based in fps + cell^.RichTextParams[i].FirstIndex := rtfRuns[i].FirstIndex + 1; + // Index of font used after this character. But be aware that the font index + // in the file is different from the font index stored by the workbook. + fntIndex := rtfRuns[i].FontIndex; + fnt := TsFont(FFontList[fntIndex]); + fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style,fnt.Color, fnt.Position); + if fntIndex = -1 then + fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + cell^.RichTextParams[i].FontIndex := fntIndex; + // Hyperlink index (not used here) + cell^.RichTextParams[i].HyperlinkIndex := -1; end; { Add attributes to cell } ApplyCellFormatting(cell, XF); - ApplyRichTextFormattingRuns(cell, rtfRuns); if FIsVirtualMode then Workbook.OnReadCellData(Workbook, ARow, ACol, cell); @@ -1448,8 +1461,11 @@ end; If the string length exceeds 255 bytes, the string will be truncated and an error message will be logged as a warning. + + NOTE: This method is called for "normal" LABEL cells as well as for + rich-text-formatted RSTRING cells. -------------------------------------------------------------------------------} -procedure TsSpreadBIFF5Writer.WriteLabel(AStream: TStream; const ARow, +procedure TsSpreadBIFF5Writer.WriteLABEL(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); const MAXBYTES = 255; // Limit for this BIFF5 @@ -1458,11 +1474,9 @@ var AnsiValue: ansistring; rec: TBIFF5_LabelRecord; buf: array of byte; - useRTF: Boolean; fmt: PsCellFormat; i, nRuns: Integer; - rtParam: TsRichTextParam; - rtfRuns: TBiff5_RichTextformattingRuns; + rtfRuns: TBIFF5_RichTextFormattingRuns; fntIndex, cellFntIndex: Integer; begin if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then @@ -1489,83 +1503,15 @@ begin ]); end; L := Length(AnsiValue); - - useRTF := (Length(ACell^.RichTextParams) > 0); + nRuns := Length(ACell^.RichTextParams); { BIFF record header } - rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL)); - rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L); + rec.RecordID := WordToLE(IfThen(nRuns > 0, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL)); + rec.RecordSize := SizeOf(rec) - SizeOf(TsBIFFHeader) + L; + if (nRuns > 0) then + inc(rec.RecordSize, 1 + nRuns * SizeOf(TBiff5_RichTextFormattingRun)); + rec.RecordSize := WordToLE(rec.RecordSize); - { 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 - fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex); - run := 0; - for j:=0 to High(ACell^.RichTextParams) do - begin - SetLength(rtfRuns, run + 1); - rtfRuns[run].FirstIndex := ACell^.RichTextParams[j].StartIndex; - rtfRuns[run].FontIndex := ACell^.RichTextParams[j].FontIndex; - if rtfRuns[run].FontIndex >= 4 then - inc(rtfRuns[run].FontIndex); // Font #4 does not exist in BIFF - inc(run); - 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 - SetLength(rtfRuns, run+1); - rtfRuns[run].FirstIndex := ACell^.RichTextParams[j].EndIndex; - rtfRuns[run].FontIndex := fmt^.FontIndex; - if rtfRuns[run].FontIndex >= 4 then - inc(rtfRuns[run].FontIndex); - inc(run); - end; - end; - - // 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); @@ -1585,17 +1531,26 @@ begin AStream.WriteBuffer(buf[0], SizeOf(Rec) + L); { Write rich-text information in case of RSTRING record } - if useRTF then + if nRuns > 0 then begin { Write number of rich-text formatting runs } AStream.WriteByte(nRuns); { Write rich-text formatting runs } - AStream.WriteBuffer(rtfRuns[0], nRuns * SizeOf(TBiff5_RichTextFormattingRun)); + SetLength(rtfRuns, nRuns); + for i:=0 to nRuns-1 do + begin + // Char index where new font starts: 0-based in file, 1-based in fps + rtfRuns[i].FirstIndex := ACell^.RichTextParams[i].FirstIndex - 1; + // Index of new font. Be aware of font #4 missing in BIFF! + if ACell^.RichTextParams[i].FontIndex >= 4 then + rtfRuns[i].FontIndex := ACell^.RichTextParams[i].FontIndex + 1 else + rtfRuns[i].FontIndex := ACell^.RichTextParams[i].FontIndex; + end; + AStream.WriteBuffer(rtfRuns[0], nRuns*SizeOf(TBiff5_RichTextFormattingRun)); end; { Clean up } SetLength(buf, 0); - SetLength(rtfRuns, 0); end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 290671940..bef12eb0e 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -77,11 +77,11 @@ type FCommentLen: Integer; procedure ReadBoundsheet(AStream: TStream); function ReadString(const AStream: TStream; const ALength: Word; - out ARichTextRuns: TsRichTextFormattingRuns): String; + out ARichTextParams: TsRichTextParams): String; function ReadUnformattedWideString(const AStream: TStream; const ALength: Word): WideString; function ReadWideString(const AStream: TStream; const ALength: Word; - out ARichTextRuns: TsRichTextFormattingRuns): WideString; overload; + out ARichTextParams: TsRichTextParams): WideString; overload; function ReadWideString(const AStream: TStream; const AUse8BitLength: Boolean): WideString; overload; protected procedure PopulatePalette; override; @@ -471,10 +471,10 @@ procedure TsSpreadBIFF8Reader.ReadCONTINUE(const AStream: TStream); var commentStr: String; comment: TBIFF8Comment; - rtRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; begin if FCommentPending then begin - commentStr := ReadWideString(AStream, FCommentLen, rtRuns); + commentStr := ReadWideString(AStream, FCommentLen, rtParams); if commentStr <> '' then begin comment := TBIFF8Comment.Create; @@ -605,7 +605,7 @@ begin end; function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream; - const ALength: WORD; out ARichTextRuns: TsRichTextFormattingRuns): WideString; + const ALength: WORD; out ARichTextParams: TsRichTextParams): WideString; var StringFlags: BYTE; DecomprStrValue: WideString; @@ -662,7 +662,7 @@ begin Raise Exception.Create('[TsSpreadBIFF8Reader.ReadWideString] CONTINUE record expected, but not found.'); end else begin PendingRecordSize := RecordSize; - DecomprStrValue := copy(DecomprStrValue,1,i) + ReadWideString(AStream, ALength-i, ARichTextRuns); + DecomprStrValue := copy(DecomprStrValue,1,i) + ReadWideString(AStream, ALength-i, ARichTextParams); break; end; end; @@ -671,7 +671,7 @@ begin end; if StringFlags and 8 = 8 then begin // Rich string (This only occurs in BIFF8) - SetLength(ARichTextRuns, RunsCounter); + SetLength(ARichTextParams, RunsCounter); for j := 0 to SmallInt(RunsCounter) - 1 do begin if (PendingRecordSize <= 0) then begin // A CONTINUE may happened here @@ -683,8 +683,10 @@ begin PendingRecordSize := RecordSize; end; end; - ARichTextRuns[j].FirstIndex := WordLEToN(AStream.ReadWord); - ARichTextRuns[j].FontIndex := WordLEToN(AStream.ReadWord); + // character start index: 0-based in file, 1-based in fps + ARichTextParams[j].FirstIndex := WordLEToN(AStream.ReadWord) + 1; + ARichTextParams[j].FontIndex := WordLEToN(AStream.ReadWord); + ARichTextParams[j].HyperlinkIndex := -1; dec(PendingRecordSize, 2*2); end; end; @@ -701,14 +703,14 @@ function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream; const AUse8BitLength: Boolean): WideString; var Len: Word; - rtRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; begin if AUse8BitLength then Len := AStream.ReadByte() else Len := WordLEtoN(AStream.ReadWord()); - Result := ReadWideString(AStream, Len, rtRuns); + Result := ReadWideString(AStream, Len, rtParams); end; procedure TsSpreadBIFF8Reader.ReadWorkbookGlobals(AStream: TStream); @@ -846,7 +848,7 @@ procedure TsSpreadBIFF8Reader.ReadBoundsheet(AStream: TStream); var Len: Byte; WideName: WideString; - rtRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; begin { Absolute stream position of the BOF record of the sheet represented by this record } @@ -863,15 +865,15 @@ begin Len := AStream.ReadByte(); { Read string with flags } - WideName:=ReadWideString(AStream, Len, rtRuns); + WideName:=ReadWideString(AStream, Len, rtParams); FWorksheetNames.Add(UTF8Encode(WideName)); end; function TsSpreadBIFF8Reader.ReadString(const AStream: TStream; - const ALength: WORD; out ARichTextRuns: TsRichTextFormattingRuns): String; + const ALength: WORD; out ARichTextParams: TsRichTextParams): String; begin - Result := UTF16ToUTF8(ReadWideString(AStream, ALength, ARichTextRuns)); + Result := UTF16ToUTF8(ReadWideString(AStream, ALength, ARichTextParams)); end; (* procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: String); @@ -985,12 +987,14 @@ end; procedure TsSpreadBIFF8Reader.ReadLABEL(AStream: TStream); var - L: Word; + L, i: Word; ARow, ACol: Cardinal; XF: Word; wideStrValue: WideString; cell: PCell; - rtfRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; + fntIndex: Integer; + fnt: TsFont; begin { BIFF Record data: Row, Column, XF Index } ReadRowColXF(AStream, ARow, ACol, XF); @@ -999,7 +1003,7 @@ begin L := WordLEtoN(AStream.ReadWord()); { Read wide string with flags } - wideStrValue := ReadWideString(AStream, L, rtfRuns); + wideStrValue := ReadWideString(AStream, L, rtParams); { Save the data } if FIsVirtualMode then begin @@ -1010,9 +1014,27 @@ begin FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(wideStrValue)); - {Add attributes} + { Add attributes } ApplyCellFormatting(cell, XF); - ApplyRichTextFormattingRuns(cell, rtfRuns); + + { Apply rich-text formatting } + if Length(rtParams) > 0 then begin + SetLength(cell^.RichTextParams, Length(rtParams)); + for i := 0 to High(rtParams) do + begin + // Character index where format starts: 0-based in file, 1-based in fps + cell^.RichTextParams[i].FirstIndex := rtParams[i].FirstIndex + 1; + // Font index of new format - need to adjust index! + fntIndex := rtParams[i].FontIndex; + fnt := TsFont(FFontList[fntIndex]); + fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + if fntIndex = -1 then + fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + cell^.RichTextParams[i].FontIndex := fntIndex; + // Hyperlink index, not used here + cell^.RichTextParams[i].HyperlinkIndex := -1; + end; + end; if FIsVirtualMode then Workbook.OnReadCellData(Workbook, ARow, ACol, cell); @@ -1187,44 +1209,57 @@ end; procedure TsSpreadBIFF8Reader.ReadRSTRING(AStream: TStream); var - j: Integer; - L: Word; + j, L: Word; ARow, ACol: Cardinal; XF: Word; wideStrValue: WideString; cell: PCell; - rtfRuns: TsRichTextFormattingRuns; + rtfRuns: TBiff8_RichTextFormattingRuns; + fntIndex: Integer; + fnt: TsFont; begin { BIFF Record data: Row, Column, XF Index } ReadRowColXF(AStream, ARow, ACol, XF); - { Byte String with 16-bit size } + { Data string: 16-bit length } L := WordLEtoN(AStream.ReadWord()); - { Read wide string without flags } + { Read wide string plus flag, but without processing it } wideStrValue := ReadUnformattedWideString(AStream, L); - { Rich-tech formatting runs } - L := WordLEToN(AStream.ReadWord); - SetLength(rtfRuns, L); - for j := 0 to L-1 do - begin - rtfRuns[j].FirstIndex := WordLEToN(AStream.ReadWord); - rtfRuns[j].FontIndex := WordLEToN(AStream.ReadWord); - end; - - { Save the data } + { Create cell } if FIsVirtualMode then begin InitCell(ARow, ACol, FVirtualCell); // "virtual" cell cell := @FVirtualCell; end else cell := FWorksheet.AddCell(ARow, ACol); // "real" cell + { Save the data string} FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(wideStrValue)); + { Read rich-text formatting runs } + L := WordLEToN(AStream.ReadWord); + SetLength(cell^.RichTextParams, L); + SetLength(rtfRuns, L); + AStream.ReadBuffer(rtfRuns[0], L * SizeOf(TBiff8_RichTextFormattingRun)); + for j := 0 to L-1 do + begin + // Index of the font. Be aware that the index in the file is not + // necessarily the same as the index used by the workbook! + fntIndex := WordLEToN(rtfRuns[j].FontIndex); + fnt := TsFont(FFontList[fntIndex]); + fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + if fntIndex = -1 then + fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + cell^.RichTextParams[j].FontIndex := fntIndex; + // Index of the first character using this font: 0-based in file, 1-based in fps + cell^.RichTextParams[j].FirstIndex := WordLEToN(rtfRuns[j].FirstIndex) + 1; + // Hyperlink index - not used by biff + cell^.RichTextParams[j].HyperlinkIndex := -1; + end; + {Add attributes} ApplyCellFormatting(cell, XF); - ApplyRichTextFormattingRuns(cell, rtfRuns); if FIsVirtualMode then Workbook.OnReadCellData(Workbook, ARow, ACol, cell); @@ -1236,7 +1271,7 @@ var StringLength, CurStrLen: WORD; LString: String; ContinueIndicator: WORD; - rtfRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; ms: TMemoryStream; begin //Reads the shared string table, only compatible with BIFF8 @@ -1265,10 +1300,8 @@ begin while PendingRecordSize > 0 do begin if StringLength > 0 then - begin //Read a stream of zero length reads all the stream. - LString := LString + ReadString(AStream, StringLength, rtfRuns); - end + LString := LString + ReadString(AStream, StringLength, rtParams) else begin //String of 0 chars in length, so just read it empty, reading only the mandatory flags @@ -1282,9 +1315,9 @@ begin begin //A Continue will happend, read the //tag and continue linking... - ContinueIndicator:=WordLEtoN(AStream.ReadWord); - if ContinueIndicator<>INT_EXCEL_ID_CONTINUE then begin - Raise Exception.Create('[TsSpreadBIFF8Reader.ReadSST] Expected CONTINUE record not found.'); + ContinueIndicator := WordLEtoN(AStream.ReadWord); + if ContinueIndicator <> INT_EXCEL_ID_CONTINUE then begin + raise Exception.Create('[TsSpreadBIFF8Reader.ReadSST] Expected CONTINUE record not found.'); end; PendingRecordSize := WordLEtoN(AStream.ReadWord); CurStrLen := Length(UTF8ToUTF16(LString)); @@ -1297,13 +1330,13 @@ begin end; end; - if Length(rtfRuns) = 0 then + if Length(rtParams) = 0 then FSharedStringTable.Add(LString) else begin ms := TMemoryStream.Create; - ms.WriteWord(Length(rtfRuns)); - ms.WriteBuffer(rtfRuns[0], SizeOf(TsRichTextFormattingRun)*Length(rtfRuns)); + ms.WriteWord(Length(rtParams)); + ms.WriteBuffer(rtParams[0], SizeOf(TsRichTextParam)*Length(rtParams)); ms.Position := 0; FSharedStringTable.AddObject(LString, ms); end; @@ -1324,13 +1357,15 @@ var rec: TBIFF8_LabelSSTRecord; cell: PCell; ms: TMemoryStream; - rtfRuns: TsRichTextFormattingRuns; - n: Integer; + i, n: Integer; + rtParams: TsRichTextParams; + fnt: TsFont; + fntIndex: Integer; begin rec.Row := 0; // to silence the compiler... { Read entire record, starting at Row } - AStream.ReadBuffer(rec.Row, SizeOf(TBIFF8_LabelSSTRecord) - 2*SizeOf(Word)); + AStream.ReadBuffer(rec.Row, SizeOf(TBIFF8_LabelSSTRecord) - SizeOf(TsBiffHeader)); ARow := WordLEToN(rec.Row); ACol := WordLEToN(rec.Col); XF := WordLEToN(rec.XFIndex); @@ -1357,10 +1392,21 @@ begin { Add rich text formatting } ms := TMemoryStream(FSharedStringTable.Objects[SSTIndex]); if ms <> nil then begin - n := ms.ReadWord; - SetLength(rtfRuns, n); - ms.ReadBuffer(rtfRuns[0], n*SizeOf(TsRichTextFormattingRun)); - ApplyRichTextFormattingRuns(cell, rtfRuns); + n := WordLEToN(ms.ReadWord); + SetLength(rtParams, n); + ms.ReadBuffer(rtParams[0], n*SizeOf(TsRichTextParam)); + SetLength(cell^.RichTextParams, n); + for i:=0 to n-1 do + begin + cell^.RichTextParams[i].FirstIndex := rtParams[i].FirstIndex; + fntIndex := rtParams[i].FontIndex; + fnt := TsFont(FFontList[fntIndex]); + fntIndex := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + if fntIndex = -1 then + fntIndex := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); + cell^.RichTextParams[i].FontIndex := fntIndex; + cell^.RichTextParams[i].HyperlinkIndex := -1; + end; end; if FIsVirtualMode then @@ -1584,7 +1630,7 @@ var lWeight: Word; Len: Byte; font: TsFont; - rtfRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; begin font := TsFont.Create; @@ -1640,7 +1686,7 @@ begin { Font name: Unicodestring, char count in 1 byte } Len := AStream.ReadByte(); - font.FontName := ReadString(AStream, Len, rtfRuns); // rtfRuns is not used here. + font.FontName := ReadString(AStream, Len, rtParams); // rtParams is not used here. { Add font to internal font list; will be transferred to workbook later because the font index in the internal list (= index in file) is not the same as the @@ -1688,13 +1734,13 @@ procedure TsSpreadBIFF8Reader.ReadHeaderFooter(AStream: TStream; var s: widestring; len: word; - rtfRuns: TsRichTextFormattingRuns; + rtParams: TsRichTextParams; begin if RecordSize = 0 then exit; len := WordLEToN(AStream.ReadWord); - s := ReadWideString(AStream, len, rtfRuns); + s := ReadWideString(AStream, len, rtParams); if AIsHeader then FWorksheet.PageLayout.Headers[1] := UTF8Encode(s) else @@ -2596,85 +2642,42 @@ const MAXBYTES = 32758; var L: Word; - WideValue: WideString; + WideStr: WideString; rec: TBIFF8_LabelRecord; - rtfRuns: TBiff8_RichTextFormattingRuns; - rtParam: TsRichTextParam; buf: array of byte; i, nRuns: Integer; - fmt: PsCellFormat; - useRTF: Boolean; - fntIndex: Word; - cellfntIndex: Word; + rtfRuns: TBiff8_RichTextFormattingRuns; begin if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then exit; - WideValue := UTF8Decode(FixLineEnding(AValue)); //to UTF16 - if WideValue = '' then begin + WideStr := UTF8Decode(FixLineEnding(AValue)); //to UTF16 + if WideStr = '' then begin // Badly formatted UTF8String (maybe ANSI?) if Length(AValue)<>0 then begin //Quite sure it was an ANSI string written as UTF8, so raise exception. - raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [GetCellString(ARow,ACol)]); + raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [GetCellString(ARow, ACol)]); end; Exit; end; - if Length(WideValue) > MAXBYTES then begin + if Length(WideStr) > MAXBYTES then begin // <-------- wp: Factor 2 missing? --------- // Rather than lose data when reading it, let the application programmer deal // with the problem or purposefully ignore it. - SetLength(WideValue, MAXBYTES); //may corrupt the string (e.g. in surrogate pairs), but... too bad. + SetLength(WideStr, MAXBYTES); //may corrupt the string (e.g. in surrogate pairs), but... too bad. Workbook.AddErrorMsg(rsTruncateTooLongCellText, [ MAXBYTES, GetCellString(ARow, ACol) ]); end; - L := Length(WideValue); - - useRTF := (Length(ACell^.RichTextParams) > 0); + L := Length(WideStr); + nRuns := Length(ACell^.RichTextParams); { BIFF record header } - rec.RecordID := WordToLE(IfThen(useRTF, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL)); - rec.RecordSize := WordToLE(SizeOf(rec) - SizeOf(TsBIFFHeader) + L * SizeOf(WideChar)); - - { 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(TBiff8_RichTextFormattingRun)); - end; + rec.RecordID := WordToLE(IfThen(nRuns > 0, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL)); + rec.RecordSize := SizeOf(TBiff8_LabelRecord) - SizeOf(TsBiffHeader) + L *SizeOf(WideChar); + if nRuns > 0 then + inc(rec.RecordSize, SizeOf(Word) + nRuns * SizeOf(TBiff8_RichTextFormattingRun)); + rec.RecordSize := WordToLE(rec.RecordSize); { BIFF record data } rec.Row := WordToLE(ARow); @@ -2688,28 +2691,40 @@ begin { Byte flags } rec.TextFlags := 1; // means regular unicode LE encoding + // Excel does not write the Rich-Text flag probably because rich-text info + // is located differently in the RSTRING record. { Copy the text characters into a buffer immediately after rec } SetLength(buf, SizeOf(rec) + L*SizeOf(WideChar)); Move(rec, buf[0], SizeOf(Rec)); - Move(WideStringToLE(WideValue)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar)); + Move(WideStringToLE(WideStr)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar)); { Write out buffer } AStream.WriteBuffer(buf[0], SizeOf(rec) + L*SizeOf(WideChar)); { Write rich-text information in case of RSTRING record } - if useRTF then + if (nRuns > 0) then begin { Write number of rich-text formatting runs } AStream.WriteWord(WordToLE(nRuns)); { Write array of rich-text formatting runs } + SetLength(rtfRuns, nRuns); + for i:=0 to nRuns-1 do + begin + // index of first character of formatted part, 0-based in file, 1-based in fps + rtfRuns[i].FirstIndex := WordToLE(ACell^.RichTextParams[i].FirstIndex - 1); + // Index of new font. Be aware of font #4 missing in BIFF! + if ACell^.RichTextParams[i].FontIndex >= 4 then + rtfRuns[i].FontIndex := WordToLE(ACell^.RichTextParams[i].FontIndex + 1) else + rtfRuns[i].FontIndex := WordToLE(ACell^.RichTextParams[i].FontIndex); + end; AStream.WriteBuffer(rtfRuns[0], nRuns * SizeOf(TBiff8_RichTextFormattingRun)); end; { Clean up } - SetLength(buf, 0); SetLength(rtfRuns, 0); + SetLength(buf, 0); end; procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 5b79aecd9..6968571e4 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -360,8 +360,10 @@ type procedure AddBuiltinNumFormats; override; procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; + (* procedure ApplyRichTextFormattingRuns(ACell: PCell; ARuns: TsRichTextFormattingRuns); + *) // Extracts a number out of an RK value function DecodeRKValue(const ARK: DWORD): Double; // Returns the numberformat for a given XF record @@ -863,7 +865,7 @@ begin ACell^.FormatIndex := 0; end; end; - + (* {@@ ---------------------------------------------------------------------------- Converts the rich-text formatting run data as read from the file to the internal format used by the cell. @@ -903,7 +905,7 @@ begin end; end; end; - + *) {@@ ---------------------------------------------------------------------------- Extracts a number out of an RK value. Valid since BIFF3. diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 0df6b4366..71d8b9404 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -566,8 +566,6 @@ var numFmt: TsNumFormatParams = nil; ms: TMemoryStream; n: Integer; - rtp: TsRichTextParam; - richTextParams: TsRichTextParams; begin if ANode = nil then exit; @@ -672,29 +670,15 @@ begin if s = 's' then begin // String from shared strings table sstIndex := StrToInt(dataStr); - // Standard cell, no rich-text parameters - if FSharedStrings.Objects[sstIndex] = nil then - AWorksheet.WriteUTF8Text(cell, FSharedStrings[sstIndex]) - else + AWorksheet.WriteUTF8Text(cell, FSharedStrings[sstIndex]); + // Read rich-text parameters from the stream stored in the Objects of the stringlist + if FSharedStrings.Objects[sstIndex] <> nil then begin - // Read rich-text parameters from the stream stored in the Objects of the stringlist ms := TMemoryStream(FSharedStrings.Objects[sstIndex]); ms.Position := 0; n := ms.ReadWord; // Count of array elements - SetLength(richTextParams, 0); - while (n > 0) do begin - ms.ReadBuffer(rtp, SizeOf(TsRichTextParam)); - // Consider only those richtext parameters with font different from cell font - if rtp.FontIndex <> fmt.FontIndex then begin - SetLength(richTextParams, Length(richTextParams)+1); - richTextParams[High(richTextParams)] := rtp; - end; - dec(n); - end; - AWorksheet.WriteUTF8Text(cell, - FSharedStrings[sstIndex], - richTextParams - ); + SetLength(cell^.RichTextParams, n); + ms.ReadBuffer(cell^.RichTextParams[0], n*SizeOf(TsRichTextParam)); end; end else if (s = 'str') or (s = 'inlineStr') then @@ -1646,43 +1630,36 @@ procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode); var valuenode: TDOMNode; childnode: TDOMNode; + innernode: TDOMNode; nodename: String; - s, sval: String; - fntIndex, startIndex, count: Integer; - richTextParams: TsRichTextParams; + totaltxt, sval: String; + fntIndex: Integer; + rtParams: TsRichTextParams; ms: TMemoryStream; fnt: TsFont; begin while Assigned(ANode) do begin if ANode.NodeName = 'si' then begin - s := ''; - richTextParams := nil; + totaltxt := ''; +// rtParams := nil; + SetLength(rtParams, 0); valuenode := ANode.FirstChild; while valuenode <> nil do begin nodename := valuenode.NodeName; if nodename = 't' then - s := GetNodeValue(valuenode) + // this is unformatted text + totaltxt := GetNodeValue(valuenode) else if nodename = 'r' then begin + // all rich-text formatted texts are defined by r nodes fntIndex := -1; - startIndex := -1; - count := -1; childnode := valuenode.FirstChild; while childnode <> nil do begin nodename := childnode.NodeName; if nodename = 't' then begin - startIndex := Length(s); - sval := GetNodevalue(childNode); - s := s + sval; - count := Length(sval); - if fntIndex <> -1 then - begin - SetLength(richTextParams, Length(richTextParams)+1); - richTextParams[Length(richTextParams)-1].StartIndex := startIndex; - richTextParams[Length(richTextParams)-1].EndIndex := startIndex + count; - richTextParams[Length(richTextParams)-1].FontIndex := fntIndex; - end; + sval := GetNodeValue(childNode); + totaltxt := totaltxt + sval; end else if nodename = 'rPr' then begin fntIndex := ReadFont(childnode); @@ -1693,26 +1670,24 @@ begin fntIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.style, fnt.Color, fnt.Position); if fntIndex = -1 then fntIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position); - if startIndex <> -1 then begin - SetLength(richTextParams, Length(richTextParams)+1); - richTextParams[Length(richTextParams)-1].StartIndex := startIndex; - richTextParams[Length(richTextParams)-1].EndIndex := startIndex + count; - richTextParams[Length(richTextParams)-1].FontIndex := fntIndex; - end; + SetLength(rtParams, Length(rtParams)+1); + rtParams[High(rtParams)].FirstIndex := UTF8Length(totaltxt) + 1; + rtParams[High(rtParams)].FontIndex := fntIndex; + rtParams[High(rtParams)].HyperlinkIndex := -1; end; childnode := childnode.NextSibling; end; end; valuenode := valuenode.NextSibling; end; - if Length(richTextParams) = 0 then - FSharedStrings.Add(s) + if Length(rtParams) = 0 then + FSharedStrings.Add(totaltxt) else begin ms := TMemoryStream.Create; - ms.WriteWord(Length(richTextParams)); - ms.WriteBuffer(richTextParams[0], SizeOf(TsRichTextParam)*Length(richTextParams)); - FSharedStrings.AddObject(s, ms); + ms.WriteWord(Length(rtParams)); + ms.WriteBuffer(rtParams[0], SizeOf(TsRichTextParam)*Length(rtParams)); + FSharedStrings.AddObject(totaltxt, ms); end; end; ANode := ANode.NextSibling; @@ -2319,19 +2294,6 @@ begin end; end; - { - // Index 1 is also pre-defined (gray 25%) - for i:=2 to High(FFillList) do begin - fmt := FFillList[i]; - if (fmt <> nil) and (uffBackgroundColor in fmt^.UsedFormattingFields) then - if (AFormat^.BackgroundColor = fmt^.BackgroundColor) then - begin - Result := i; - exit; - end; - end; - } - // Not found --> return -1 Result := -1; end; @@ -3852,6 +3814,7 @@ var CellValueText: String; lStyleIndex: Integer; begin + Unused(AValue); CellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); CellValueText := GetErrorValueStr(ACell^.ErrorValue); @@ -3934,9 +3897,7 @@ var lStyleIndex: Cardinal; ResultingValue: string; fnt: TsFont; - n: Integer; - i: Integer; - L: Integer; + i, n, L: Integer; rtParam: TsRichTextParam; txt: String; begin @@ -3951,6 +3912,7 @@ begin else ResultingValue := AValue; + { Check for invalid characters } txt := ResultingValue; if not ValidXMLText(txt) then Workbook.AddErrorMsg( @@ -3959,7 +3921,6 @@ begin ]); { Write string to SharedString table } - if Length(ACell^.RichTextParams) = 0 then // unformatted string AppendToStream(FSSharedStrings, @@ -3969,13 +3930,15 @@ begin else begin // rich-text formatted string + FixLineEndings(ResultingValue, ACell^.RichTextParams); L := UTF8Length(Resultingvalue); AppendToStream(FSSharedStrings, ''); rtParam := ACell^.RichTextParams[0]; - if rtParam.StartIndex > 0 then + if rtParam.FirstIndex > 1 then begin - txt := UTF8Copy(ResultingValue, 1, rtParam.StartIndex); + // Unformatted part before first format + txt := UTF8Copy(ResultingValue, 1, rtParam.FirstIndex - 1); ValidXMLText(txt); AppendToStream(FSSharedStrings, '' + @@ -3987,8 +3950,12 @@ begin begin rtParam := ACell^.RichTextParams[i]; fnt := FWorkbook.GetFont(rtParam.FontIndex); - n := rtParam.EndIndex - rtParam.StartIndex; - txt := UTF8Copy(Resultingvalue, rtParam.StartIndex+1, n); + // Calculate count of characters in this format section + if i = High(ACell^.RichTextParams) then + n := L - rtParam.FirstIndex + 1 else + n := ACell^.RichTextParams[i+1].FirstIndex - rtParam.FirstIndex; + // Partial string having this format + txt := UTF8Copy(Resultingvalue, rtParam.FirstIndex, n); ValidXMLText(txt); AppendToStream(FSSharedStrings, ''); @@ -3997,34 +3964,12 @@ begin '' + txt + '' + '' ); - if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then - begin - txt := UTF8Copy(ResultingValue, rtParam.EndIndex+1, MaxInt); - ValidXMLText(txt); - AppendToStream(FSSharedStrings, - '' + - '' + txt + '' + - '' - ) - end else - if (i < High(ACell^.RichTextParams)) and (rtParam.EndIndex < ACell^.RichTextParams[i+1].StartIndex) - then begin - n := ACell^.RichTextParams[i+1].StartIndex - rtParam.EndIndex; - txt := UTF8Copy(Resultingvalue, rtParam.EndIndex+1, n); - ValidXMLText(txt); - AppendToStream(FSSharedStrings, - '' + - '' + txt + '' + - '' - ); - end; end; AppendToStream(FSSharedStrings, ''); end; { Write shared string index to cell record } - CellPosText := TsWorksheet.CellPosToText(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); AppendToStream(AStream, Format(