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

fpspreadsheet: Fix remaining utf8 issues when reading/writing rpn string formulas. Fix BIFFExplorer issues when displaying biff2 formulas. Excel complains about data loss when reading a biff2 file containing a calculated formula having a string result - not fixed yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3266 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-02 11:51:59 +00:00
parent 9dc234ae22
commit c82e915262
14 changed files with 221 additions and 489 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/examples/excel2demo/excel2write.lpi
View File

@ -39,7 +39,6 @@
<Unit0>
<Filename Value="excel2write.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="excel2write"/>
</Unit0>
</Units>
</ProjectOptions>
@ -55,8 +54,5 @@
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

5
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -5154,6 +5154,10 @@ end;
procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream);
begin
if Length(ACell^.RPNFormulaValue) > 0 then
// A non-calculated RPN formula has ContentType cctUTF8Formula, but after
// calculation it has the content type of the result. Both cases have in
// common that there is a non-vanishing array of rpn tokens which has to
// be written to file.
WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell)
else
case ACell.ContentType of
@ -5162,7 +5166,6 @@ begin
cctNumber : WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
cctUTF8String : WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
cctFormula : WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell^.FormulaValue, ACell);
// cctRPNFormula: WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell);
end;
end;

125
components/fpspreadsheet/fpsutils.pas
View File

@ -77,9 +77,6 @@ function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelF
function GetErrorValueStr(AErrorValue: TsErrorValue): String;
function UTF8ProperCase(AText: String): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean;
@ -129,6 +126,7 @@ function HTMLLengthStrToPts(AValue: String): Double;
function HTMLColorStrToColor(AValue: String): TsColorValue;
function ColorToHTMLColorStr(AValue: TsColorValue): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
procedure Unused(const A1);
procedure Unused(const A1, A2);
@ -663,85 +661,6 @@ begin
end;
end;
{@@
Converts a string to "proper case", i.e. 1st character of each word is
upper-case, other characters are lowercase.
@param S String to be converted
@return String in proper case }
function UTF8ProperCase(AText: String): String;
begin
result := '';
end;
(*
const
Delims: TSysCharSet = ['0'..'9', ' ', '.', ',', ';', ':', '-', '_',
'<', '>', '|', '''', '#', '*', '+', '~', '!', '"', '§', '$', '%', '&', '/', '(', ')', '=',
'?', '\', '}', ']', '[', '{', '@'];
var
ch: String;
len, i, j: Integer;
res: string;
w: String;
p: Integer;
words: Array of String;
begin
AText := UTF8Lowercase(AText);
i := 0;
w := 'dummy';
Result := '';
while w <> '' do begin
w := ExtractWordPos(i, AText, Delims, p);
Result := UTF8Copy(AText, 1, p-1) + UTF8Uppercase(UTF8Copy(w, 1, 1)) +
UTF8Copy(w, 2, Length(w)-1);
inc(i);
end;
end;
*)
{@@
Converts a string encoded in UTF8 to a string usable in XML. For this purpose,
some characters must be translated.
@param AText input string encoded as UTF8
@return String usable in XML with some characters replaced by the HTML codes.
}
function UTF8TextToXMLText(AText: ansistring): ansistring;
var
Idx:Integer;
WrkStr, AppoSt:ansistring;
begin
WrkStr:='';
for Idx:=1 to Length(AText) do
begin
case AText[Idx] of
'&': begin
AppoSt:=Copy(AText, Idx, 6);
if (Pos('&amp;', AppoSt) = 1) or
(Pos('&lt;', AppoSt) = 1) or
(Pos('&gt;', AppoSt) = 1) or
(Pos('&quot;', AppoSt) = 1) or
(Pos('&apos;', AppoSt) = 1) then begin
//'&' is the first char of a special chat, it must not be converted
WrkStr:=WrkStr + AText[Idx];
end else begin
WrkStr:=WrkStr + '&amp;';
end;
end;
'<': WrkStr:=WrkStr + '&lt;';
'>': WrkStr:=WrkStr + '&gt;';
'"': WrkStr:=WrkStr + '&quot;';
'''':WrkStr:=WrkStr + '&apos;';
else
WrkStr:=WrkStr + AText[Idx];
end;
end;
Result:=WrkStr;
end;
{@@
Helper function to reduce typing: "if a conditions is true return the first
number format, otherwise return the second format"
@ -1539,6 +1458,48 @@ begin
Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]);
end;
{@@
Converts a string encoded in UTF8 to a string usable in XML. For this purpose,
some characters must be translated.
@param AText input string encoded as UTF8
@return String usable in XML with some characters replaced by the HTML codes.
}
function UTF8TextToXMLText(AText: ansistring): ansistring;
var
Idx:Integer;
WrkStr, AppoSt:ansistring;
begin
WrkStr:='';
for Idx:=1 to Length(AText) do
begin
case AText[Idx] of
'&': begin
AppoSt:=Copy(AText, Idx, 6);
if (Pos('&amp;', AppoSt) = 1) or
(Pos('&lt;', AppoSt) = 1) or
(Pos('&gt;', AppoSt) = 1) or
(Pos('&quot;', AppoSt) = 1) or
(Pos('&apos;', AppoSt) = 1) then begin
//'&' is the first char of a special chat, it must not be converted
WrkStr:=WrkStr + AText[Idx];
end else begin
WrkStr:=WrkStr + '&amp;';
end;
end;
'<': WrkStr:=WrkStr + '&lt;';
'>': WrkStr:=WrkStr + '&gt;';
'"': WrkStr:=WrkStr + '&quot;';
'''':WrkStr:=WrkStr + '&apos;';
else
WrkStr:=WrkStr + AText[Idx];
end;
end;
Result:=WrkStr;
end;
{******************************************************************************}

3
components/fpspreadsheet/reference/BIFFExplorer/BIFFExplorer.lpi
View File

@ -135,6 +135,7 @@
<ComponentName Value="AboutForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="beAbout"/>
</Unit1>
<Unit2>
<Filename Value="bebiffgrid.pas"/>
@ -144,6 +145,7 @@
<Unit3>
<Filename Value="bebiffutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="beBIFFUtils"/>
</Unit3>
<Unit4>
<Filename Value="behtml.pas"/>
@ -160,7 +162,6 @@
<Unit6>
<Filename Value="beutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="beUtils"/>
</Unit6>
<Unit7>
<Filename Value="mrumanager.pp"/>

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

@ -208,7 +208,7 @@ begin
SetLength(sa, ls);
ANumBytes := ls*SizeOf(AnsiChar) + ALenBytes;
Move(FBuffer[ABufIndex + ALenBytes], sa[1], ls*SizeOf(AnsiChar));
AString := sa;
AString := AnsiToUTF8(sa);
end;
end;
@ -1420,9 +1420,76 @@ begin
ShowInRow(FCurrROw, FBufferIndex, numBytes, Format('%d ($%.4x)', [w, w]),
'Index of XF record');
end;
// Offset 6: Result of formula
numBytes := 8;
Move(FBuffer[FBufferIndex], q, numBytes);
if wordarr[3] <> $FFFF then begin
if FCurrRow = Row then begin
FDetails.Add('Formula result:'#13);
FDetails.Add(Format('Bytes 0-7: $%.15x --> IEEE 764 floating-point value, 64-bit double precision'#13+
' = %g', [q, dbl]));
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, FloatToStr(dbl),
'Result of formula (IEEE 764 floating-point value, 64-bit double precision)');
end else begin
case bytearr[0] of
0: begin // String result
if FCurrRow = Row then begin
FDetails.Add('Formula result:'#13);
FDetails.Add('Byte 0 = 0 --> Result is string, follows in STRING record');
FDetails.Add('Byte 1-5: Not used');
FDetails.Add('Byte 6&7: $FFFF --> no floating point number');
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('$%.16x', [q]),
'Result is a string, follows in STRING record');
end;
1: begin // BOOL result
if FCurrRow = Row then begin
FDetails.Add('Formula result:'#13);
FDetails.Add('Byte 0 = 1 --> Result is BOOLEAN');
FDetails.Add('Byte 1: Not used');
if bytearr[2] = 0
then FDetails.Add('Byte 2 = 0 --> FALSE')
else FDetails.Add('Byte 2 = 1 --> TRUE');
FDetails.Add('Bytes 3-5: Not used');
FDetails.Add('Bytes 6&7: $FFFF --> no floating point number');
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('$%.16x', [q]),
'Result is BOOLEAN');
end;
2: begin // ERROR result
if FCurrRow = Row then begin
FDetails.Add('Formula result:'#13);
FDetails.Add('Byte 0 = 2 --> Result is an ERROR value');
FDetails.Add('Byte 1: Not used');
case bytearr[2] of
$00: FDetails.Add('Byte 2 = $00 --> #NULL! Intersection of two cell ranges is empty');
$07: FDetails.Add('Byte 2 = $07 --> #DIV/0! Division by zero');
$0F: FDetails.Add('Byte 2 = $0F --> #VALUE! Wrong type of operand');
$17: FDetails.Add('Byte 2 = $17 --> #REF! Illegal or deleted cell reference');
$1D: FDetails.Add('Byte 2 = $1D --> #NAME? Wrong function or range name');
$24: FDetails.Add('Byte 2 = $24 --> #NUM! Value range overflow');
$2A: FDetails.Add('Byte 2 = $2A --> #N/A Argument or function not available');
end;
FDetails.Add('Bytes 6&7: $FFFF --> no floating point number');
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('$%.16x', [q]),
'Result is an ERROR value');
end;
3: begin // EMPTY cell
if FCurrRow = Row then begin
FDetails.Add('Formula result:'#13);
FDetails.Add('Byte 0 = 3 --> Result is an empty cell, for example an empty string');
FDetails.Add('Byte 1-5: Not used');
FDetails.Add('Bytes 6&7: $FFFF --> no floating point number');
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('$%.16x', [q]),
'Result is an EMPTY cell (empty string)');
end;
end;
end;
(*
if (FFormat > sfExcel2) then begin
if wordarr[3] <> $FFFF then begin
if FCurrRow = Row then begin
@ -1494,31 +1561,44 @@ begin
ShowInRow(FCurrRow, FBufferIndex, numBytes, FloatToStr(dbl),
'Result of formula (IEEE 764 floating-point value, 64-bit double precision)');
end;
*)
// Option flags
numBytes := 2;
Move(FBuffer[FBufferIndex], w, numBytes);
w := WordLEToN(w);
if Row = FCurrRow then begin
FDetails.Add('Option flags:'#13);
if w and $0001 = 0
then FDetails.Add('Bit $0001 = 0: Don''t recalculate')
else FDetails.Add('Bit $0001 = 1: Recalculate always');
FDetails.Add('Bit $0002: Reserved - MUST be zero, MUST be ignored');
if w and $0004 = 0
then FDetails.Add('Bit $0004 = 0: Cell does NOT have a fill alignment or a center-across-selection alignment.')
else FDetails.Add('Bit $0004 = 1: Cell has either a fill alignment or a center-across-selection alignment.');
if w and $0008 = 0
then FDetails.Add('Bit $0008 = 0: Formula is NOT part of a shared formula')
else FDetails.Add('Bit $0008 = 1: Formula is part of a shared formula');
FDetails.Add('Bit $0010: Reserved - MUST be zero, MUST be ignored');
if w and $0020 = 0
then FDetails.Add('Bit $0020 = 0: Formula is NOT excluded from formula error checking')
else FDetails.Add('Bit $0020 = 1: Formula is excluded from formula error checking');
FDetails.Add('Bits $FC00: Reserved - MUST be zero, MUST be ignored');
if FFormat = sfExcel2 then begin
numBytes := 1;
b := FBuffer[FBufferIndex];
if Row = FCurrRow then begin
FDetails.Add('Option flags:'#13);
case b of
0: FDetails.Add('0 = Do not recalculate');
1: FDetails.Add('1 = Recalculate always');
end;
end;
ShowInRow(FCurrRow, FBufferIndex, numbytes, IntToStr(b), 'Option flags');
end else begin
numBytes := 2;
Move(FBuffer[FBufferIndex], w, numBytes);
w := WordLEToN(w);
if Row = FCurrRow then begin
FDetails.Add('Option flags:'#13);
if w and $0001 = 0
then FDetails.Add('Bit $0001 = 0: Do not recalculate')
else FDetails.Add('Bit $0001 = 1: Recalculate always');
FDetails.Add('Bit $0002: Reserved - MUST be zero, MUST be ignored');
if w and $0004 = 0
then FDetails.Add('Bit $0004 = 0: Cell does NOT have a fill alignment or a center-across-selection alignment.')
else FDetails.Add('Bit $0004 = 1: Cell has either a fill alignment or a center-across-selection alignment.');
if w and $0008 = 0
then FDetails.Add('Bit $0008 = 0: Formula is NOT part of a shared formula')
else FDetails.Add('Bit $0008 = 1: Formula is part of a shared formula');
FDetails.Add('Bit $0010: Reserved - MUST be zero, MUST be ignored');
if w and $0020 = 0
then FDetails.Add('Bit $0020 = 0: Formula is NOT excluded from formula error checking')
else FDetails.Add('Bit $0020 = 1: Formula is excluded from formula error checking');
FDetails.Add('Bits $FC00: Reserved - MUST be zero, MUST be ignored');
end;
ShowInRow(FCurrRow, FBufferIndex, numbytes, Format('$%.4x', [w]),
'Option flags');
end;
ShowInRow(FCurrRow, FBufferIndex, numbytes, Format('$%.4x', [w]),
'Option flags');
// Not used
if (FFormat >= sfExcel5) then begin

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

@ -12,7 +12,7 @@ object MainForm: TMainForm
OnDestroy = FormDestroy
OnShow = FormShow
ShowHint = True
LCLVersion = '1.2.4.0'
LCLVersion = '1.3'
object Splitter1: TSplitter
Left = 419
Height = 497

2
components/fpspreadsheet/reference/BIFFExplorer/bemain.pas
View File

@ -178,7 +178,7 @@ implementation
{$R *.lfm}
uses
IniFiles, StrUtils, Math, lazutf8,
IniFiles, lazutf8,
fpsUtils,
beUtils, beBIFFUtils, beAbout;

2
components/fpspreadsheet/tests/formulatests.pas
View File

@ -161,7 +161,7 @@ begin
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
// Calculation of rpn formulas must be activated expicitely!
// Calculation of rpn formulas must be activated explicitly!
{ Write out test formulas.
This include file creates various rpn formulas and stores the expected

2
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -80,7 +80,6 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -89,7 +88,6 @@
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>

14
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

@ -116,6 +116,14 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(-1);
// String result
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '="Hallo"');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNString('Hallo', nil)));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateString('Hallo');
// String concatenation
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '="Hallo"&" world"');
@ -324,12 +332,9 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(1<>1);
{------------------------------------------------------------------------------}
{ Math }
{------------------------------------------------------------------------------}
// ABS
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=abs(-1)');
@ -1506,10 +1511,11 @@
RPNBool(true,
RPNNumber(1.0,
RPNString('A',
RPNFunc(fekIF,2, nil)))))); // <-- we have 3 parameters, not 2
RPNFunc(fekIF,2, nil)))))); // <-- but we pushed 3 parameters, not 2
SetLength(sollValues, Row+1);
sollValues[Row] := CreateError(errWrongType);
{ The first idea was that this should report an ArgError, but in fact it is
a WrongType error because popping two values from the stack finds a number,
but a bool is expected }
{$ENDIF}

112
components/fpspreadsheet/xlsbiff2.pas
View File

@ -682,13 +682,15 @@ var
len: Byte;
s: ansistring;
begin
// The string is a byte-string with 16 bit length
// The string is a byte-string with 8 bit length
len := AStream.ReadByte;
if len > 0 then begin
SetLength(s, Len);
AStream.ReadBuffer(s[1], len);
if (FIncompleteCell <> nil) and (s <> '') then begin
FIncompleteCell^.UTF8StringValue := s;
// The "IncompleteCell" has been identified in the sheet when reading
// the FORMULA record which precedes the String record.
FIncompleteCell^.UTF8StringValue := AnsiToUTF8(s);
FIncompleteCell^.ContentType := cctUTF8String;
end;
end;
@ -1329,108 +1331,7 @@ begin
{ Formula data (RPN token array) }
WriteRPNTokenArray(AStream, AFormula, RPNLength);
(*
{ Formula }
{ The size of the token array is written later,
because it's necessary to calculate if first,
and this is done at the same time it is written }
TokenArraySizePos := AStream.Position;
AStream.WriteByte(RPNLength);
{ Formula data (RPN token array) }
for i := 0 to Length(AFormula) - 1 do
begin
{ Token identifier }
FormulaKind := FormulaElementKindToExcelTokenID(AFormula[i].ElementKind, ExtraInfo);
AStream.WriteByte(FormulaKind);
Inc(RPNLength);
{ Additional data }
case FormulaKind of
{ binary operation tokens }
INT_EXCEL_TOKEN_TADD, INT_EXCEL_TOKEN_TSUB, INT_EXCEL_TOKEN_TMUL,
INT_EXCEL_TOKEN_TDIV, INT_EXCEL_TOKEN_TPOWER: begin end;
INT_EXCEL_TOKEN_TNUM:
begin
AStream.WriteBuffer(AFormula[i].DoubleValue, 8);
Inc(RPNLength, 8);
end;
INT_EXCEL_TOKEN_TSTR:
begin
s := ansistring(AFormula[i].StringValue);
len := Length(s);
AStream.WriteByte(len);
AStream.WriteBuffer(s[1], len);
Inc(RPNLength, len + 1);
end;
INT_EXCEL_TOKEN_TBOOL:
begin
AStream.WriteByte(ord(AFormula[i].DoubleValue <> 0.0));
inc(RPNLength, 1);
end;
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA:
begin
r := AFormula[i].Row and MASK_EXCEL_ROW;
if (rfRelRow in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(r);
AStream.WriteByte(AFormula[i].Col);
Inc(RPNLength, 3);
end;
INT_EXCEL_TOKEN_TAREA_R: { fekCellRange }
begin
r := AFormula[i].Row and MASK_EXCEL_ROW;
if (rfRelRow in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(WordToLE(r));
r := AFormula[i].Row2 and MASK_EXCEL_ROW;
if (rfRelRow2 in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol2 in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(WordToLE(r));
AStream.WriteByte(AFormula[i].Col);
AStream.WriteByte(AFormula[i].Col2);
Inc(RPNLength, 6);
end;
INT_EXCEL_TOKEN_FUNC_R, INT_EXCEL_TOKEN_FUNC_V, INT_EXCEL_TOKEN_FUNC_A:
begin
AStream.WriteByte(Lo(ExtraInfo));
Inc(RPNLength, 1);
end;
INT_EXCEL_TOKEN_FUNCVAR_V:
begin
AStream.WriteByte(AFormula[i].ParamsNum);
AStream.WriteByte(Lo(ExtraInfo));
// taking only the low-bytes, the high-bytes are needed for compatibility
// with other BIFF formats...
Inc(RPNLength, 2);
end;
end;
end;
{ Write sizes in the end, after we known them }
FinalPos := AStream.Position;
AStream.position := TokenArraySizePos;
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(17 + RPNLength));
AStream.position := FinalPos;
*)
{ Write sizes in the end, after we known them }
{ Finally write sizes after we know them }
FinalPos := AStream.Position;
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(17 + RPNLength));
@ -1466,7 +1367,8 @@ var
s: ansistring;
len: Integer;
begin
s := AString;
// s := AString; // Why not call UTF8ToAnsi?
s := UTF8ToAnsi(AString);
len := Length(s);
{ BIFF Record header }

4
components/fpspreadsheet/xlsbiff5.pas
View File

@ -956,7 +956,7 @@ var
s: ansistring;
len: Integer;
begin
s := AString;
s := UTF8ToAnsi(AString);
len := Length(s);
{ BIFF Record header }
@ -1399,7 +1399,7 @@ begin
SetLength(s, Len);
AStream.ReadBuffer(s[1], len);
if (FIncompleteCell <> nil) and (s <> '') then begin
FIncompleteCell^.UTF8StringValue := s;
FIncompleteCell^.UTF8StringValue := AnsiToUTF8(s);
FIncompleteCell^.ContentType := cctUTF8String;
end;
end;

225
components/fpspreadsheet/xlsbiff8.pas
View File

@ -127,10 +127,6 @@ type
AFlags: TsRelFlags): word; override;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags): Word; override;
{
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override;
}
function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override;
procedure WriteStringRecord(AStream: TStream; AString: string); override;
procedure WriteStyle(AStream: TStream);
@ -798,8 +794,7 @@ begin
end;
{ Writes the address of a cell as used in an RPN formula and returns the
number of bytes written.
Valid for BIFF8. }
number of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream;
ARow, ACol: Cardinal; AFlags: TsRelFlags): Word;
var
@ -814,17 +809,9 @@ begin
end;
{ Writes the address of a cell range as used in an RPN formula and returns the
count of bytes written.
Valid for BIFF2-BIFF5. }
count of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream;
ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): Word;
{ Cell range address, BIFF8:
Offset Size Contents
0 2 Index to first row (0…65535) or offset of first row (method [B], -32768…32767)
2 2 Index to last row (0…65535) or offset of last row (method [B], -32768…32767)
4 2 Index to first column or offset of first column, with relative flags (see table above)
6 2 Index to last column or offset of last column, with relative flags (see table above)
}
var
c: Cardinal; // column index with encoded relative/absolute address info
begin
@ -844,208 +831,6 @@ begin
Result := 8;
end;
(*
procedure TsSpreadBIFF8Writer.WriteRPNFormula(AStream: TStream; const ARow,
ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
FormulaResult: double;
FormulaResultWords: array[0..3] of word absolute FormulaResult;
i: Integer;
len: Integer;
RPNLength: Word;
TokenArraySizePos, RecordSizePos, FinalPos: Int64;
TokenID: Word;
lSecondaryID: Word;
c: Cardinal;
wideStr: WideString;
begin
RPNLength := 0;
FormulaResult := 0.0;
case ACell^.ContentType of
cctNumber:
FormulaResult := ACell^.NumberValue;
cctDateTime:
FormulaResult := ACell^.DateTimeValue;
cctUTF8String:
begin
if ACell^.UTF8StringValue = '' then
FormulaResultWords[0] := 3;
FormulaResultWords[3] := $FFFF;
end;
cctBool:
begin
FormulaResultWords[0] := 1;
FormulaResultWords[1] := ord(ACell^.BoolValue);
FormulaResultWords[3] := $FFFF;
end;
cctError:
begin
FormulaResultWords[0] := 2;
case ACell^.ErrorValue of
errEmptyIntersection: FormulaResultWords[1] := ERR_INTERSECTION_EMPTY;// #NULL!
errDivideByZero : FormulaResultWords[1] := ERR_DIVIDE_BY_ZERO; // #DIV/0!
errWrongType : FormulaResultWords[1] := ERR_WRONG_TYPE_OF_OPERAND; // #VALUE!
errIllegalRef : FormulaResultWords[1] := ERR_ILLEGAL_REFERENCE; // #REF!
errWrongName : FormulaResultWords[1] := ERR_WRONG_NAME; // #NAME?
errOverflow : FormulaResultWords[1] := ERR_OVERFLOW; // #NUM!
errArgError : FormulaResultWords[1] := ERR_ARG_ERROR; // #N/A;
end;
FormulaResultWords[3] := $FFFF;
end;
end;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
AStream.WriteWord(WordToLE(22 + RPNLength));
{ BIFF Record data }
AStream.WriteWord(WordToLE(ARow));
AStream.WriteWord(WordToLE(ACol));
{ Index to XF record, according to formatting }
//AStream.WriteWord(0);
WriteXFIndex(AStream, ACell);
{ Result of the formula in IEEE 754 floating-point value }
AStream.WriteBuffer(FormulaResult, 8);
{ Options flags }
AStream.WriteWord(WordToLE(MASK_FORMULA_RECALCULATE_ALWAYS));
{ Not used }
AStream.WriteDWord(0);
{ Formula }
{ The size of the token array is written later, because it's necessary to
calculate if first, and this is done at the same time it is written }
TokenArraySizePos := AStream.Position;
WriteRPNTokenArraySize(AStream, RPNLength);
WriteRPNTokenArray(AStream, AFormula, RPNLength);
{ Formula data (RPN token array) }
for i := 0 to Length(AFormula) - 1 do
begin
{ Token identifier }
TokenID := FormulaElementKindToExcelTokenID(AFormula[i].ElementKind, lSecondaryID);
AStream.WriteByte(TokenID);
Inc(RPNLength);
{ Additional data }
case TokenID of
{ Operand Tokens }
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA: { fekCell }
begin
AStream.WriteWord(AFormula[i].Row);
c := AFormula[i].Col and MASK_EXCEL_COL_BITS_BIFF8;
if (rfRelRow in AFormula[i].RelFlags) then c := c or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFormula[i].RelFlags) then c := c or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(c);
Inc(RPNLength, 4);
end;
INT_EXCEL_TOKEN_TAREA_R: { fekCellRange }
begin
{
Cell range address, BIFF8:
Offset Size Contents
0 2 Index to first row (0…65535) or offset of first row (method [B], -32768…32767)
2 2 Index to last row (0…65535) or offset of last row (method [B], -32768…32767)
4 2 Index to first column or offset of first column, with relative flags (see table above)
6 2 Index to last column or offset of last column, with relative flags (see table above)
}
AStream.WriteWord(WordToLE(AFormula[i].Row));
AStream.WriteWord(WordToLE(AFormula[i].Row2));
c := AFormula[i].Col;
if (rfRelCol in AFormula[i].RelFlags) then c := c or MASK_EXCEL_RELATIVE_COL;
if (rfRelRow in AFormula[i].RelFlags) then c := c or MASK_EXCEL_RELATIVE_ROW;
AStream.WriteWord(WordToLE(c));
c := AFormula[i].Col2;
if (rfRelCol2 in AFormula[i].RelFlags) then c := c or MASK_EXCEL_RELATIVE_COL;
if (rfRelRow2 in AFormula[i].RelFlags) then c := c or MASK_EXCEL_RELATIVE_ROW;
AStream.WriteWord(WordToLE(c));
Inc(RPNLength, 8);
end;
INT_EXCEL_TOKEN_TNUM: { fekNum }
begin
AStream.WriteBuffer(AFormula[i].DoubleValue, 8);
Inc(RPNLength, 8);
end;
INT_EXCEL_TOKEN_TSTR: { fekString }
begin
// string constant is stored as widestring in BIFF8
// Writing is done by the virtual method WriteString_8bitLen.
Inc(RPNLength, WriteString_8bitLen(AStream, AFormula[i].StringValue));
{
wideStr := UTF8Decode(AFormula[i].StringValue);
len := Length(wideStr);
AStream.WriteByte(len); // char count in 1 byte
AStream.WriteByte(1); // Widestring flags, 1=regular unicode LE string
AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * Sizeof(WideChar));
Inc(RPNLength, 1 + 1 + len*SizeOf(WideChar));
}
end;
INT_EXCEL_TOKEN_TBOOL: { fekBool }
begin
AStream.WriteByte(ord(AFormula[i].DoubleValue <> 0.0));
inc(RPNLength, 1);
end;
{ binary operation tokens }
INT_EXCEL_TOKEN_TADD, INT_EXCEL_TOKEN_TSUB, INT_EXCEL_TOKEN_TMUL,
INT_EXCEL_TOKEN_TDIV, INT_EXCEL_TOKEN_TPOWER: begin end;
{ Other operations }
INT_EXCEL_TOKEN_TATTR: { fekOpSUM }
{ 3.10, page 71: e.g. =SUM(1) is represented by token array
tInt(1),tAttrRum
}
begin
// Unary SUM Operation
AStream.WriteByte($10); //tAttrSum token (SUM with one parameter)
AStream.WriteByte(0); // not used
AStream.WriteByte(0); // not used
Inc(RPNLength, 3);
end;
// Functions with fixed parameter count
INT_EXCEL_TOKEN_FUNC_R, INT_EXCEL_TOKEN_FUNC_V, INT_EXCEL_TOKEN_FUNC_A:
begin
AStream.WriteWord(WordToLE(lSecondaryID));
Inc(RPNLength, 2);
end;
// Functions with variable parameter count
INT_EXCEL_TOKEN_FUNCVAR_V:
begin
AStream.WriteByte(AFormula[i].ParamsNum);
AStream.WriteWord(WordToLE(lSecondaryID));
Inc(RPNLength, 3);
end;
else
end;
end;
{ Write sizes in the end, after we known them }
FinalPos := AStream.Position;
AStream.position := TokenArraySizePos;
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.Position := FinalPos;
{ Write following STRING record if formula result is a non-empty string }
if (ACell^.ContentType = cctUTF8String) and (ACell^.UTF8StringValue <> '') then
WriteStringRecord(AStream, ACell^.UTF8StringValue);
end;
*)
{ Helper function for writing a string with 8-bit length. Overridden version
for BIFF8. Called for writing rpn formula string tokens.
Returns the count of bytes written}
@ -1070,7 +855,7 @@ var
wideStr: widestring;
len: Integer;
begin
wideStr := AString;
wideStr := UTF8Decode(AString);
len := Length(wideStr);
{ BIFF Record header }
@ -1927,7 +1712,7 @@ var
s: widestring;
begin
s := ReadWideString(AStream, true);
Result := s;
Result := UTF8Encode(s);
end;
procedure TsSpreadBIFF8Reader.ReadStringRecord(AStream: TStream);
@ -1936,7 +1721,7 @@ var
begin
s := ReadWideString(AStream, false);
if (FIncompleteCell <> nil) and (s <> '') then begin
FIncompleteCell^.UTF8StringValue := s;
FIncompleteCell^.UTF8StringValue := UTF8Encode(s);
FIncompleteCell^.ContentType := cctUTF8String;
end;
FIncompleteCell := nil;

82
components/fpspreadsheet/xlscommon.pas
View File

@ -1564,7 +1564,7 @@ begin
len := AStream.ReadByte;
SetLength(s, len);
AStream.ReadBuffer(s[1], len);
Result := s;
Result := ansiToUTF8(s);
end;
{ Reads a STRING record. It immediately precedes a FORMULA record which has a
@ -1573,7 +1573,6 @@ end;
procedure TsSpreadBIFFReader.ReadStringRecord(AStream: TStream);
begin
Unused(AStream);
//
end;
{ Reads the WINDOW2 record containing information like "show grid lines",
@ -1991,7 +1990,7 @@ end;
function TsSpreadBIFFWriter.WriteRPNCellAddress(AStream: TStream;
ARow, ACol: Cardinal; AFlags: TsRelFlags): Word;
var
r: Cardinal; // row index containing the relativ/absolute address info
r: Cardinal; // row index containing encoded relativ/absolute address info
begin
r := ARow and MASK_EXCEL_ROW;
if (rfRelRow in AFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
@ -2091,46 +2090,52 @@ end;
{ Writes the result of an RPN formula. }
procedure TsSpreadBIFFWriter.WriteRPNResult(AStream: TStream; ACell: PCell);
var
Data: array[0..3] of word;
FormulaResult: double;
FormulaResultWords: array[0..3] of word absolute FormulaResult;
begin
{ Determine encoded result bytes }
FormulaResult := 0.0;
FillChar(Data, SizeOf(Data), 0);
case ACell^.ContentType of
cctNumber:
FormulaResult := ACell^.NumberValue;
begin
FormulaResult := ACell^.NumberValue;
Move(FormulaResult, Data, 8);
end;
cctDateTime:
FormulaResult := ACell^.DateTimeValue;
begin
FormulaResult := ACell^.DateTimeValue;
Move(FormulaResult, Data, 8);
end;
cctUTF8String:
begin
if ACell^.UTF8StringValue = '' then
FormulaResultWords[0] := 3;
FormulaResultWords[3] := $FFFF;
Data[0] := 3;
Data[3] := $FFFF;
end;
cctBool:
begin
FormulaResultWords[0] := 1;
FormulaResultWords[1] := ord(ACell^.BoolValue);
FormulaResultWords[3] := $FFFF;
Data[0] := 1;
Data[1] := ord(ACell^.BoolValue);
Data[3] := $FFFF;
end;
cctError:
begin
FormulaResultWords[0] := 2;
Data[0] := 2;
case ACell^.ErrorValue of
errEmptyIntersection: FormulaResultWords[1] := ERR_INTERSECTION_EMPTY;// #NULL!
errDivideByZero : FormulaResultWords[1] := ERR_DIVIDE_BY_ZERO; // #DIV/0!
errWrongType : FormulaResultWords[1] := ERR_WRONG_TYPE_OF_OPERAND; // #VALUE!
errIllegalRef : FormulaResultWords[1] := ERR_ILLEGAL_REFERENCE; // #REF!
errWrongName : FormulaResultWords[1] := ERR_WRONG_NAME; // #NAME?
errOverflow : FormulaResultWords[1] := ERR_OVERFLOW; // #NUM!
errArgError : FormulaResultWords[1] := ERR_ARG_ERROR; // #N/A;
errEmptyIntersection: Data[1] := ERR_INTERSECTION_EMPTY;// #NULL!
errDivideByZero : Data[1] := ERR_DIVIDE_BY_ZERO; // #DIV/0!
errWrongType : Data[1] := ERR_WRONG_TYPE_OF_OPERAND; // #VALUE!
errIllegalRef : Data[1] := ERR_ILLEGAL_REFERENCE; // #REF!
errWrongName : Data[1] := ERR_WRONG_NAME; // #NAME?
errOverflow : Data[1] := ERR_OVERFLOW; // #NUM!
errArgError : Data[1] := ERR_ARG_ERROR; // #N/A;
end;
FormulaResultWords[3] := $FFFF;
Data[3] := $FFFF;
end;
end;
{ Write result of the formula, encoded above }
AStream.WriteBuffer(FormulaResult, 8);
AStream.WriteBuffer(Data, 8);
end;
{ Writes the token array of the given RPN formula and returns its size }
@ -2203,23 +2208,6 @@ begin
inc(RPNLength, 1);
end;
{ binary operation tokens }
INT_EXCEL_TOKEN_TADD, INT_EXCEL_TOKEN_TSUB, INT_EXCEL_TOKEN_TMUL,
INT_EXCEL_TOKEN_TDIV, INT_EXCEL_TOKEN_TPOWER:
begin
end;
{ Other operations }
INT_EXCEL_TOKEN_TATTR: { fekOpSUM }
{ 3.10, page 71: e.g. =SUM(1) is represented by token array tInt(1),tAttrRum }
begin
// Unary SUM Operation
AStream.WriteByte($10); //tAttrSum token (SUM with one parameter)
AStream.WriteByte(0); // not used
AStream.WriteByte(0); // not used
inc(RPNLength, 3);
end;
// Functions with fixed parameter count
INT_EXCEL_TOKEN_FUNC_R, INT_EXCEL_TOKEN_FUNC_V, INT_EXCEL_TOKEN_FUNC_A:
begin
@ -2234,13 +2222,25 @@ begin
n := WriteRPNFunc(AStream, secondaryID);
inc(RPNLength, 1 + n);
end;
// Other operations
INT_EXCEL_TOKEN_TATTR: { fekOpSUM }
{ 3.10, page 71: e.g. =SUM(1) is represented by token array tInt(1),tAttrRum }
begin
// Unary SUM Operation
AStream.WriteByte($10); //tAttrSum token (SUM with one parameter)
AStream.WriteByte(0); // not used
AStream.WriteByte(0); // not used
inc(RPNLength, 3);
end;
end; // case
end; // for
// Now update the size of the token array.
finalPos := AStream.Position;
AStream.Position := TokenArraySizePos;
AStream.WriteByte(RPNLength);
WriteRPNTokenArraySize(AStream, RPNLength);
AStream.Position := finalPos;
end;
@ -2428,7 +2428,7 @@ end;
{ Helper function for writing a string with 8-bit length. Here, we implement the
version for ansistrings since it is valid for all BIFF versions except BIFF8
where it has to overridden. Is called for writing a string rpn token.
where it has to be overridden. Is called for writing a string rpn token.
Returns the count of bytes written. }
function TsSpreadBIFFWriter.WriteString_8bitLen(AStream: TStream;
AString: String): Integer;