paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Fix 3d cell references with a single other sheet (Sheet1!A1:C3), except for ODS. 3d references with several sheets prepared (not tested yet). Some more unit tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6408 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-05-13 10:15:13 +00:00
parent 4d4e06ecb9
commit d2351b5559
12 changed files with 1624 additions and 476 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

224
components/fpspreadsheet/source/common/fpsexprparser.pas
View File

@ -86,8 +86,7 @@ type
TsResultTypes = set of TsResultType;
TsExpressionResult = record
Worksheet : TsWorksheet;
Worksheet2 : TsWorksheet;
Worksheet : TsWorksheet; // Worksheet containing the calculated cell
ResString : String;
case ResultType : TsResultType of
rtEmpty : ();
@ -96,8 +95,9 @@ type
rtInteger : (ResInteger : Int64);
rtFloat : (ResFloat : TsExprFloat);
rtDateTime : (ResDateTime : TDatetime);
rtCell : (ResRow, ResCol : Cardinal);
rtCellRange : (ResCellRange : TsCellRange);
rtCell : (ResRow, ResCol : Cardinal;
ResSheetIndex : Integer);
rtCellRange : (ResCellRange : TsCellRange3D);
rtHyperlink : ();
rtString : ();
end;
@ -564,7 +564,7 @@ type
private
FCallBack: TsExprFunctionCallBack;
protected
procedure GetNodeValue(out Result: TsExpressionResult); override;
procedure GetNodeValue(out AResult: TsExpressionResult); override;
public
constructor CreateFunction(AParser: TsExpressionParser;
AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override;
@ -616,30 +616,29 @@ type
TsCellRangeExprNode = class(TsExprNode)
private
FWorksheet: TsWorksheet;
FWorksheet2: TsWorksheet;
// FWorksheet2: TsWorksheet;
FRow: array[TsCellRangeIndex] of Cardinal;
FCol: array[TsCellRangeIndex] of Cardinal;
FSheet: array[TsCellRangeIndex] of Integer;
FFlags: TsRelFlags;
FonOtherSheet: Boolean;
F3dRange: Boolean;
protected
function GetCol(AIndex: TsCellRangeIndex): Cardinal;
function GetRow(AIndex: TsCellRangeIndex): Cardinal;
procedure GetNodeValue(out Result: TsExpressionResult); override;
function GetSheetIndex(AIndex: TscellRangeIndex): Integer;
function GetWorkbook: TsWorkbook;
public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ACellRangeString: String; OnOtherSheet: Boolean); overload;
ARangeString: String); overload;
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ARow1,ACol1, ARow2,ACol2: Cardinal; AFlags: TsRelFlags; OnOtherSheet: Boolean); overload;
constructor Create(AParser: TsExpressionParser; AWorksheet1, AWorksheet2: TsWorksheet;
ACellRangeString: String); overload;
constructor Create(AParser: TsExpressionParser; AWorksheet1, AWorksheet2: TsWorksheet;
ARow1,ACol1, ARow2,ACol2: Cardinal; AFlags: TsRelFlags); overload;
ASheet1, ASheet2: String; ARow1,ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags; Is3DRange: Boolean); overload;
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override;
procedure Check; override;
function Has3DLink: Boolean; override;
function NodeType: TsResultType; override;
property Workbook: TsWorkbook read GetWorkbook;
property Worksheet: TsWorksheet read FWorksheet;
end;
@ -751,7 +750,7 @@ type
procedure Clear;
function CopyMode: Boolean;
function Evaluate: TsExpressionResult;
procedure EvaluateExpression(out Result: TsExpressionResult);
procedure EvaluateExpression(out AResult: TsExpressionResult);
function Has3DLinks: Boolean;
procedure PrepareCopyMode(ASourceCell, ADestCell: PCell);
function ResultType: TsResultType;
@ -1361,13 +1360,13 @@ begin
EvaluateExpression(Result);
end;
procedure TsExpressionParser.EvaluateExpression(out Result: TsExpressionResult);
procedure TsExpressionParser.EvaluateExpression(out AResult: TsExpressionResult);
begin
if (FExpression = '') then
ParserError(rsExpressionEmpty);
if not Assigned(FExprNode) then
ParserError(rsErrorInExpression);
FExprNode.GetNodeValue(Result);
FExprNode.GetNodeValue(AResult);
end;
function TsExpressionParser.GetAsBoolean: Boolean;
@ -1672,7 +1671,7 @@ begin
else if (TokenType = ttCell) then
Result := TsCellExprNode.Create(self, FWorksheet, CurrentToken, false)
else if (TokenType = ttCellRange) then
Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken, false)
Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
else if (TokenType = ttSheetName) then begin
sheetName := CurrentToken;
GetToken;
@ -1683,10 +1682,10 @@ begin
Result := TsCellExprNode.Create(self, sheet, CurrentToken, true)
end else
if TokenType = ttCellRange then begin
sheet := FWorksheet.WorkBook.GetWorksheetByName(sheetName);
if sheet = nil then
sheet := FWorksheet.Workbook.AddWorksheet(sheetName, true);
Result := TsCellRangeExprNode.Create(self, sheet, sheet, CurrentToken);
if FDialect = fdOpenDocument then
Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
else
Result := TsCellrangeExprNode.Create(self, FWorksheet, sheetName+'!'+CurrentToken);
end;
end
else if (TokenType = ttError) then
@ -1877,12 +1876,13 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
operand: TsExprNode = nil;
fek: TFEKind;
r,c, r2,c2: Cardinal;
idx: Integer;
idx, idx2: Integer;
flags: TsRelFlags;
ID: TsExprIdentifierDef;
i, n: Integer;
args: TsExprArgumentArray;
sheet, sheet2: TsWorksheet;
sheet: TsWorksheet;
sn, sn2: string;
begin
if AIndex < 0 then
exit;
@ -1918,22 +1918,23 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
end;
dec(AIndex);
end;
fekCellRange:
fekCellRange, fekCellRange3D:
begin
r := AFormula[AIndex].Row;
c := AFormula[AIndex].Col;
r2 := AFormula[AIndex].Row2;
c2 := AFormula[AIndex].Col2;
flags := AFormula[AIndex].RelFlags;
idx := AFormula[AIndex].Sheet;
if idx = -1 then
ANode := TsCellRangeExprNode.Create(self, FWorksheet, r, c, r2, c2, flags, false)
if fek = fekCellRange then
ANode := TsCellRangeExprNode.Create(self, FWorksheet,
FWorksheet.Name, FWorksheet.Name, r, c, r2, c2, flags, false)
else begin
sheet := FWorksheet.Workbook.GetWorksheetByIndex(idx);
idx := AFormula[AIndex].Sheet2;
if idx = -1 then sheet2 := sheet
else sheet2 := FWorksheet.Workbook.GetWorksheetByIndex(idx);
ANode := TsCellRangeExprNode.Create(self, sheet, sheet2, r,c, r2,c2, flags);
sn := FWorksheet.Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet).Name;
if AFormula[AIndex].Sheet2 = -1 then
sn2 := sn
else
sn2 := FWorksheet.Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet2).Name;
ANode := TsCellRangeExprNode.Create(self, FWorksheet, sn,sn2, r,c, r2,c2, flags, true);
end;
dec(AIndex);
end;
@ -3608,12 +3609,12 @@ begin
FCallBack := AID.OnGetFunctionValueCallBack;
end;
procedure TsFunctionCallBackExprNode.GetNodeValue(out Result: TsExpressionResult);
procedure TsFunctionCallBackExprNode.GetNodeValue(out AResult: TsExpressionResult);
begin
Result.ResultType := NodeType; // was at end!
AResult.ResultType := NodeType; // was at end!
if Length(FArgumentParams) > 0 then
CalcParams;
FCallBack(Result, FArgumentParams);
FCallBack(AResult, FArgumentParams);
end;
@ -3863,6 +3864,42 @@ end;
{ TsCellRangeExprNode }
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ARangeString: String);
var
r1, c1, r2, c2: Cardinal;
sheet1, sheet2: String;
flags: TsRelFlags;
begin
ParseCellRangeString(ARangeString, sheet1, sheet2, r1, c1, r2, c2, flags);
if (sheet1 = '') then begin
sheet1 := AWorksheet.Name;
sheet2 := sheet1;
end;
Create(AParser, AWorksheet, sheet1, sheet2, r1, c1, r2, c2,
flags, (AWorksheet.Name <> sheet1) );
end;
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ASheet1, ASheet2: String;
ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: tsRelFlags; Is3DRange: Boolean);
begin
FParser := AParser;
FWorksheet := AWorksheet;
FSheet[1] := GetWorkbook.GetWorksheetIndex(ASheet1);
if ASheet2 = '' then
FSheet[2] := FSheet[1]
else
FSheet[2] := GetWorkbook.GetWorksheetIndex(ASheet2);
FRow[1] := ARow1;
FCol[1] := ACol1;
FRow[2] := ARow2;
FCol[2] := ACol2;
FFlags := AFlags;
F3dRange := Is3dRange;
end;
(*
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ACellRangeString: String; OnOtherSheet: Boolean);
var
@ -3929,17 +3966,22 @@ begin
FFlags := AFlags;
FOnOtherSheet := true;
end;
*)
function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
if FOnOtherSheet then
if F3dRange then
Result := RPNCellRange3D(
GetSheetIndex(1), GetRow(1), GetCol(1),
GetSheetIndex(2), GetRow(2), GetCol(2),
FSheet[1], GetRow(1), GetCol(1),
FSheet[2], GetRow(2), GetCol(2),
FFlags, ANext
)
else
Result := RPNCellRange(GetRow(1), GetCol(1), GetRow(2), GetCol(2), FFlags, ANext);
Result := RPNCellRange(
GetRow(1), GetCol(1),
GetRow(2), GetCol(2),
FFlags, ANext
);
end;
function TsCellRangeExprNode.AsString: string;
@ -3947,19 +3989,33 @@ var
r1, c1, r2, c2: Cardinal;
s1, s2: String;
begin
r1 := GetRow(1); r2 := GetRow(2);
c1 := GetCol(1); c2 := GetCol(2);
s1 := FWorksheet.Name; s2 := FWorksheet2.Name;
s1 := Workbook.GetWorksheetByIndex(FSheet[1]).Name;
s2 := Workbook.GetWorksheetByIndex(FSheet[2]).Name;
r1 := GetRow(1);
c1 := GetCol(1);
r2 := GetRow(2);
c2 := GetCol(2);
case FParser.Dialect of
fdExcelA1:
Result := GetCellRangeString(s1, s2, r1, c1, r2, c2, FFlags, true);
fdExcelR1C1:
Result := GetCellRangeString_R1C1(s1, s2, r1, c1, r2, c2, FFlags,
FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
fdOpenDocument:
Result := GetCellRangeString_ODS(s1, s2, r1, c1, r2, c2, FFlags);
end;
if F3dRange then
case FParser.Dialect of
fdExcelA1:
Result := GetCellRangeString(s1, s2, r1, c1, r2, c2, FFlags, true);
fdExcelR1C1:
Result := GetCellRangeString_R1C1(s1, s2, r1, c1, r2, c2, FFlags,
FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
fdOpenDocument:
Result := GetCellRangeString_ODS(s1, s2, r1, c1, r2, c2, FFlags);
end
else
case FParser.Dialect of
fdExcelA1:
Result := GetCellRangeString(r1, c1, r2, c2, FFlags, true);
fdExcelR1C1:
Result := GetCellRangeString_R1C1(r1, c1, r2, c2, FFlags,
FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
fdOpenDocument:
Result := GetCellRangeString(r1, c1, r2, c2, FFlags, true);
end;
end;
procedure TsCellRangeExprNode.Check;
@ -3997,14 +4053,16 @@ begin
begin
r[i] := GetRow(i);
c[i] := GetCol(i);
s[i] := GetSheetIndex(i);
s[i] := FSheet[i];
end;
if not FOnOtherSheet then s[2] := s[1];
book := FWorksheet.Workbook;
if not F3dRange then begin
s[1] := Workbook.GetWorksheetIndex(FWorksheet);
s[2] := s[1];
end;
for ss := s[1] to s[2] do begin
sheet := book.GetWorksheetByIndex(ss);
sheet := Workbook.GetWorksheetByIndex(ss);
for rr := r[1] to r[2] do
for cc := c[1] to c[2] do
begin
@ -4024,8 +4082,10 @@ begin
Result.ResCellRange.Col1 := c[1];
Result.ResCellRange.Row2 := r[2];
Result.ResCellRange.Col2 := c[2];
Result.ResCellRange.Sheet1 := s[1];
Result.ResCellRange.Sheet2 := s[2];
Result.Worksheet := FWorksheet;
Result.Worksheet2 := FWorksheet2;
// Result.Worksheet2 := FWorksheet2;
end;
function TsCellRangeExprNode.GetRow(AIndex: TsCellRangeIndex): Cardinal;
@ -4035,22 +4095,14 @@ begin
Result := FRow[AIndex] - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
end;
function TsCellRangeExprNode.GetSheetIndex(AIndex: TsCellRangeIndex): Integer;
var
book: TsWorkbook;
sheet: TsWorksheet;
function TsCellRangeExprNode.GetWorkbook: TsWorkbook;
begin
case AIndex of
1: sheet := FWorksheet;
2: sheet := FWorksheet2;
end;
book := sheet.Workbook;
Result := book.GetWorksheetIndex(sheet);
Result := FWorksheet.Workbook;
end;
function TsCellRangeExprNode.Has3DLink: Boolean;
begin
Result := FOnOtherSheet;
Result := F3dRange;
end;
function TsCellRangeExprNode.NodeType: TsResultType;
@ -4224,29 +4276,37 @@ var
i, n: Integer;
r, c: Cardinal;
cell: PCell;
sheet: TsWorksheet;
arg: TsExpressionResult;
idx, idx1, idx2: Integer;
begin
SetLength(AData, BLOCKSIZE);
n := 0;
for i:=0 to High(Args) do
begin
arg := Args[i];
if arg.ResultType = rtCellRange then
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
begin
cell := arg.Worksheet.FindCell(r, c);
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
if arg.ResultType = rtCellRange then begin
idx1 := arg.ResCellRange.Sheet1;
idx2 := arg.ResCellRange.Sheet2;
for idx := idx1 to idx2 do
begin
sheet := arg.Worksheet.Workbook.GetWorksheetByIndex(idx);
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
begin
case cell^.ContentType of
cctNumber : AData[n] := cell^.NumberValue;
cctDateTime : AData[n] := cell^.DateTimeValue
cell := sheet.FindCell(r, c);
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
begin
case cell^.ContentType of
cctNumber : AData[n] := cell^.NumberValue;
cctDateTime : AData[n] := cell^.DateTimeValue
end;
inc(n);
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
end;
inc(n);
if n = Length(AData) then SetLength(AData, length(AData) + BLOCKSIZE);
end;
end
else
end
end;
end else
if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtBoolean]) then
begin
AData[n] := ArgToFloat(arg);

21
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -755,7 +755,7 @@ type
procedure PrepareBeforeReading;
procedure PrepareBeforeSaving;
procedure ReCalc;
// procedure ReCalc;
public
{@@ A copy of SysUtil's DefaultFormatSettings (converted to UTF8) to provide
@ -8119,6 +8119,7 @@ end;
{@@ ----------------------------------------------------------------------------
Recalculates rpn formulas in all worksheets
-------------------------------------------------------------------------------}
(*
procedure TsWorkbook.Recalc;
var
sheet: pointer;
@ -8126,6 +8127,7 @@ begin
for sheet in FWorksheets do
TsWorksheet(sheet).CalcFormulas;
end;
*)
{@@ ----------------------------------------------------------------------------
Conversion of length values between units
@ -8475,7 +8477,8 @@ begin
ok := true;
UpdateCaches;
if (boAutoCalc in Options) then
Recalc;
CalcFormulas;
// Recalc;
FFormatID := AFormatID;
finally
FReadWriteFlag := rwfNormal;
@ -8611,7 +8614,8 @@ begin
ok := true;
UpdateCaches;
if (boAutoCalc in Options) then
Recalc;
CalcFormulas;
// Recalc;
FFormatID := AFormatID;
finally
FReadWriteFlag := rwfNormal;
@ -8977,11 +8981,13 @@ end;
function TsWorkbook.GetWorksheetByName(AName: String): TsWorksheet;
var
i:integer;
s: String;
begin
Result := nil;
for i:=0 to FWorksheets.Count-1 do
begin
if UTF8CompareText(TsWorkSheet(FWorkSheets.Items[i]).Name, AName) = 0 then
s := TsWorksheet(FWorksheets.Items[i]).Name;
if UTF8CompareText(s, AName) = 0 then
begin
Result := TsWorksheet(FWorksheets.Items[i]);
exit;
@ -9012,10 +9018,15 @@ end;
worksheet does not exist.
-------------------------------------------------------------------------------}
function TsWorkbook.GetWorksheetIndex(const AWorksheetName: String): Integer;
var
s: String;
begin
for Result := 0 to FWorksheets.Count-1 do
if TsWorksheet(FWorksheets[Result]).Name = AWorksheetName then
begin
s := TsWorksheet(FWorksheets[Result]).Name;
if SameText(s, AWorksheetName) then
exit;
end;
Result := -1;
end;

88
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -81,6 +81,9 @@ function ParseSheetCellString(const AStr: String; out ASheetName: String;
function ParseCellRowString(const AStr: string; out ARow: Cardinal): Boolean;
function ParseCellColString(const AStr: string; out ACol: Cardinal): Boolean;
function ParseCellRangeString(const AStr: String; out ASheet1, ASheet2: String;
out ARow1, ACol1, ARow2, ACol2: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function GetCellRangeString(ASheet1, ASheet2: String; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
@ -914,6 +917,87 @@ begin
Result := Char(AValue + ord('A'));
end;
{@@ ----------------------------------------------------------------------------
Parses a 3D cell and sheet range string in Excel A1 dialect. Returns the
names of the limiting sheets and the indexes of the limiting borders.
The function result is false if the provided string is not valid.
-------------------------------------------------------------------------------}
function ParseCellRangeString(const AStr: String; out ASheet1, ASheet2: String;
out ARow1, ACol1, ARow2, ACol2: Cardinal; out AFlags: TsRelFlags): Boolean;
var
s1, s2: string;
p: Integer;
begin
p := pos('!', AStr);
if p = 0 then begin
ASheet1 := '';
ASheet2 := '';
s2 := AStr;
end else begin
s1 := Copy(AStr, 1, p-1);
s2 := Copy(AStr, p+1, MaxInt);
p := pos(':', s1);
if p = 0 then
ASheet1 := s1
else begin
ASheet1 := copy(s1, 1, p-1);
ASheet2 := copy(s1, p+1, MaxInt);
end;
end;
Result := ParseCellRangeString(s2, ARow1, ACol1, ARow2, ACol2, AFlags);
end;
{@@ ----------------------------------------------------------------------------
Parses a 3D cell and sheet range string in ODS dialect. Returns the
names of the limiting sheets and the indexes of the limiting borders.
The function result is false if the provided string is not valid.
-------------------------------------------------------------------------------}
function ParseCellRangeString_ODS(const AStr: String; out ASheet1, ASheet2: String;
out ARow1, ACol1, ARow2, ACol2: Cardinal; out AFlags: TsRelFlags): Boolean;
var
s1, s2: String;
p: Integer;
res1, res2: Boolean;
flags1, flags2: TsRelFlags;
begin
p := Pos(':', AStr);
if p = 0 then begin
s1 := AStr;
s2 := '';
end else begin
s1 := copy(AStr, 1, p-1);
s2 := copy(AStr, p+1, MaxInt);
end;
p := pos('.', s1);
if p = 0 then begin
ASheet1 := '';
ASheet2 := '';
Result := ParseCellString(s1, ARow1, ACol1, AFlags);
ARow2 := ARow1;
ACol2 := ACol1;
exit;
end else begin
ASheet1 := Copy(s1, 1, p-1);
s1 := copy(s1, p+1, MaxInt);
res1 := ParseCellString(s1, ARow1, ACol1, flags1);
end;
p := pos('.', s2);
if p = 0 then begin
ASheet2 := '';
res2 := ParseCellString(s2, ARow2, ACol2, flags2);
end else begin
ASheet2 := Copy(s2, 1, p-1);
s2 := copy(s2, p+1, MaxInt);
res2 := ParseCellString(s2, ARow2, ACol2, flags2);
end;
Result := res1 and res2;
AFlags := flags1 + flags2;
end;
{@@ ----------------------------------------------------------------------------
Calculates an Excel column name ('A', 'B' etc) from the zero-based column index
@ -1113,11 +1197,11 @@ function GetCellRangeString_ODS(ASheet1, ASheet2: String;
var
s1, s2: String;
begin
s1 := Format('%s%s%s%s', [
s1 := Format('%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol1),
RELCHAR[rfRelRow in AFlags], ARow1 + 1
]);
s2 := Format('%s%s%s%s', [
s2 := Format('%s%s%s%d', [
RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2),
RELCHAR[rfRelRow2 in AFlags], ARow2 + 1
]);

10
components/fpspreadsheet/source/common/xlsbiff5.pas
View File

@ -532,6 +532,8 @@ begin
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_EXTERNCOUNT : ReadEXTERNCOUNT(AStream);
INT_EXCEL_ID_EXTERNSHEET : ReadEXTERNSHEET(AStream);
INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true);
@ -666,17 +668,17 @@ begin
// Skip 8 unused bytes
AStream.Position := AStream.Position + 8;
// Zero-based index to first referenced sheet (-1 = deleted sheet)
// one-based index to first referenced sheet (-1 = deleted sheet)
idx := Int16(WordLEToN(AStream.ReadWord));
if idx <> -1 then begin
s := FExternSheets.Strings[idx];
s := FExternSheets.Strings[idx-1];
ASheet1 := FWorkbook.GetWorksheetIndex(s);
end;
// Zero-based index to last referenced sheet (-1 = deleted sheet)
// one-based index to last referenced sheet (-1 = deleted sheet)
idx := WordLEToN(AStream.ReadWord);
if idx <> -1 then begin
s := FExternSheets.Strings[idx];
s := FExternSheets.Strings[idx-1];
ASheet2 := FWorkbook.GetWorksheetIndex(s);
end;
end

3
components/fpspreadsheet/source/common/xlsbiff8.pas
View File

@ -2831,6 +2831,9 @@ end;
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteEXTERNBOOK(AStream: TStream);
begin
if (FExternBooks = nil) or (FExternBooks.Count = 0) then
exit;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNBOOK, 4);

6
components/fpspreadsheet/source/common/xlscommon.pas
View File

@ -1887,7 +1887,8 @@ begin
inc(len);
SetLength(ansistr, len);
AStream.ReadBuffer(ansistr[2], len-1);
ansistr[1] := char(b);
Delete(ansistr, 1, 1);
// ansistr[1] := char(b);
s := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
FExternSheets.AddObject(s, TObject(PtrInt(b)));
end;
@ -4088,6 +4089,9 @@ end;
*)
procedure TsSpreadBIFFWriter.WriteEXTERNCOUNT(AStream: TStream; ACount: Word);
begin
if ACount = 0 then
exit;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNCOUNT, 2);

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

@ -10,6 +10,8 @@ unit formulatests;
Note that Excel report a corrupted file when trying to read this file }
{.DEFINE ENABLE_DEFECTIVE_FORMULAS }
{ Activate the project define FORMULADEBUG to log the formulas written }
interface
@ -87,6 +89,9 @@ type
implementation
uses
{$IFDEF FORMULADEBUG}
LazLogger,
{$ENDIF}
math, typinfo, lazUTF8, fpsUtils, fpsRPN, rpnFormulaUnit;
var

258
components/fpspreadsheet/tests/singleformulatests.pas Normal file
View File

@ -0,0 +1,258 @@
unit SingleFormulaTests;
{$mode objfpc}{$H+}
interface
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
fpstypes, fpsallformats, fpspreadsheet, fpsexprparser,
xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
type
TFormulaTestKind = (ftkConstants, ftkCellConstant, ftkCells, ftkCellRange,
ftkCellRangeSheet, ftkCellRangeSheetRange);
{ TSpreadDetailedFormulaFormula }
TSpreadSingleFormulaTests = class(TTestCase)
private
protected
procedure SetUp; override;
procedure TearDown; override;
procedure TestFloatFormula(AFormula: String; AExpected: Double;
ATestKind: TFormulaTestKind; AFormat: TsSpreadsheetFormat);
published
procedure AddConst_BIFF2;
procedure AddConst_BIFF5;
procedure AddConst_BIFF8;
procedure AddConst_OOXML;
procedure AddConst_ODS;
procedure AddCells_BIFF2;
procedure AddCells_BIFF5;
procedure AddCells_BIFF8;
procedure AddCells_OOXML;
procedure AddCells_ODS;
procedure SumRange_BIFF2;
procedure SumRange_BIFF5;
procedure SumRange_BIFF8;
procedure SumRange_OOXML;
procedure SumSheetRange_BIFF5; // no 3d ranges for BIFF2
procedure SumSheetRange_BIFF8;
procedure SumSheetRange_OOXML;
end;
implementation
uses
{$IFDEF FORMULADEBUG}
LazLogger,
{$ENDIF}
math, typinfo, lazUTF8, fpsUtils;
{ TSpreadExtendedFormulaTests }
procedure TSpreadSingleFormulaTests.SetUp;
begin
inherited SetUp;
end;
procedure TSpreadSingleFormulaTests.TearDown;
begin
inherited TearDown;
end;
procedure TSpreadSingleFormulaTests.TestFloatFormula(AFormula: String;
AExpected: Double; ATestKind: TFormulaTestKind; AFormat: TsSpreadsheetFormat);
const
SHEET1 = 'Sheet1';
SHEET2 = 'Sheet2';
SHEET3 = 'Sheet3';
TESTCELL_ROW = 1;
TESTCELL_COL = 2;
var
worksheet: TsWorksheet;
othersheet: TsWorksheet;
workbook: TsWorkbook;
TempFile: string; //write xls/xml to this file and read back from it
cell: PCell;
actualformula: String;
actualValue: Double;
begin
TempFile := GetTempFileName;
// Create test workbook and write test formula and needed cells
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boCalcBeforeSaving, boAutoCalc];
workSheet:= workBook.AddWorksheet(SHEET1);
if ATestKind <> ftkConstants then begin
// Write cells used by the formula
worksheet.WriteNumber(2, 2, 1.0); // C3
worksheet.WriteNumber(3, 2, -2.0); // C4
worksheet.WriteNumber(4, 2, 1.5); // C5
worksheet.WriteNumber(2, 3, 15.0); // D3
end;
if ATestKind in [ftkCellRangeSheet, ftkCellRangeSheetRange] then begin
otherSheet := Workbook.AddWorksheet(SHEET2);
othersheet.WriteNumber(2, 2, 10.0); // Sheet2!C3
othersheet.WriteNumber(3, 2, -20.0); // Sheet2!C4
othersheet.WriteNumber(4, 2, 15.0); // Sheet2!C5
othersheet.WriteNumber(2, 3, 150.0); // Sheet2!D5
end;
if ATestKind = ftkCellRangeSheetRange then begin
otherSheet := Workbook.AddWorksheet(SHEET3);
othersheet.WriteNumber(2, 2, 100.0); // Sheet3C3
othersheet.WriteNumber(3, 2, -200.0); // Sheet3!C4
othersheet.WriteNumber(4, 2, 150.0); // Sheet3!C5
othersheet.WriteNumber(2, 3, 1500.0); // Sheet3!D5
end;
// Write the formula
cell := worksheet.WriteFormula(TESTCELL_ROW, TESTCELL_COL, AFormula);
// Read formula before saving
actualFormula := cell^.Formulavalue;
CheckEquals(AFormula, actualFormula, 'Unsaved formula text mismatch');
// Read calculated value before saving
actualvalue := worksheet.ReadAsNumber(TESTCELL_ROW, TESTCELL_COL);
CheckEquals(AExpected, actualvalue, 'Unsaved calculated value mismatch');
// Save
workbook.WriteToFile(TempFile, AFormat, true);
finally
workbook.Free;
end;
// Read file
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boReadFormulas, boAutoCalc];
workbook.ReadFromFile(TempFile, AFormat);
worksheet := workbook.GetFirstWorksheet;
// Read calculated formula value
actualvalue := worksheet.ReadAsNumber(TESTCELL_ROW, TESTCELL_COL);
CheckEquals(AExpected, actualValue, 'Saved calculated value mismatch');
cell := worksheet.FindCell(TESTCELL_ROW, TESTCELL_COL);
actualformula := cell^.FormulaValue;
CheckEquals(AFormula, actualformula, 'Saved formula text mismatch.');
finally
workbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadSingleFormulaTests.AddConst_BIFF2;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfExcel2);
end;
procedure TSpreadSingleFormulaTests.AddConst_BIFF5;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.AddConst_BIFF8;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.AddConst_OOXML;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfOOXML);
end;
procedure TSpreadSingleFormulaTests.AddConst_ODS;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfOpenDocument);
end;
{---------------}
procedure TSpreadSingleFormulaTests.AddCells_BIFF2;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfExcel2);
end;
procedure TSpreadSingleFormulaTests.AddCells_BIFF5;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.AddCells_BIFF8;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.AddCells_OOXML;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfOOXML);
end;
procedure TSpreadSingleFormulaTests.AddCells_ODS;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfOpenDocument);
end;
{ ------ }
procedure TSpreadSingleFormulaTests.SumRange_BIFF2;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfExcel2);
end;
procedure TSpreadSingleFormulaTests.SumRange_BIFF5;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.SumRange_BIFF8;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.SumRange_OOXML;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfOOXML);
end;
{ ---- }
procedure TSpreadSingleFormulaTests.SumSheetRange_BIFF5;
begin
TestFloatFormula('SUM(Sheet2!C3:C5)', 5.0, ftkCellRangeSheet, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.SumSheetRange_BIFF8;
begin
TestFloatFormula('SUM(Sheet2!C3:C5)', 5.0, ftkCellRangeSheet, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.SumSheetRange_OOXML;
begin
TestFloatFormula('SUM(Sheet2!C3:C5)', 5.0, ftkCellRangeSheet, sfOOXML);
end;
{ ---- }
initialization
// Register to include these tests in a full run
RegisterTest(TSpreadSingleFormulaTests);
end.

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

@ -38,7 +38,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="29">
<Units Count="30">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -156,6 +156,11 @@
<Filename Value="testcases_calc3dformula.inc"/>
<IsPartOfProject Value="True"/>
</Unit28>
<Unit29>
<Filename Value="singleformulatests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="SingleFormulaTests"/>
</Unit29>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -174,6 +179,12 @@
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-dFormulaDebug"/>
<OtherDefines Count="1">
<Define0 Value="FormulaDebug"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="6">

13
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

@ -9,12 +9,13 @@ uses
//HeapTrc,
SysUtils,
{$ENDIF}
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit, exceltests,
emptycelltests, errortests, virtualmodetests, insertdeletetests, ssttests,
celltypetests, sortingtests, copytests, enumeratortests, commenttests,
hyperlinktests, pagelayouttests, protectiontests;
Interfaces, Forms, GuiTestRunner, testsutility,
datetests, stringtests, numberstests, manualtests, internaltests,
formattests, colortests, fonttests, optiontests, numformatparsertests,
formulatests, rpnFormulaUnit, singleformulatests,
exceltests, emptycelltests, errortests, virtualmodetests,
insertdeletetests, ssttests, celltypetests, sortingtests, copytests,
enumeratortests, commenttests, hyperlinktests, pagelayouttests, protectiontests;
begin
{$IFDEF HEAPTRC}

11
components/fpspreadsheet/tests/testcases_calc3dformula.inc
View File

@ -6,7 +6,9 @@
sheet1.WriteNumber(1, 5, 12.0); // F2 = 12.0
sheet2.WriteText(2, 1, 'A'); // B3 = 'A'
sheet2.WriteNumber(1, 4, 1.0); // E2 = 1.0
sheet2.WriteNumber(1, 4, 1.0); // E2 = 1.0
sheet2.WriteNumber(2, 4, -1.0); // E3 = -1.0
sheet2.WriteNumber(3, 4, 10.0); // E4 = 10.0
sheet3.WriteText(1, 2, 'B'); // C2 = 'B'
sheet3.WriteNumber(1, 1, 2.0); // B2 = 2.0
@ -69,6 +71,13 @@
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('AB');
inc(Row);
formula := 'SUM(Sheet2!E2:E4)'; { A9 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := FloatResult(10.0);
{
inc(Row);
formula := 'D1&Sheet2!B3%"BC"';

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

File diff suppressed because it is too large Load Diff