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

fpspreadsheet: Re-do rich-text format (easier, less code). Fix rich-text issues with utf8 characters.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4257 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-08 16:23:49 +00:00
parent 3e2a6b4bc6
commit 62355e2d51
14 changed files with 553 additions and 609 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
components/fpspreadsheet/fpshtml.pas
View File

@@ -1198,9 +1198,9 @@ begin
textp := textp + '<a href="' + target + '">';
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</%0: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</%0:s>', [ESCAPEMENT_TAG[fnt.Position], txt]);
textp := textp + '<span' + style +'>' + txt + '</span>';
// 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</%0: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</%0:s>', [ESCAPEMENT_TAG[cellFnt.Position], txt]);
textp := textp + txt;
end;
end;
if target <> '' then
textp := textp + '</a></div>' else

54
components/fpspreadsheet/fpsopendocument.pas
View File

@@ -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 := '<text:p>';
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 + '</text:p>';
end;

91
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -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

2
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@@ -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);

8
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@@ -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;

10
components/fpspreadsheet/fpstypes.pas
View File

@@ -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. }

29
components/fpspreadsheet/fpsutils.pas
View File

@@ -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
-------------------------------------------------------------------------------}

324
components/fpspreadsheet/fpsvisualutils.pas
View File

@@ -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;

17
components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
View File

@@ -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

65
components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm
View File

@@ -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 = <

145
components/fpspreadsheet/xlsbiff5.pas
View File

@@ -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;
{@@ ----------------------------------------------------------------------------

249
components/fpspreadsheet/xlsbiff8.pas
View File

@@ -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;

6
components/fpspreadsheet/xlscommon.pas
View File

@@ -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.

133
components/fpspreadsheet/xlsxooxml.pas
View File

@@ -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,
'<si>');
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,
'<r>' +
@@ -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,
'<r>');
@@ -3997,34 +3964,12 @@ begin
'<t xml:space="preserve">' + txt + '</t>' +
'</r>'
);
if (rtParam.EndIndex < L) and (i = High(ACell^.RichTextParams)) then
begin
txt := UTF8Copy(ResultingValue, rtParam.EndIndex+1, MaxInt);
ValidXMLText(txt);
AppendToStream(FSSharedStrings,
'<r>' +
'<t xml:space="preserve">' + txt + '</t>' +
'</r>'
)
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,
'<r>' +
'<t xml:space="preserve">' + txt + '</t>' +
'</r>'
);
end;
end;
AppendToStream(FSSharedStrings,
'</si>');
end;
{ Write shared string index to cell record }
CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
AppendToStream(AStream, Format(